home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Delphi.5 / Samples / sourceD5 / browutil.exe / BROWSER / COMPARE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-03  |  8.7 KB  |  310 lines
  1. unit Compare;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   FileCtrl, StdCtrls, ExtCtrls, Db, DBTables, Grids, DBGrids, Menus;
  8.  
  9. type
  10.   TFrmCompare = class(TForm)
  11.     Panel1: TPanel;
  12.     GroupBox1: TGroupBox;
  13.     DriveComboBox1: TDriveComboBox;
  14.     DirectoryListBox1: TDirectoryListBox;
  15.     FileListBox1: TFileListBox;
  16.     GroupBox2: TGroupBox;
  17.     DriveComboBox2: TDriveComboBox;
  18.     DirectoryListBox2: TDirectoryListBox;
  19.     FileListBox2: TFileListBox;
  20.     tblSource: TTable;
  21.     tblTarget: TTable;
  22.     Panel4: TPanel;
  23.     Panel2: TPanel;
  24.     GroupBox4: TGroupBox;
  25.     Memo1: TMemo;
  26.     Panel3: TPanel;
  27.     BtnStart: TButton;
  28.     BtnCancel: TButton;
  29.     BtnClose: TButton;
  30.     DBGSource: TDBGrid;
  31.     DBGTarget: TDBGrid;
  32.     SrcSource: TDataSource;
  33.     SrcTarget: TDataSource;
  34.     BtnCheck: TButton;
  35.     Splitter1: TSplitter;
  36.     Splitter2: TSplitter;
  37.     PopupMenu1: TPopupMenu;
  38.     Scatter1: TMenuItem;
  39.     Gather1: TMenuItem;
  40.     N1: TMenuItem;
  41.     New1: TMenuItem;
  42.     Insert1: TMenuItem;
  43.     Edit1: TMenuItem;
  44.     Delete1: TMenuItem;
  45.     N2: TMenuItem;
  46.     Save1: TMenuItem;
  47.     Revert1: TMenuItem;
  48.     procedure BtnCloseClick(Sender: TObject);
  49.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  50.     procedure BtnStartClick(Sender: TObject);
  51.     procedure Scatter1Click(Sender: TObject);
  52.     procedure Gather1Click(Sender: TObject);
  53.     procedure FileListBox1Click(Sender: TObject);
  54.     procedure FileListBox2Click(Sender: TObject);
  55.     procedure BtnCheckClick(Sender: TObject);
  56.     procedure BtnCancelClick(Sender: TObject);
  57.     procedure New1Click(Sender: TObject);
  58.     procedure Insert1Click(Sender: TObject);
  59.     procedure Edit1Click(Sender: TObject);
  60.     procedure Delete1Click(Sender: TObject);
  61.     procedure Save1Click(Sender: TObject);
  62.     procedure Revert1Click(Sender: TObject);
  63.   private
  64.     { Private declarations }
  65.     lAbortProcess : Boolean;
  66. //    aTableStructure, aFieldContent : Array [0..500] of string;
  67.     function FileCompare(Source, Target : TFileListBox) : Boolean;
  68.     function Compare(tblSource,tblTarget : TTable) : Boolean;
  69.     procedure WriteLog(sString : String);
  70.     procedure CheckFiles(tblFiles : TTable; FileListBox : TFileListBox);
  71.   public
  72.     { Public declarations }
  73.   end;
  74.  
  75. var
  76.   FrmCompare: TFrmCompare;
  77.  
  78. implementation
  79.  
  80. uses GenFunc, Menu, Literals;
  81.  
  82. {$R *.DFM}
  83.  
  84. procedure TFrmCompare.BtnCloseClick(Sender: TObject);
  85. begin
  86.   Close;
  87. end;
  88.  
  89. procedure TFrmCompare.FormClose(Sender: TObject; var Action: TCloseAction);
  90. begin
  91.   Action := caFree;
  92. end;
  93.  
  94. procedure TFrmCompare.WriteLog(sString : String);
  95. begin
  96.   Memo1.Lines.Add(sString);
  97. end;
  98.  
  99. function TFrmCompare.Compare(tblSource,tblTarget : TTable) : Boolean;
  100. var
  101.   I : Integer;
  102.   TarFieldName : TField;
  103. begin
  104.   for I := 0 to tblSource.FieldDefs.Count - 1 do begin
  105.     TarFieldName := nil;
  106.     TarFieldName := tblTarget.FindField(tblSource.FieldDefs.Items[I].Name);
  107.     if (TarFieldName <> nil) then begin
  108.         if (TarFieldName.DataType <> tblSource.FieldDefs.Items[I].DataType) then begin
  109.           WriteLog('     '+tblSource.FieldDefs.Items[I].Name +' Field data type is different');
  110.           WriteLog('      ('+FindFieldType(tblSource.FieldDefs.Items[I].DataType)+' - '+FindFieldType(TarFieldName.DataType)+')');
  111.         end;
  112.         if (TarFieldName.Size <> tblSource.FieldDefs.Items[I].Size) then
  113.           WriteLog('     Field '+tblSource.FieldDefs.Items[I].Name + ' size is different');
  114.       end
  115.     else
  116.       WriteLog('     Field '+tblSource.FieldDefs.Items[I].Name + ' does not exist.');
  117.   end;
  118.   Application.ProcessMessages;
  119. end;
  120.  
  121. function TFrmCompare.FileCompare(Source, Target : TFileListBox) : Boolean;
  122. var
  123.   I : Integer;
  124. begin
  125.   Memo1.Lines.Clear;
  126.   Memo1.Refresh;
  127.   if Source.Items.Count = 0 then begin
  128.     MessageBeep(MB_ok);
  129.     Application.MessageBox('No source files were found for comparision',PChar(MB_Title),mb_Ok);
  130.     Exit
  131.   end;
  132.   tblSource.DataBaseName := Source.Directory;
  133.   tblTarget.DataBaseName := Target.Directory;
  134.   tblSource.DisableControls;
  135.   tblTarget.DisableControls;
  136.   for I := 0 to Source.Items.Count - 1 do begin
  137.     if lAbortProcess then
  138.       Break;
  139.     tblSource.TableName := Source.Items.Strings[I];
  140.     if not FileExists(tblTarget.DataBaseName+'\'+tblSource.TableName) then begin
  141.         WriteLog('File does not exists '+ Source.Items.Strings[I]);
  142.         Continue;
  143.       end
  144.     else begin
  145.         tblTarget.TableName := tblSource.TableName;
  146.         WriteLog('Comparing File '+ Source.Items.Strings[I]);
  147.       end;
  148.     tblSource.Active := True;
  149.     tblTarget.Active := True;
  150.     Compare(tblSource,tblTarget);
  151.     tblSource.Active := False;
  152.     tblTarget.Active := False;
  153.   end;
  154.   if lAbortProcess then
  155.     WriteLog('File Comparision terminated...')
  156.   else
  157.     WriteLog('File Comparision Completes...');
  158.   tblSource.EnableControls;
  159.   tblTarget.EnableControls;
  160. end;
  161.  
  162. procedure TFrmCompare.BtnStartClick(Sender: TObject);
  163. begin
  164.   lAbortProcess := False;
  165.   BtnStart.Enabled := False;
  166.   tblSource.Close;
  167.   tblTarget.Close;
  168.   FileCompare(FileListBox1,FileListBox2);
  169.   BtnStart.Enabled := True;
  170. end;
  171.  
  172. procedure TFrmCompare.Scatter1Click(Sender: TObject);
  173. var
  174.   Table1 : TTable;
  175. begin
  176.   if Self.ActiveControl.Name = 'DBGSource' then
  177.     Table1 := tblSource
  178.   else
  179.     Table1 := tblTarget;
  180.   Scatter(Table1, FrmMenu.aTableStructure, FrmMenu.aFieldContent);
  181. end;
  182.  
  183. procedure TFrmCompare.Gather1Click(Sender: TObject);
  184. var
  185.   Table1 : TTable;
  186. begin
  187.   if Self.ActiveControl.Name = 'DBGSource' then
  188.     Table1 := tblSource
  189.   else
  190.     Table1 := tblTarget;
  191.   Gather(Table1, FrmMenu.aTableStructure, FrmMenu.aFieldContent);
  192. end;
  193.  
  194. procedure TFrmCompare.FileListBox1Click(Sender: TObject);
  195. begin
  196.   tblSource.Active := False;
  197.   tblSource.DataBaseName := FileListBox1.Directory;
  198.   tblSource.TableName := FileListBox1.Items[FileListBox1.ItemIndex];
  199.   tblSource.Active := True;
  200. end;
  201.  
  202. procedure TFrmCompare.FileListBox2Click(Sender: TObject);
  203. begin
  204.   tblTarget.Active := False;
  205.   tblTarget.DataBaseName := FileListBox2.Directory;
  206.   tblTarget.TableName := FileListBox2.Items[FileListBox2.ItemIndex];
  207.   tblTarget.Active := True;
  208. end;
  209.  
  210. procedure TFrmCompare.BtnCheckClick(Sender: TObject);
  211. var
  212.   tblSoftware : TTable;
  213. begin
  214.   tblSoftware := TTable.Create(Self);
  215.   tblSoftware.DatabaseName := sWorkingDirectory;
  216.   tblSoftware.TableName := 'Ophthal.db';
  217.   tblSoftware.Active := True;
  218.   CheckFiles(tblSoftware,FileListBox1);
  219.   tblSoftware.Close;
  220.   tblSoftware.Free;
  221. end;
  222.  
  223. procedure TFrmCompare.CheckFiles(tblFiles : TTable; FileListBox : TFileListBox);
  224. var
  225.   lFound : Boolean;
  226.   I : Integer;
  227.   sMessage : String;
  228. begin
  229.   tblFiles.First;
  230.   Memo1.Lines.Clear;
  231.   while not tblFiles.EOF do begin
  232. //    if not FileExists(tblFiles.DataBaseName+'\'+tblFiles.FieldByName('FileName').AsString) then begin
  233.     lFound := False;
  234.     sMessage := 'File '+ tblFiles.FieldByName('FileName').AsString;
  235.     for I := 0 to FileListBox.Items.Count - 1 do begin
  236.       if UpperCase(tblFiles.FieldByName('FileName').AsString) = UpperCase(FileListBox.Items.Strings[I]) then begin
  237.         lFound := True;
  238.         WriteLog(sMessage + ' Found');
  239.         Break;
  240.       end;
  241.     end;
  242.     if not lFound then
  243.       WriteLog(sMessage + ' not found');
  244.     lFound := False;
  245.     tblFiles.Next;
  246.   end;
  247.   WriteLog('Completes');
  248. end;
  249.  
  250. procedure TFrmCompare.BtnCancelClick(Sender: TObject);
  251. begin
  252.   lAbortProcess := True;
  253. end;
  254.  
  255. procedure TFrmCompare.New1Click(Sender: TObject);
  256. begin
  257.   if Self.ActiveControl.Name = 'DBGSource' then
  258.     tblSource.Append
  259.   else
  260.     tblTarget.Append;
  261. end;
  262.  
  263. procedure TFrmCompare.Insert1Click(Sender: TObject);
  264. begin
  265.   if Self.ActiveControl.Name = 'DBGSource' then
  266.     tblSource.Insert
  267.   else
  268.     tblTarget.Insert;
  269. end;
  270.  
  271. procedure TFrmCompare.Edit1Click(Sender: TObject);
  272. begin
  273.   if Self.ActiveControl.Name = 'DBGSource' then
  274.     tblSource.Edit
  275.   else
  276.     tblTarget.Edit;
  277. end;
  278.  
  279. procedure TFrmCompare.Delete1Click(Sender: TObject);
  280. begin
  281.   if Self.ActiveControl.Name = 'DBGSource' then
  282.     tblSource.Delete
  283.   else
  284.     tblTarget.Delete;
  285. end;
  286.  
  287. procedure TFrmCompare.Save1Click(Sender: TObject);
  288. begin
  289.   if Self.ActiveControl.Name = 'DBGSource' then begin
  290.       if (tblSource.State in [dsInsert,dsEdit]) then
  291.         tblSource.Post;
  292.     end
  293.   else
  294.     if (tblTarget.State in [dsInsert,dsEdit]) then
  295.       tblTarget.Post;
  296. end;
  297.  
  298. procedure TFrmCompare.Revert1Click(Sender: TObject);
  299. begin
  300.   if Self.ActiveControl.Name = 'DBGSource' then begin
  301.       if (tblSource.State in [dsInsert,dsEdit]) then
  302.         tblSource.Cancel;
  303.     end
  304.   else
  305.     if (tblTarget.State in [dsInsert,dsEdit]) then
  306.       tblTarget.Cancel;
  307. end;
  308.  
  309. end.
  310.