You've already forked lazarus-ccr
6f8c048343
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1748 8e941d3f-bd1b-0410-a28a-d453659cc2b4
384 lines
10 KiB
ObjectPascal
Executable File
384 lines
10 KiB
ObjectPascal
Executable File
{ query FreeDB for audio cd title informations
|
|
written by Sebastian Kraft
|
|
sebastian_kraft@gmx.de
|
|
|
|
This software is free under the GNU Public License
|
|
|
|
(c)2005
|
|
}
|
|
|
|
unit cddb;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, CDrom, discid, lnet, config;
|
|
|
|
|
|
type
|
|
|
|
{ TCddbObject }
|
|
|
|
TCddbObject = class
|
|
year, genre, artist, album: string;
|
|
title: array[1..99] of string;
|
|
ErrorMsg, Status, QueryString: string;
|
|
CDromDrives : Array[1..10] of String;
|
|
DriveCount, NrTracks: byte;
|
|
Device: string;
|
|
ErrorCode: Integer;
|
|
Data: TStringList;
|
|
TOCEntries: array[1..99] of TTocEntry;
|
|
DiscID: integer;
|
|
query_send, data_ready, receiving_data:boolean;
|
|
function connect(server:string; port: word):boolean;
|
|
procedure callevents;
|
|
procedure query(drive, server:string; port: word);
|
|
procedure Parsedata;
|
|
function ReadTOC(drive:string):boolean;
|
|
constructor create;
|
|
destructor destroy;
|
|
private
|
|
{ private declarations }
|
|
orphantext: string;
|
|
Connection: TLTcp;
|
|
FServer, FUser, FSoftware, FVersion, FHostname: string;
|
|
FPort: word;
|
|
procedure OnReceiveProc(asocket: TLSocket);
|
|
procedure OnErrorProc(const msg: string; asocket: TLSocket);
|
|
procedure OnDisconnectProc(asocket: TLSocket);
|
|
procedure OnConnectProc(asocket: TLSocket);
|
|
public
|
|
{ public declarations }
|
|
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses functions;
|
|
|
|
|
|
type
|
|
|
|
{ TLEvents }
|
|
|
|
TLEvents = class
|
|
public
|
|
procedure DsProc(aSocket: TLSocket);
|
|
procedure ReProc(aSocket: TLSocket);
|
|
procedure ErProc(const msg: string; aSocket: TLSocket);
|
|
end;
|
|
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
{ TLEvents }
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
|
|
procedure TLEvents.DsProc(aSocket: TLSocket);
|
|
begin
|
|
|
|
end;
|
|
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
|
|
procedure TLEvents.ReProc(aSocket: TLSocket);
|
|
begin
|
|
|
|
end;
|
|
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
|
|
procedure TLEvents.ErProc(const msg: string; aSocket: TLSocket);
|
|
begin
|
|
|
|
end;
|
|
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
|
|
|
|
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
{ TCddbObject }
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
|
|
function TCddbObject.connect(server: string; port: word): boolean;
|
|
begin
|
|
|
|
end;
|
|
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
|
|
procedure TCddbObject.OnReceiveProc(asocket: TLSocket);
|
|
var s, s1, s2, tmp: string;
|
|
deleted: boolean;
|
|
posi: integer;
|
|
Errorcode2: integer;
|
|
begin
|
|
ErrorCode:=0;
|
|
s:='';
|
|
asocket.GetMessage(s);
|
|
writeln('Socket message length: ', Length(s));
|
|
if s<>'' then begin
|
|
if length(s)>3 then begin
|
|
posi:=pos(#13, s);
|
|
s1:=Copy(s, 1, 3);
|
|
if (posi<>0) then s2:=Copy(s, posi+2, 3);
|
|
try
|
|
TryStrToInt(s1, ErrorCode);
|
|
TryStrToInt(s2, ErrorCode2);
|
|
if Errorcode2 > 0 then Errorcode := Errorcode2;
|
|
except
|
|
end;
|
|
end;
|
|
writeln('-------------------------------------------------');
|
|
writeln(s);
|
|
writeln(errorcode);
|
|
writeln(s1);
|
|
writeln(s2);
|
|
writeln('-------------------------------------------------');
|
|
end;
|
|
|
|
if (ErrorCode=200) and query_send then begin
|
|
delete(s, 1, 4);
|
|
tmp:=copy(s, 1, pos(' ',s));
|
|
delete(s, 1, pos(' ', s));
|
|
s1:=copy(s, 1, pos(' ',s));
|
|
Connection.SendMessage('cddb read '+tmp+' '+s1+' '+#13+#10);
|
|
writeln('cddb read ',tmp,' ',s1,' ');
|
|
end;
|
|
|
|
if (ErrorCode=211) and query_send then begin
|
|
// delete(s, 1, 4);
|
|
delete(s, 1, pos(#10, s));
|
|
tmp:=copy(s, 1, pos(' ',s));
|
|
delete(s, 1, pos(' ', s));
|
|
s1:=copy(s, 1, pos(' ',s));
|
|
Connection.SendMessage('cddb read '+tmp+' '+s1+' '+#10+#13);
|
|
writeln('cddb read ',tmp,' ',s1,' ');
|
|
end;
|
|
|
|
|
|
if (ErrorCode=200) and (not query_send) then begin
|
|
Connection.SendMessage('cddb query '+QueryString+#10+#13);
|
|
writeln('cddb query '+QueryString);
|
|
query_send:=true;
|
|
end;
|
|
|
|
|
|
if (ErrorCode=210) and (query_send) then begin
|
|
artist:='';
|
|
album:='';
|
|
delete(s, 1, pos(#10, s));
|
|
receiving_data := true;
|
|
Data.Clear;
|
|
orphantext := '';
|
|
end;
|
|
|
|
if receiving_data then
|
|
begin
|
|
Data.Text := Data.Text + orphantext + s;
|
|
if not (s[Length(s)] in [#10,#13]) then
|
|
begin
|
|
orphantext := Data[Data.Count-1];
|
|
Data.Delete(Data.Count-1);
|
|
end;
|
|
// writeln(' v v v v v v v v v v v v v v v');
|
|
// writeln(Data.Text);
|
|
// writeln(' ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^');
|
|
if Data[Data.Count-1]= '.' then // End of data (".") in Count-1
|
|
begin
|
|
Parsedata;
|
|
album:=copy(artist, pos(' / ', artist)+3, length(artist)-pos(' / ', artist)+3);
|
|
delete(artist, pos(' / ', artist), length(artist)-pos(' / ', artist)+1);
|
|
album:=Latin1toUTF8(album);
|
|
data_ready:=true;
|
|
receiving_data := false;
|
|
writeln('CDDB data ready...');
|
|
end;
|
|
end;
|
|
|
|
s:='';
|
|
s1:='';
|
|
tmp:=''
|
|
end;
|
|
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
|
|
procedure TCddbObject.OnErrorProc(const msg: string; asocket: TLSocket);
|
|
begin
|
|
ErrorMsg:=msg;
|
|
writeln(ErrorMsg);
|
|
end;
|
|
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
|
|
procedure TCddbObject.OnDisconnectProc(asocket: TLSocket);
|
|
begin
|
|
writeln('lost connection');
|
|
end;
|
|
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
|
|
procedure TCddbObject.OnConnectProc(asocket: TLSocket);
|
|
var s:string;
|
|
begin
|
|
asocket.GetMessage(s);
|
|
writeln(s);
|
|
Connection.CallAction;
|
|
writeln('connected to cddb server, sending hello...');
|
|
asocket.SendMessage('cddb hello '+FUser+' '+FHostname+' '+FSoftware+' '+FVersion+#13+#10);
|
|
end;
|
|
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
|
|
procedure TCddbObject.callevents;
|
|
begin
|
|
Connection.CallAction;
|
|
end;
|
|
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
|
|
procedure TCddbObject.query(drive, server: string; port: word);
|
|
begin
|
|
if NrTracks>0 then begin
|
|
discid:=(CDDBDiscID(TOCEntries, NrTracks));
|
|
querystring:=GetCDDBQueryString(TOCEntries, NrTracks);
|
|
writeln(QueryString);
|
|
writeln(hexStr(discid, 8));
|
|
|
|
FServer:=server;
|
|
FPort:=port;
|
|
query_send:=false;
|
|
Connection.Connect(FServer, FPort);
|
|
end;
|
|
end;
|
|
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
|
|
procedure TCddbObject.Parsedata;
|
|
var
|
|
c: integer;
|
|
s: string;
|
|
i: integer;
|
|
begin
|
|
|
|
// TODO: initialize year, genre, artist, album, and title[n] to ''
|
|
for c := 0 to Data.Count-1 do
|
|
begin
|
|
s := Data[c];
|
|
{ deleted:=false;
|
|
if pos('#', s)=1 then begin
|
|
delete(s, 1, pos(#10, s));
|
|
deleted:=true;
|
|
end;
|
|
if pos('DISCID=', s)=1 then begin
|
|
delete(s, 1, pos(#10, s));
|
|
deleted:=true;
|
|
end; }
|
|
|
|
if (pos('DTITLE=', s)=1) and (artist='') then begin
|
|
artist:=Copy(s, 8, MaxInt);
|
|
artist:=Latin1toUTF8(artist);
|
|
delete(s, 1, pos(#10, s));
|
|
//deleted:=true;
|
|
end;
|
|
if pos('TTITLE', s)=1 then begin
|
|
TryStrToInt(Copy(s,7, Pos('=',s)-7 ), i);
|
|
inc(i);
|
|
title[i]:=Copy(s, pos('=', s)+1, MaxInt);
|
|
title[i]:=Latin1toUTF8(title[i]);
|
|
delete(s, 1, pos(#10, s));
|
|
if i>8 then
|
|
writeln('title ---> ',title[i]);
|
|
// deleted:=true;
|
|
end;
|
|
|
|
if (pos('EXTD=', s)=1) and (pos('YEAR:', s)<>0) then begin
|
|
year:=Copy(s, pos('YEAR:', s)+6, 4);
|
|
{ delete(s, 1, pos(#10, s));
|
|
deleted:=true; }
|
|
end;
|
|
|
|
{ if (pos('EXTD=', s)=1) then begin
|
|
delete(s, 1, pos(#10, s));
|
|
deleted:=true;
|
|
end;
|
|
|
|
if (pos('PLAYORDER', s)=1)then begin
|
|
delete(s, 1, pos(#10, s));
|
|
deleted:=true;
|
|
end;
|
|
|
|
if (pos('EXTT', s)=1)then begin
|
|
delete(s, 1, pos(#10, s));
|
|
deleted:=true;
|
|
end; }
|
|
{ if not deleted then delete(s, 1, pos(#10, s));}
|
|
|
|
end;
|
|
end;
|
|
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
|
|
function TCddbObject.ReadTOC(drive: string):boolean;
|
|
begin
|
|
NrTracks:=0;
|
|
Device:=drive;
|
|
Try
|
|
NrTracks:= ReadCDTOC(drive, TOCEntries);
|
|
except begin
|
|
result:=false;
|
|
NrTracks:=0;
|
|
end;
|
|
end;
|
|
if NrTracks>100 then NrTracks:=0;
|
|
end;
|
|
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
|
|
constructor TCddbObject.create;
|
|
var b: byte;
|
|
begin
|
|
Connection:=TLTcp.Create(nil);
|
|
Connection.OnConnect:=@OnConnectProc;
|
|
Connection.OnReceive:=@OnReceiveProc;
|
|
Connection.OnDisconnect:=@OnDisconnectProc;
|
|
Connection.OnError:=@OnErrorProc;
|
|
Data := TStringList.Create;
|
|
data_ready:=false;
|
|
receiving_data := false;
|
|
FUser:='cddbuser';
|
|
FSoftware:='cddbobject';
|
|
FVersion:='v0.1';
|
|
FHostname:='localhost';
|
|
Try
|
|
DriveCount:=GetCDRomDevices(CDromDrives);
|
|
Writeln(DriveCount,' CD-ROM drives autodetected');
|
|
For b:=1 to DriveCount do
|
|
Writeln('Drive ',b,' on device: ',CDRomDrives[b]);
|
|
Except
|
|
On E : exception do
|
|
Writeln(E.ClassName,' exception caught with message: ',E.Message);
|
|
end;
|
|
if DriveCount=0 then begin
|
|
CDromDrives[1]:=CactusConfig.CDRomDevice;
|
|
inc(DriveCount);
|
|
end;
|
|
Connection.CallAction;
|
|
end;
|
|
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
|
|
destructor TCddbObject.destroy;
|
|
begin
|
|
Connection.destroy;
|
|
Data.Destroy;
|
|
end;
|
|
|
|
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
|
|
begin
|
|
end.
|
|
|