{BASS dll code} const signMP3 = $FBFF; signID3 = $00334449; signOGG = $5367674F; OGGHdrSize = 26; // +1=NumSegments const BASSName = 'bass.dll'; StationHeader:PByte=nil; const basspath:PWideChar=nil; var hdrlen:integer; syncMETA, syncOGG, syncWMA, syncWMA1, syncEND:HSYNC; SaveHeader:bool; procedure SetSndVol(arg:integer); begin if arg<0 then arg:=gVolume else gVolume:=arg; if chan<>0 then begin if arg<0 then arg:=0; BASS_ChannelSetAttribute(chan,BASS_ATTRIB_VOL,arg/100); end; end; procedure BassError(text:PWideChar); begin MessageboxW(0,TranslateW(text),TranslateW('Sorry!'),MB_ICONERROR) end; procedure ErrorCustom(text:pWideChar=nil); var buf:array [0..255] of WideChar; idx:integer; pcw:pWideChar; begin idx:=BASS_ErrorGetCode(); if (idx<0) or (idx>BASS_ERROR_MAXNUMBER) then begin if text=nil then pcw:='Unknown error' else pcw:=text; end else pcw:=FastAnsiToWideBuf(BASS_ERRORS[idx],@buf); MessageBoxW(0,TranslateW(pcw), TranslateW('Oops! BASS error'),MB_ICONERROR) end; procedure EQ_OFF; var i:dword; begin if chan<>0 then for i:=0 to 9 do BASS_ChannelRemoveFX(chan,eq[i].fx); isEQ_OFF:=BST_CHECKED; end; procedure EQ_ON; var i:dword; begin if chan<>0 then begin for i:=0 to 9 do eq[i].fx:=BASS_ChannelSetFX(chan,BASS_FX_DX8_PARAMEQ,1); for i:=0 to 9 do BASS_FXSetParameters(eq[i].fx,@eq[i].param); isEQ_OFF:=BST_UNCHECKED; end; end; function MyLoadBASS(root:PwideChar;custom:pWideChar):bool; var pc:PWideChar; buf:array [0..MAX_PATH-1] of WideChar; begin result:=true; mGetMem(basspath,1024); pc:=StrCopyEW(basspath,custom); if (pc-1)^<>'\' then begin pc^:='\'; inc(pc); end; StrCopyW(pc,BASSName); if not Load_BASSDLL(basspath) then begin pc:=StrCopyW(StrCopyEW(basspath,root),BASSName); if not Load_BASSDLL(basspath) then begin pc:=StrCopyW(StrCopyEW(pc,'plugins\'),BASSName); if not Load_BASSDLL(basspath) then begin pc:=StrCopyW(StrCopyEW(pc,'bass\'),BASSName); if not Load_BASSDLL(basspath) then begin if (custom<>nil) and (custom^<>#0) then BassError('BASS.DLL not found!'); result:=false; end; end; end; end; if (not result) and ((custom=nil) or (custom^=#0)) then begin if MessageboxA(0,Translate('BASS.DLL not found! Choose BASS.dll path manually'), cPluginName,MB_YESNO)=IDYES then begin pc := nil; if SelectDirectory(TranslateW('Choose BASS.dll path'),pc,0) then begin PathToRelativeW(pc,buf); pc:=StrCopyEW(basspath,buf); if (pc-1)^<>'\' then begin pc^:='\'; inc(pc); end; pc^:=#0; DBWriteUnicode(0,PluginName,optBASSPath,basspath); StrCopyW(pc,BASSName); if not Load_BASSDLL(basspath) then BassError('BASS.DLL not found!') else result:=true; end; end; end; if result then begin if (BASS_GetVersion shr 16)0 then begin if syncMETA<>0 then begin BASS_ChannelRemoveSync(chan,syncMETA); syncMETA:=0 end; if syncEND<>0 then begin BASS_ChannelRemoveSync(chan,syncEND); syncEND:=0 end; if syncWMA<>0 then begin BASS_ChannelRemoveSync(chan,syncWMA); syncWMA:=0 end; if syncOGG<>0 then begin BASS_ChannelRemoveSync(chan,syncOGG); syncOGG:=0 end; if syncWMA1<>0 then begin BASS_ChannelRemoveSync(chan,syncWMA1); syncWMA1:=0 end; end; end; procedure MyFreeBASS; begin MyStopBASS; BASS_Free; BASS_PluginFree(0); end; procedure StopStation; begin if chan<>0 then BASS_StreamFree(chan); // close old stream chan:=0; mFreeMem(StationHeader); mFreeMem(ActiveURLw); DBDeleteSetting(ActiveContact,strCList,optStatusMsg); MyStopBASS; end; function GetDeviceNumber:integer; var i:integer; info:BASS_DEVICEINFO; begin // default device result:=-1; i:=1; repeat if not BASS_GetDeviceInfo(i,info) then break; if (info.flags and BASS_DEVICE_ENABLED)<>0 then if StrCmp(info.name,usedevice)=0 then begin // not default device if (info.flags and BASS_DEVICE_DEFAULT)=0 then result:=i; break; end; inc(i); until false; end; function MyInitBASS:int; var fd:TWin32FindDataW; fh:THANDLE; buf:array [0..MAX_PATH-1] of WideChar; // buf1:array [0..31] of WideChar; pc:PWideChar; p:Bool; num:integer; begin if Inited then begin result:=1; exit; end; Inited:=true; BASS_Free; num:=GetDeviceNumber; p:=BASS_Init(num,44100,BASS_DEVICE_3D,0,nil); if not p then p:=BASS_Init(num,44100,0,0,nil); // not default device choosed - check default now if (not p) and (num>=0) then begin p:=BASS_Init(-1,44100,BASS_DEVICE_3D,0,nil); if not p then p:=BASS_Init(-1,44100,0,0,nil); end; if not p then begin ErrorCustom('Can''t initialize device'); result:=0; end else begin pc:=StrCopyW(StrCopyEW(buf,basspath),'bass*.dll'); fh:=FindFirstFileW(buf,fd); if fh<>INVALID_HANDLE_VALUE then begin repeat StrCopyW(pc,fd.cFileName); if BASS_PluginLoad(pAnsiChar(@buf),BASS_UNICODE)=0 then until not FindNextFileW(fh,fd); FindClose(fh); end; // enable ASX processing (if WMA loaded) BASS_SetConfig(BASS_CONFIG_NET_PLAYLIST, 2); // 2 - enable internet and local playlists fh:=DBReadByte(0,PluginName,optEAXType,0); if fh=0 then BASS_SetEAXParameters(-1,0,-1,-1) else BASS_SetEAXPreset(EAXItems[fh].code); result:=1; end; end; function GetMusicFormat:PAnsiChar; var bci:BASS_CHANNELINFO; begin BASS_ChannelGetInfo(chan,bci); case bci.ctype of BASS_CTYPE_STREAM_OGG: result:='OGG'; BASS_CTYPE_STREAM_MP1, BASS_CTYPE_STREAM_MP2, BASS_CTYPE_STREAM_MP3: result:='MP3'; BASS_CTYPE_STREAM_WMA, BASS_CTYPE_STREAM_WMA_MP3: result:='WMA'; {BASS_CTYPE_STREAM_AAC,}$10b00: result:='AAC'; {BASS_CTYPE_STREAM_MP4:}$10b01: result:='MP4'; {BASS_CTYPE_STREAM_AC3:}$11000: result:='AC3'; else result:=nil; end; end; function GetFileExt(buf:pWideChar;sign:pointer):pWideChar; var pc:pAnsiChar; begin result:=buf; pc:=GetMusicFormat; if pc=nil then begin StrCopyW(buf,'sav'); if sign<>nil then begin if pdword(sign)^=signOGG then StrCopyW(buf,'ogg') else if ((pdword(sign)^ and $00FFFFFF)=signID3) or (pword(sign)^=signMP3) then StrCopyW(buf,'mp3'); end; end else begin FastAnsiToWideBuf(pc,buf); LowerCase(buf); end; end; function MakeFileName(sign:pointer):pWideChar; var p,pcw:PWideChar; buf:pWideChar; begin // allocate buffer mGetMem(buf,MAX_PATH*SizeOf(WideChar)); // path if recpath<>nil then begin ConvertFileName(recpath,buf,ActiveContact); if not ForceDirectories(buf) then begin result:=nil; exit; end; pcw:=StrEndW(buf); if (pcw-1)^<>'\' then begin pcw^:='\'; inc(pcw); end; end else pcw:=buf; // name //!! p:=MakeMessage; pcw:=StrCopyEW(pcw,p); mFreeMem(p); if (pcw=buf) or ((pcw-1)^='\') then pcw:=StrEndW(IntToHex(pcw,GetCurrentTime)); // ext pcw^:='.'; inc(pcw); GetFileExt(pcw,sign); result:=buf; end; procedure StatusProc(buffer:Pointer;len,user:DWORD); stdcall; var pc:pWideChar; pb:PByte; i,sum:integer; flag:bool; doRecord:bool; begin flag:=true; doRecord:=CallService(MS_RADIO_COMMAND,MRC_RECORD,LPARAM(-1))<>0; if (buffer<>nil) and (len<>0) and SaveHeader then begin SaveHeader:=false; if pdword(buffer)^=signOGG then // if header ALL in buffer begin pb:=buffer; flag:=false; repeat inc(pb,OGGHdrSize); i:=pb^; //patterns sum:=0; inc(pb); while i>0 do begin inc(sum,pb^); inc(pb); dec(i); end; inc(pb,sum); //here must be next sign flag:=not flag; until not flag; hdrlen:=PAnsiChar(pb)-PAnsiChar(buffer); mGetMem(StationHeader,hdrlen); move(buffer^,StationHeader^,hdrlen); end; end; if (buffer=nil) or not doRecord then // end of stream or stop record begin if not doRecord or (doContRec=BST_UNCHECKED) then if hRecord<>0 then begin if buffer<>nil then // write tail BlockWrite(hRecord,buffer^,len); CloseHandle(hRecord); hRecord:=0; end; end else begin if len=0 then // HTTP or ICY tags begin { while PAnsiChar(buffer)^<>#0 do begin messagebox(0,PAnsiChar(buffer),'ICY-HTTP',0); while PAnsiChar(buffer)^<>#0 do inc(PAnsiChar(buffer)); inc(PAnsiChar(buffer)); end; } end else begin if doRecord then begin if hRecord=0 then begin pc:=MakeFileName(StationHeader); if pc<>nil then hRecord:=Rewrite(pc) else hRecord:=THANDLE(INVALID_HANDLE_VALUE); if hRecord=THANDLE(INVALID_HANDLE_VALUE) then hRecord:=0 else if flag and (StationHeader<>nil) then begin BlockWrite(hRecord,StationHeader^,hdrlen); // permissible to skip to the next Page (OggS) but this is not necessary end; mFreeMem(pc); end; if hRecord<>0 then BlockWrite(hRecord,buffer^,len); end; end; end; end; {$IFDEF Debug} procedure logmeta(tag,a,b:pansiChar); var f:thandle; p:pansichar; begin f:=Append(pansichar('mradio.log')); BlockWrite(f,tag^,StrLen(tag)); p:=#13#10; BlockWrite(f,p^,StrLen(p)); BlockWrite(f,a^,StrLen(a)); p:=#13#10; BlockWrite(f,p^,StrLen(p)); BlockWrite(f,b^,StrLen(b)); p:=#13#10; BlockWrite(f,p^,StrLen(p)); p:=#13#10; BlockWrite(f,p^,StrLen(p)); CloseHandle(f); end; {$ENDIF} function DoMeta(meta:PAnsiChar;TagType:int_ptr):Boolean; var pcw:pWideChar; buf:array [0..511] of AnsiChar; artist,title:PAnsiChar; oldartist,oldtitle:pAnsiChar; ppc,pc:pAnsiChar; idx,lcp:integer; needtofree:Boolean; CurDescrW:PWideChar; old:boolean; // tag:PAnsiChar; gotartist,gottitle:boolean; // indicate what we got artist/title begin result:=false; if meta=nil then meta:=BASS_ChannelGetTags(chan,TagType); if meta<>nil then begin // for cases when artist or title presents but empty gotartist:=false; gottitle :=false; needtofree:=false; lcp:=CP_UTF8; buf[0]:=#0; artist:=nil; title :=nil; CurDescrW:=nil; //tag:=meta; case TagType of BASS_TAG_WMA_META: begin pc:=StrPos(meta,'data='); if pc=meta then begin pc:=StrPos(meta,'artist='); if pc<>nil then begin gotartist:=true; mGetMem(artist,256); Decode(artist,pc+7); end; pc:=StrPos(meta,'title='); if pc<>nil then begin gottitle:=true; mGetMem(title,256); Decode(title,pc+6); end; pc:=StrPos(meta,'album='); if pc<>nil then begin end; pc:=StrPos(meta,'duration='); if pc<>nil then begin end; if not gotartist then begin if not gottitle then begin pc:=StrPos(meta,'caption='); if pc<>nil then begin gottitle:=true; mGetMem(title,256); Decode(title,pc+8); end; end; // analize title/caption for artist-title if gottitle then begin pc:=StrPos(title,' - '); if pc=nil then pc:=StrScan(title,'-'); if pc<>nil then begin artist:=title; if pc^=' ' then title:=pc+3 else title:=pc+1; pc^:=#0; CurDescrW:=pWideChar(artist); end else CurDescrW:=pWideChar(title); end; end else needtofree:=true; // to avoid mem leak and wrong tag process result:=true; end; StatusProc(nil,0,0); // split records here end; BASS_TAG_META: begin //tag:='SHOUTCAST'; // SHOUTCAST StreamTitle='xxx';StreamUrl='xxx'; // "Station=xyz" meta tag="Trackinfo" pc:=StrPos(meta,'StreamTitle='); if pc<>nil then begin inc(pc,13); ppc:=StrScan(pc,';'); if (ppc-pc-1)>0 then begin StrCopy(buf,pc,ppc-pc-1); lcp:=GetTextFormat(@buf,ppc-pc-1); end; end; if buf[0]<>#0 then begin case lcp of CP_UTF8: UTF8ToWide(buf,CurDescrW); CP_ACP : AnsiToWide(buf,CurDescrW,MirandaCP); end; end; gottitle:=true; title:=pAnsiChar(CurDescrW); pcw:=StrPosW(CurDescrW,' - '); if pcw=nil then pcw:=StrScanW(CurDescrW,'-'); if pcw<>nil then begin artist:=pAnsiChar(CurDescrW); if pcw^=' ' then title:=pAnsiChar(pcw+3) else title:=pAnsiChar(pcw+1); pcw^:=#0; end; lcp:=CP_UNICODE; StatusProc(nil,0,0); // split records here result:=true; end; BASS_TAG_ID3: begin // not realized, anyway - at the end of track end; BASS_TAG_ID3V2: begin end; BASS_TAG_APE, // not sure, need to check. maybe better process BASS_TAG_APEBINARY BASS_TAG_WMA, BASS_TAG_OGG: begin //tag:='OGG'; while meta^<>#0 do begin CharLowerA(StrCopy(buf,meta,10)); if StrCmp(buf,'title',5)=0 then begin title:=meta+6; gottitle:=true; end else if StrCmp(buf,'artist',6)=0 then begin artist:=meta+7; gotartist:=true; end; if gotartist and gottitle then break; while meta^<>#0 do inc(meta); inc(meta); end; if (not gotartist) and gottitle then begin pc:=StrPos(title,' - '); if pc=nil then pc:=StrScan(title,'-'); if pc<>nil then begin needtofree:=true; StrDup(artist,title,pc-title); if pc^=' ' then idx:=3 else idx:=1; StrDup(title,pc+idx); end; end; buf[0]:=#0; end; end; old:=true; if gotartist or gottitle then begin // check for old oldartist:=nil; oldtitle :=nil; case lcp of CP_UTF8: begin if gotartist then begin oldartist:=DBReadUTF8(0,PluginName,optArtist); if StrCmp(artist,oldartist)<>0 then old:=false; end; if old and gottitle then begin oldtitle:=DBReadUTF8(0,PluginName,optTitle); if StrCmp(title,oldtitle)<>0 then old:=false; end; if not old then begin DBWriteUTF8(0,PluginName,optArtist,artist); DBWriteUTF8(0,PluginName,optTitle ,title); end; end; CP_UNICODE:begin if gotartist then begin oldartist:=pAnsiChar(DBReadUnicode(0,PluginName,optArtist)); if StrCmpW(pWideChar(artist),pWideChar(oldartist))<>0 then old:=false; end; if old and gottitle then begin oldtitle:=pAnsiChar(DBReadUnicode(0,PluginName,optTitle)); if StrCmpW(pWideChar(title),pWideChar(oldtitle))<>0 then old:=false; end; if not old then begin DBWriteUnicode(0,PluginName,optArtist,pWideChar(artist)); DBWriteUnicode(0,PluginName,optTitle ,pWideChar(title)); end; end; end; {$IFDEF Debug} logmeta(tag,artist,title); {$ENDIF} mFreeMem(oldartist); mFreeMem(oldtitle); mFreeMem(CurDescrW); if needtofree then begin mFreeMem(artist); mFreeMem(title ); end; end; if not old then CallService(MS_RADIO_COMMAND,MRC_STATUS,RD_STATUS_NEWTAG); end; end; procedure MetaSync(handle:HSYNC;channel,data:dword;user:pointer); stdcall; //var tagtype:Integer; begin (* if handle=syncOGG then tagtype:=BASS_TAG_OGG else if handle=syncWMA then tagtype:=BASS_TAG_WMA else if handle=syncWMA1 then tagtype:=BASS_TAG_WMA_META else {if handle=syncMETA then} tagtype:=BASS_TAG_META; *) DoMeta(nil{PAnsiChar(data)},int_ptr(user){tagtype}); end; procedure EndSync(handle:HSYNC;channel,data:dword;user:pointer); stdcall; var lContact:cardinal; begin if RemoteSong then begin lContact:=ActiveContact; CallService(MS_RADIO_COMMAND,MRC_STOP,0); CallService(MS_RADIO_COMMAND,MRC_PLAY,lContact) end else if plist<>nil then CallService(MS_RADIO_COMMAND,MRC_NEXT,0) else if doLoop=BST_UNCHECKED then CallService(MS_RADIO_COMMAND,MRC_STOP,0); end; type tICYField = record name :PAnsiChar; branch:PAnsiChar; option:PAnsiChar; end; const NumICYFields = 4; ICYFields: array [0..NumICYFields-1] of tICYField = ( (name:'icy-name:' ; branch:'CList' ; option:'MyHandle'), (name:'icy-genre:' ; branch:cPluginName ; option:'Genre'), (name:'icy-br:' ; branch:cPluginName ; option:'Bitrate'), (name:'icy-description'; branch:cPluginName ; option:'About') ); procedure ProcessStationData; var icy:PAnsiChar; i,len:integer; begin // get the broadcast name and bitrate icy:=BASS_ChannelGetTags(chan,BASS_TAG_ICY); if icy=nil then icy:=BASS_ChannelGetTags(chan,BASS_TAG_HTTP); // no ICY tags, try HTTP if icy<>nil then begin while icy^<>#0 do begin for i:=0 to NumICYFields-1 do begin with ICYFields[i] do begin len:=StrLen(name); if StrCmp(icy,name,len)=0 then begin if DBReadStringLength(ActiveContact,branch,option)=0 then DBWriteString(ActiveContact,branch,option,icy+len); break; end; end; end; while icy^<>#0 do inc(icy); inc(icy); end; end; end; procedure OpenURL(url:PWideChar); cdecl; var len,progress:DWORD; flags:dword; i:integer; EAXUsed:bool; ansiurl:array [0..511] of AnsiChar; begin if plist=nil then CallService(MS_RADIO_COMMAND,MRC_STATUS,RD_STATUS_CONNECT); EAXUsed:=DBReadByte(0,PluginName,optEAXType,0)<>0; {} for i:=0 to NumTries-1 do begin if EAXUsed then flags:=BASS_STREAM_STATUS or BASS_SAMPLE_3D or BASS_SAMPLE_MONO else begin if ForcedMono<>BST_UNCHECKED then flags:=BASS_STREAM_STATUS or BASS_SAMPLE_MONO else flags:=BASS_STREAM_STATUS; end; flags:=flags or BASS_UNICODE; if RemoteSong then begin SaveHeader:=true; chan:=BASS_StreamCreateURL(url,0,flags,@StatusProc,nil) end else begin if (plist=nil) and (doLoop<>BST_UNCHECKED) then flags:=flags or BASS_SAMPLE_LOOP; chan:=BASS_StreamCreateFile(FALSE,url,0,0,flags); end; if (chan=0) and EAXUsed then begin flags:=flags and not (BASS_SAMPLE_3D or BASS_SAMPLE_MONO); if ForcedMono<>BST_UNCHECKED then flags:=flags or BASS_SAMPLE_MONO; if RemoteSong then chan:=BASS_StreamCreateURL({ansi}url,0,flags,@StatusProc,nil) else chan:=BASS_StreamCreateFile(FALSE,url,0,0,flags); end; if (chan=0) and RemoteSong then begin if BASS_ErrorGetCode=BASS_ERROR_FILEOPEN then begin flags:=flags and not BASS_UNICODE; chan:=BASS_StreamCreateURL(FastWideToAnsiBuf(url,ansiurl),0,flags,@StatusProc,nil) end; end; if chan<>0 then break; end; {} if chan=0 then begin if (CallService(MS_RADIO_COMMAND,MRC_STATUS,RD_STATUS_GET)=RD_STATUS_ABORT) or (plist=nil) then begin CallService(MS_RADIO_COMMAND,MRC_STOP,1); end else if plist<>nil then CallService(MS_RADIO_COMMAND,MRC_NEXT,0); end else begin CallService(MS_RADIO_COMMAND,MRC_STATUS,RD_STATUS_NEWTRACK); if RemoteSong then begin if isEQ_OFF=BST_UNCHECKED then EQ_ON; {$IFDEF CHANGE_NAME_BUFFERED} icy:=DBReadString(ActiveContact,strCList,optMyHandle); mGetMem(url,StrLen(icy)+6); StrCopy(url+6,icy); mFreeMem(icy); url[0]:='['; url[1]:=#0; url[4]:=']'; url[5]:=' '; {$ENDIF} progress:=0; repeat if CallService(MS_RADIO_COMMAND,MRC_STATUS,RD_STATUS_GET)=RD_STATUS_ABORT then begin CallService(MS_RADIO_COMMAND,MRC_STOP,1); exit; end; len:=BASS_StreamGetFilePosition(chan,BASS_FILEPOS_END); if len=DW_ERROR then break; progress:=BASS_StreamGetFilePosition(chan, BASS_FILEPOS_DOWNLOAD); if progress=dword(-1) then break; progress:=(progress- BASS_StreamGetFilePosition(chan,BASS_FILEPOS_CURRENT))*100 div len; // percentage of buffer filled {$IFDEF CHANGE_NAME_BUFFERED} IntToStr(url+1,progress,2); url[3]:='%'; DBWriteString(ActiveContact,strCList,optMyHandle,url); {$ENDIF} until progress>sPreBuf; {$IFDEF CHANGE_NAME_BUFFERED} if url[1]<>#0 then DBWriteString(ActiveContact,strCList,optMyHandle,url+6); mFreeMem(url); {$ENDIF} ProcessStationData; // process ICY-headers // get the stream title and set sync for subsequent titles DoMeta(nil,BASS_TAG_META); syncMETA:=BASS_ChannelSetSync(chan,BASS_SYNC_META ,0,@MetaSync,pointer(BASS_TAG_META)); syncOGG :=BASS_ChannelSetSync(chan,BASS_SYNC_OGG_CHANGE,0,@MetaSync,pointer(BASS_TAG_OGG)); syncWMA :=BASS_ChannelSetSync(chan,BASS_SYNC_WMA_CHANGE,0,@MetaSync,pointer(BASS_TAG_WMA)); syncWMA1:=BASS_ChannelSetSync(chan,BASS_SYNC_WMA_META ,0,@MetaSync,pointer(BASS_TAG_WMA_META)); end else begin if not DoMeta(nil,BASS_TAG_OGG) then if not DoMeta(nil,BASS_TAG_ID3V2) then if not DoMeta(nil,BASS_TAG_ID3) then if not DoMeta(nil,BASS_TAG_APE) then ; end; syncEND:=BASS_ChannelSetSync(chan,BASS_SYNC_END,0,@EndSync,nil); SetSndVol(-1); // play it! BASS_ChannelPlay(chan,FALSE); end; end;