home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / kompon / d3456 / ICQ.ZIP / ICQ / DBConverter / Unit1.pas < prev   
Pascal/Delphi Source File  |  2002-08-16  |  9KB  |  268 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, Classes, Controls, Forms,
  7.   StdCtrls, ICQDb, ICQWorks, ComCtrls, SysUtils;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Button1: TButton;
  12.     ProgressBar1: TProgressBar;
  13.     ICQDb1: TICQDb;
  14.     PageControl1: TPageControl;
  15.     TabSheet1: TTabSheet;
  16.     TabSheet2: TTabSheet;
  17.     StatusBar1: TStatusBar;
  18.     TabSheet3: TTabSheet;
  19.     TabSheet4: TTabSheet;
  20.     Memo1: TMemo;
  21.     Memo2: TMemo;
  22.     Memo3: TMemo;
  23.     ListView1: TListView;
  24.     procedure ICQDb1Error(Sender: TObject; Reason: Word);
  25.     procedure Button1Click(Sender: TObject);
  26.     procedure ICQDb1ParsingFinished(Sender: TObject);
  27.     procedure ICQDb1ParsingStarted(Sender: TObject);
  28.     procedure ICQDb1Progress(Sender: TObject; Progress: Byte);
  29.     procedure ICQDb1ContactFound(Sender: TObject; UIN: Cardinal; NickName,
  30.       FirstName, LastName, Email: String; Age, Gender: Byte;
  31.       LastUpdate: String; LastUpdateStamp: Cardinal);
  32.     procedure ICQDb1MessageFound(Sender: TObject; UIN: Cardinal;
  33.       Incoming: Boolean; Msg, RecvTime: String; RecvTimeStamp: Cardinal);
  34.     procedure FormCreate(Sender: TObject);
  35.     procedure ICQDb1SelfInfoFound(Sender: TObject; UIN: Cardinal; NickName,
  36.       FirstName, LastName, Email, Password: String; Age, Gender: Byte;
  37.       LastUpdate: String; LastUpdateStamp: Cardinal);
  38.     procedure FormDestroy(Sender: TObject);
  39.   private
  40.     FDbTypeList: TStringList;
  41.   public
  42.     { Public declarations }
  43.   end;
  44.  
  45. var
  46.   Form1: TForm1;
  47.  
  48. function GetDualIcqFiles(DbPath: String; var FList: TStringList): Boolean;
  49. function GetMirandaFiles(var FList: TStringList): Boolean;
  50.  
  51. implementation
  52.  
  53. {$R *.dfm}
  54.  
  55. procedure TForm1.ICQDb1Error(Sender: TObject; Reason: Word);
  56. begin
  57.   MessageBox(0, PChar('Error: ' + DbErrorToStr(Reason)), 'Error', MB_ICONERROR);
  58. end;
  59.  
  60. procedure TForm1.Button1Click(Sender: TObject);
  61. begin
  62.   Memo1.Lines.Clear;
  63.   Memo2.Lines.Clear;
  64.   Memo3.Lines.Clear;  
  65.   if ListView1.Selected = nil then
  66.   begin
  67.     MessageBox(0, 'Please select database', 'Error', MB_ICONERROR);
  68.     Exit;
  69.   end;
  70.   if FDbTypeList[ListView1.Selected.Index] = 'ICQ' then
  71.   begin
  72.     ICQDb1.DbType := DB_ICQ;
  73.     ICQDb1.DatFile := ListView1.Selected.Caption + '.dat';
  74.     ICQDb1.IdxFile := ListView1.Selected.Caption + '.idx';
  75.   end else
  76.   begin
  77.     ICQDb1.DbType := DB_MIRANDA;
  78.     ICQDb1.DatFile := ListView1.Selected.Caption + '.dat';
  79.   end;
  80.   ICQDb1.StartParsing;
  81. end;
  82.  
  83. procedure TForm1.ICQDb1ParsingFinished(Sender: TObject);
  84. begin
  85.   StatusBar1.Panels[0].Text := 'Parsing finished';
  86. end;
  87.  
  88. procedure TForm1.ICQDb1ParsingStarted(Sender: TObject);
  89. begin
  90.   StatusBar1.Panels[0].Text := 'Parsing started';
  91.   Application.ProcessMessages;
  92. end;
  93.  
  94. procedure TForm1.ICQDb1Progress(Sender: TObject; Progress: Byte);
  95. begin
  96.   ProgressBar1.Position := Progress;
  97.   Application.ProcessMessages;  
  98. end;
  99.  
  100. procedure TForm1.ICQDb1ContactFound(Sender: TObject; UIN: Cardinal;
  101.   NickName, FirstName, LastName, Email: String; Age, Gender: Byte;
  102.   LastUpdate: String; LastUpdateStamp: Cardinal);
  103. begin
  104.   if NickName <> '' then
  105.     Memo1.Lines.Add(IntToStr(UIN) + ' (' + NickName + ')')
  106.   else
  107.     Memo1.Lines.Add(IntToStr(UIN));
  108. end;
  109.  
  110. procedure TForm1.ICQDb1MessageFound(Sender: TObject; UIN: Cardinal;
  111.   Incoming: Boolean; Msg, RecvTime: String; RecvTimeStamp: Cardinal);
  112. begin
  113.   if Incoming then
  114.     Memo2.Lines.Add('From ' + IntToStr(UIN) + ': ' + Msg)
  115.   else
  116.     Memo2.Lines.Add('To ' + IntToStr(UIN) + ': ' + Msg);
  117. end;
  118.  
  119. procedure TForm1.FormCreate(Sender: TObject);
  120. var
  121.   RegKeyHandle: HKEY;
  122.   StrBuffer: array[0..2047] of Char;
  123.   DataType, BufSize: Integer;
  124.   DbPaths: TStringList;
  125.   i, n: Word;
  126.   l: TStringList;
  127.   item: TListItem;
  128.  
  129.   procedure QueryReg(Where: HKEY);
  130.   begin
  131.     if (RegOpenKey(Where, PChar('SOFTWARE\Mirabilis\ICQ\DefaultPrefs'), RegKeyHandle) = ERROR_SUCCESS) then
  132.     begin
  133.       if RegQueryValueEx(RegKeyHandle, PChar('99b Database'), nil, @DataType, PByte(@StrBuffer), @BufSize) = ERROR_SUCCESS then
  134.          DbPaths.Add(Copy(StrBuffer, 0, BufSize));
  135.       if RegQueryValueEx(RegKeyHandle, PChar('2000a Database'), nil, @DataType, PByte(@StrBuffer), @BufSize) = ERROR_SUCCESS then
  136.          DbPaths.Add(Copy(StrBuffer, 0, BufSize));
  137.       if RegQueryValueEx(RegKeyHandle, PChar('2000b Database'), nil, @DataType, PByte(@StrBuffer), @BufSize) = ERROR_SUCCESS then
  138.          DbPaths.Add(Copy(StrBuffer, 0, BufSize));
  139.       if RegQueryValueEx(RegKeyHandle, PChar('2001a Database'), nil, @DataType, PByte(@StrBuffer), @BufSize) = ERROR_SUCCESS then
  140.          DbPaths.Add(Copy(StrBuffer, 0, BufSize));
  141.       if RegQueryValueEx(RegKeyHandle, PChar('2002a Database'), nil, @DataType, PByte(@StrBuffer), @BufSize) = ERROR_SUCCESS then
  142.          DbPaths.Add(Copy(StrBuffer, 0, BufSize));
  143.     end;
  144.     RegCloseKey(RegKeyHandle);
  145.   end;
  146. begin
  147.   FDbTypeList := TStringList.Create;
  148.   DbPaths := TStringList.Create;
  149.   {Find Miranda-icq database files.}
  150.   if GetMirandaFiles(DbPaths) then
  151.     for i := 0 to DbPaths.Count - 1 do
  152.     begin
  153.       item := ListView1.Items.Add;
  154.       item.Caption := DbPaths.Strings[i];
  155.     end;
  156.   DbPaths.Clear;
  157.   {Find ICQ database files.}
  158.   QueryReg(HKEY_LOCAL_MACHINE);
  159.   QueryReg(HKEY_CURRENT_USER);
  160.   if DbPaths.Count > 0 then
  161.      for i := 0 to DbPaths.Count - 1 do
  162.      begin
  163.        l := TStringList.Create;
  164.        GetDualIcqFiles(DbPaths.Strings[i],  l);
  165.        if l.Count > 0 then
  166.          for n := 0 to l.Count - 1 do
  167.          begin
  168.           Form1.FDbTypeList.Add('ICQ');         
  169.           item := ListView1.Items.Add;
  170.           item.Caption := DbPaths.Strings[i] + '\' + l.Strings[n];
  171.          end;
  172.        l.Free;
  173.      end;
  174.   DbPaths.Free;
  175.   if ListView1.Items.Count < 1 then
  176.     MessageBox(Form1.Handle, 'Sorry no database files were found in your system, please set the paths manually', 'Error', MB_ICONERROR);
  177. end;
  178.  
  179. function GetDualIcqFiles(DbPath: String; var FList: TStringList): Boolean;
  180. var
  181.   fd: TWin32FindData;
  182.   hs: THandle;
  183.   FNames: TStringList;
  184.   S: String;
  185.   n: LongWord;
  186. begin
  187.   FList.Clear;
  188.   FNames := TStringList.Create;
  189.   fd.dwFileAttributes := FILE_ATTRIBUTE_NORMAL;
  190.   hs := FindFirstFile(PChar(DbPath + '\*.*'), fd);
  191.   if hs <> INVALID_HANDLE_VALUE then
  192.   begin
  193.     repeat
  194.       if AnsiLowerCase(Copy(fd.cFileName, LastDelimiter('.', fd.cFileName) + 1, Length(fd.cFileName) - LastDelimiter('.', fd.cFileName))) = 'dat' then
  195.         FNames.Add(fd.cFileName)
  196.       else if AnsiLowerCase(Copy(fd.cFileName, LastDelimiter('.', fd.cFileName) + 1, Length(fd.cFileName) - LastDelimiter('.', fd.cFileName))) = 'idx' then
  197.         FNames.Add(fd.cFileName);
  198.     until not FindNextFile(hs, fd);
  199.     Windows.FindClose(hs);
  200.   end;
  201.  
  202.   if FNames.Count > 0 then
  203.     for n := 0 to FNames.Count - 1 do
  204.       if AnsiLowerCase(Copy(FNames.Strings[n], LastDelimiter('.', FNames.Strings[n]) + 1, Length(FNames.Strings[n]) - LastDelimiter('.', FNames.Strings[n]))) = 'dat' then
  205.       begin
  206.         S := Copy(FNames.Strings[n], 0, LastDelimiter('.', FNames.Strings[n]) - 1);
  207.         if FNames.IndexOf(S + '.idx') <> -1 then
  208.           FList.Add(S);
  209.       end;
  210.   FNames.Free;
  211.   Result := FList.Count > 0;
  212. end;
  213.  
  214. function GetMirandaFiles(var FList: TStringList): Boolean;
  215. var
  216.   fd: TWin32FindData;
  217.   hs: THandle;
  218.   Path: String;
  219.   RegKeyHandle: HKEY;
  220.   StrBuffer: array[0..2048] of Char;
  221.   DataType, BufSize: Integer;
  222. begin
  223.   Path := ''; Result := False;
  224.   DataType := REG_SZ; BufSize := SizeOf(StrBuffer) - 1;
  225.   if (RegOpenKey(HKEY_LOCAL_MACHINE, PChar('SOFTWARE\Miranda'), RegKeyHandle) = ERROR_SUCCESS) and
  226.      (RegQueryValueEx(RegKeyHandle, PChar('Install_Dir'), nil, @DataType, PByte(@StrBuffer), @BufSize) = ERROR_SUCCESS) then
  227.        Path := StrBuffer;
  228.   RegCloseKey(RegKeyHandle);
  229.   {Exit if there is no install_dir found}
  230.   if Path = '' then
  231.     Exit;
  232.  
  233.   fd.dwFileAttributes := FILE_ATTRIBUTE_NORMAL;
  234.   hs := FindFirstFile(PChar(Path + '\*.*'), fd);
  235.   if hs <> INVALID_HANDLE_VALUE then
  236.   begin
  237.     repeat
  238.       if AnsiLowerCase(Copy(fd.cFileName, LastDelimiter('.', fd.cFileName) + 1, Length(fd.cFileName) - LastDelimiter('.', fd.cFileName))) = 'dat' then
  239.       begin
  240.         FList.Add(Path + '\' + Copy(fd.cFileName, 0, LastDelimiter('.', fd.cFileName) - 1));
  241.         Form1.FDbTypeList.Add('Miranda');
  242.         Result := True;
  243.       end;
  244.     until not FindNextFile(hs, fd);
  245.     Windows.FindClose(hs);
  246.   end;
  247. end;
  248.  
  249. procedure TForm1.ICQDb1SelfInfoFound(Sender: TObject; UIN: Cardinal;
  250.   NickName, FirstName, LastName, Email, Password: String; Age,
  251.   Gender: Byte; LastUpdate: String; LastUpdateStamp: Cardinal);
  252. begin
  253.   Memo3.Lines.Add('UIN: ' + IntToStr(UIN));
  254.   Memo3.Lines.Add('NickName: ' + NickName);
  255.   Memo3.Lines.Add('FirstName: ' + FirstName);
  256.   Memo3.Lines.Add('LastName: ' + LastName);
  257.   Memo3.Lines.Add('Email: ' + Email);
  258.   Memo3.Lines.Add('Password: ' + Password);
  259.   Memo3.Lines.Add('Last update: ' + LastUpdate);
  260. end;
  261.  
  262. procedure TForm1.FormDestroy(Sender: TObject);
  263. begin
  264.   FDbTypeList.Free;
  265. end;
  266.  
  267. end.
  268.