DiskCDDBInfo.pas
上传用户:wanyu_2000
上传日期:2021-02-21
资源大小:527k
文件大小:5k
源码类别:

DVD

开发平台:

Delphi

  1. unit DiskCDDBInfo;
  2. interface
  3. Uses WinInet, Windows, Sysutils, Classes;
  4. Const
  5.      CDDBServer   = 'Freedb.Freedb.org';
  6.      CDDBCmdStr   = '/~cddb/cddb.cgi?cmd=';
  7.      CDDBCmdHello = '&hello=AudioUser+hostname+FreeBurner+1.0&proto=4';
  8. Type
  9.    TCDDBQuery = Class
  10.    private
  11.     FCDDBID : String;
  12.     FAlbum  : String;
  13.     FArtist : String;
  14.     FCategory  : String;
  15.     FYear   : String;
  16.     FErrorCode : Integer;
  17.     FTracks : TStringList;
  18.     FEXTData : TStringList;
  19.     FWEBText : String;
  20.     FApplicationName : String;
  21.     function GetAlbum: string;
  22.     function GetArtist: string;
  23.     function GetCategory: string;
  24.     function GetYear: string;
  25.     function GetCDDBRead: String;
  26.     function GetInetFile(FileURL: String): boolean;
  27.     procedure ReadCDInfoFromData;
  28.    Public
  29.     constructor Create;
  30.     destructor Destroy; override;
  31.     procedure ClearCDDB;
  32.     Procedure GetCDDBInfo;
  33.    Published
  34.     property ApplicationName : String read FApplicationName write FApplicationName;
  35.     property CDDBID  : String read FCDDBID write FCDDBID;
  36.     property Artist  : string read GetArtist;
  37.     property Album   : string read GetAlbum;
  38.     property Tracks  : TStringlist read FTracks;
  39.     property Category: string read GetCategory;
  40.     property Year    : string read GetYear;
  41.   end;
  42. implementation
  43. constructor TCDDBQuery.Create;
  44. begin
  45.   FTracks := TStringList.create;
  46.   FEXTData := TStringList.create;
  47. end;
  48. destructor TCDDBQuery.Destroy;
  49. begin
  50.     FTracks.free;
  51.     FEXTData.free;
  52.     Inherited Destroy;
  53. end;
  54. function TCDDBQuery.GetCDDBRead: String;
  55. begin
  56.   if FCDDBID <>'' then
  57.     Result := 'http://'+CDDBServer + CDDBCmdStr + 'cddb+read+' + FCategory + '+' + FCDDBID
  58.   else
  59.     Result := 'http://'+CDDBServer + CDDBCmdStr + 'cddb+read+' + FCategory;
  60.   Result := LowerCase(Result) + CDDBCmdHello;
  61.   //http://Freedb.Freedb.org/~cddb/cddb.cgi?cmd=cddb+read+rock+c611cd0e&hello=AudioUser+hostname+FreeBurner+1.0&proto=4
  62. end;
  63. function TCDDBQuery.GetAlbum: string;
  64. begin
  65.   Result := FAlbum;
  66. end;
  67. function TCDDBQuery.GetArtist: string;
  68. begin
  69.   Result := FArtist;
  70. end;
  71. function TCDDBQuery.GetCategory: string;
  72. begin
  73.   Result := FCategory;
  74. end;
  75. function TCDDBQuery.GetYear: string;
  76. begin
  77.   Result := FYear;
  78. end;
  79. procedure TCDDBQuery.ClearCDDB;
  80. begin
  81.     FCategory:='';
  82.     FArtist:='';
  83.     FAlbum:='';
  84.     FYear:='';
  85.     FTracks.clear;
  86.     FEXTData.Clear;
  87. end;
  88. function TCDDBQuery.GetInetFile(FileURL: String): boolean;
  89. const BufferSize = 16384;
  90. var
  91.   hSession, hURL: HInternet;
  92.   Buffer   : PChar;
  93.   BuffStr : String;
  94.   sAppName: string;
  95.   FBytesRead : dword;
  96.   RC : boolean;
  97. begin
  98.  Result := False;
  99.  FWEBText := '';
  100.  sAppName := ExtractFileName(FApplicationName);
  101.  hSession := InternetOpen(PChar(sAppName),INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0);
  102.  try
  103.   hURL := InternetOpenURL(hSession,PChar(FileURL),nil,0,0,0);
  104.   try
  105.     GetMem(Buffer,BufferSize);
  106.    repeat
  107.     rc := InternetReadFile(hURL,Buffer,BufferSize,FBytesRead);
  108.     BuffStr := Buffer;
  109.     FWEBText := FWEBText + Copy(BuffStr,1,FBytesRead);
  110.     Sleep(0);
  111.    until not RC or (FBytesRead = 0);
  112.    Result := True;
  113.   finally
  114.    InternetCloseHandle(hURL)
  115.   end
  116.  finally
  117.   InternetCloseHandle(hSession)
  118.  end
  119. end;
  120. procedure TCDDBQuery.ReadCDInfoFromData;
  121. var
  122.   i,si,p,j :integer;
  123.   CDBString, StatusID : string;
  124.   sl : TStringList;
  125.   Position : integer;
  126. begin
  127.   ClearCDDB;
  128.   si := 0;
  129.   sl := TStringList.Create;
  130.   sl.text := FWEBText;
  131.   CDBString :='';
  132.   CDBString := sl.Strings[0];    // 210 rock c611cd0e
  133.   // get status
  134.   Position := pos(' ',CDBString);
  135.   if Position >0 then
  136.   begin
  137.      StatusID := trim(Copy(CDBString,1,Position));
  138.      delete(CDBString,1,Position);
  139.   end;
  140.   // get category
  141.   if StatusID = '210' then
  142.    begin
  143.       Position := pos(' ',CDBString);
  144.     if Position >0 then
  145.      begin
  146.        FCategory := trim(Copy(CDBString,1,Position));
  147.      end;
  148.   CDBString := '';
  149.   for i := 0 to sl.Count -1 do
  150.     if pos('DTITLE=',sl[i]) = 1 then begin
  151.       CDBString := CDBString + copy(sl[i],system.Length('DTITLE=')+1,1024);
  152.       si := i;
  153.     end else
  154.       if CDBString<>'' then
  155.         Break;
  156.   p := pos(' / ',CDBString);
  157.   if p > 0 then
  158.    begin
  159.     FArtist := copy(CDBString,1,p-1);
  160.     FAlbum := copy(CDBString,p+3,1024);
  161.     FTracks.Add(Artist);
  162.     FTracks.Add(Album);
  163.   end;
  164.   j := 0;
  165.   FTracks.Clear;
  166.   for i := si + 1 to sl.count-1 do
  167.    begin
  168.     if pos('TTITLE',sl[i]) = 1 then begin
  169.       FTracks.Add(copy(sl[i],system.Length('TTITLE'+inttostr(j)+'=')+1,1024));
  170.       inc(j);
  171.     end
  172.      else
  173.       break;
  174.   end;
  175.   end;
  176.   sl.free;
  177. end;
  178. Procedure TCDDBQuery.GetCDDBInfo;
  179. var
  180.     CDDBQuery : String;
  181. begin
  182.   FCategory := 'rock';
  183.   CDDBQuery := GetCDDBRead;
  184.   If GetInetFile(CDDBQuery) = true then
  185.   begin
  186.     ReadCDInfoFromData;
  187.   end;
  188. end;
  189. end.