CD Shareware Magazine 1996 December/CD_shareware_12-96.iso/DOS/Database/SCAN.ZIP/UNIT1.PAS

Pascal/Delphi Source File | 1996-07-10 | 9.3 KB | 337 lines

unit Unit1;

{  SCAN - Table Scanning Utility 1.1 - Main Unit
   Copyright (c) 1996 by Martin Kelly, PDQ Technology Limited
   All rights reserved.

   This software should not be SOLD by anyone other than the author,
   Martin Kelly. It is distributed as freeware and therefore may be used
   free of charge.

   Comments:
   Compuserve ID: 100437,2243

   Payback:
   I have been downloading lots of interesting stuff from the Delphi forums
   for months, so I thought it was about time I uploaded something (useful?)
   on the basis that giving is apparently more spiritually rewarding than
   taking.

   Disclaimer:
   The author shall have no liability whatsoever in respect of the use of
   this program, and nor does the author warrant that the use of this program
   will be uninterrupted or error free. }

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, DB, Grids, DBGrids, DBTables, ExtCtrls, Buttons,
  DBCtrls, Menus, Unit2, Unit3;

type
  TMain = class(TForm)
    Table1: TTable;
    Table2: TTable;
    DBGrid1: TDBGrid;
    DBGrid2: TDBGrid;
    DataSource1: TDataSource;
    DataSource2: TDataSource;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    BitBtn1: TBitBtn;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Label1: TLabel;
    Label2: TLabel;
    OpenDialog1: TOpenDialog;
    DBNavigator1: TDBNavigator;
    OpenDialog2: TOpenDialog;
    BitBtn2: TBitBtn;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Help1: TMenuItem;
    Contents: TMenuItem;
    SpeedHelp: TSpeedButton;
    SpeedClose: TSpeedButton;
    SelectMastertable1: TMenuItem;
    SelecttabletoComparewithMaster1: TMenuItem;
    N1: TMenuItem;
    Cleartableselections1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    Comparethetables1: TMenuItem;
    N4: TMenuItem;
    About1: TMenuItem;
    procedure BitBtn1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure DBGrid1Enter(Sender: TObject);
    procedure DBGrid2Enter(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure SpeedCloseClick(Sender: TObject);
    procedure SpeedHelpClick(Sender: TObject);
    procedure About1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Main: TMain;

implementation

{$R *.DFM}

procedure TMain.BitBtn1Click(Sender: TObject);
var
F: TextFile;
S, Table1PrimIndxStr, Table2PrimIndxStr: String;
I: Integer;

BEGIN
{Check that both datasets are active}
 if not Table1.Active or not Table2.Active then
 begin
  MessageDlg('Table selections are incomplete.', mtError, [mbOk], 0);
  Abort;
 end;

{Check that the tables have the same number of fields}
 if IntToStr(DBGrid1.FieldCount)<>IntToStr(DBGrid2.FieldCount)then
 begin
  MessageDlg('Tables MUST have the same structure.', mtError, [mbOk], 0);
  Abort;
 end;

{Ensure that the most recent index information is used}
 Table1.IndexDefs.Update;
 Table2.IndexDefs.Update;

{Initialize String Variables}
 Table1PrimIndxStr := '';
 Table2PrimIndxStr := '';

{Try to locate primary index for both tables}
  for I := 0 to Table1.IndexDefs.Count - 1 do
     {Find primary index}
     if (ixPrimary in Table1.IndexDefs.Items[I].Options) then
     {Save the field names of the key to String Variable}
     Table1PrimIndxStr := Table1.IndexDefs.Items[I].Fields;
  for I := 0 to Table2.IndexDefs.Count - 1 do
     {Find primary index}
     if (ixPrimary in Table2.IndexDefs.Items[I].Options) then
     {Save the fields names of the key to String Variable}
     Table2PrimIndxStr := Table2.IndexDefs.Items[I].Fields;

{Check for primary index in Table1}
 if Table1PrimIndxStr = '' then
    begin
      MessageDlg(Table1.TableName + ' does not have a Primary Index.',
                 mtError, [mbOk], 0);
      Abort;
    end;

{Check for primary index in Table2}
 if Table2PrimIndxStr = '' then
    begin
      MessageDlg(Table2.TableName + ' does not have a Primary Index.',
                 mtError, [mbOk], 0);
      Abort;
    end;

{Compare primary index fields found in both tables}
 if Table1PrimIndxStr <> Table2PrimIndxStr then
    begin
     MessageDlg('Primary Index fields in tables do not match.',
                 mtError, [mbOk], 0);
     Abort;
    end;

{Prepare the text file}
 AssignFile(F, 'SCANLOG.TXT');
 Rewrite(F);
 Writeln(F, DateTimeToStr(Now));
 Writeln(F, '');
 Writeln(F, 'Master table: '+ OpenDialog1.FileName);

{Initialize String Variable}
 S := '';

{Use TRY..EXCEPT to trap exceptions..}
 TRY
 with Table1 do
 {Create a composite string with the key field names separated by ', '}
    for I := 0 to IndexFieldCount - 1 do
    S := S + ', ' + IndexFields[I].FieldName;

{Remove initial ', '}
 Delete(S,1,2);
 Writeln(F, 'Primary index: ' + S);
 Writeln (F,'');
 Writeln(F, 'Differences identified in '+ OpenDialog2.FileName);
 Writeln (F,'');
 {Goto first record in Table1}
 Table1.First;
  While not Table1.EOF do
   begin
     S := '';
     {Put Table2 in SetKey state}
     {Note - as no value has been assigned to the IndexName property then
             Primary Index is utilised. Delphi always open tables on its
             Primary Index.}
     Table2.SetKey;
     with Table1 do
     {Assign Values to be searched for in Table2 using Primary Key}
     for I := 0 to IndexFieldCount - 1 do
     Table2.Fields[I].AsString := IndexFields[I].AsString;
     with Table1 do
     {Create a composite string with the key field values separated by ', '}
      for I := 0 to IndexFieldCount - 1 do
      S := S + ', ' + IndexFields[I].AsString;
     {Remove initial ', '}
      Delete(S,1,2);
      if Table2.GotoKey then
     {Check field values in all fields}
      for I := 0 to Table1.FieldCount - 1 do
      begin
      if Table1.Fields[I].AsString <>
         Table2.Fields[I].AsString then
         Writeln(F, S + ': '+ Table2.Fields[I].FieldName + ' = '
         + (Table2.Fields[I].AsString));
      end
    else
    {Record must have been deleted from Table2}
     Writeln(F, S + ' is NOT found in '+ OpenDialog2.FileName);

     Table1.Next;
   end;

 {Checking for new records added to Table2}
 {Goto first record in Table2}
 Table2.First;
 While not Table2.EOF do
 begin
   {Put Table1 in SetKey state}
   {Note - as no value has been assigned to the IndexName property then
           Primary Index is utilised. Delphi always open tables on its
           Primary Index.}
    Table1.SetKey;
     with Table2 do
      {Assign Values to be searched for in Table1 using Primary Key}
      for I := 0 to IndexFieldCount - 1 do
      Table1.Fields[I].AsString := IndexFields[I].AsString;
     if not Table1.GotoKey then
     begin
     Writeln (F,'');
     Writeln(F, 'New record found in '+ OpenDialog2.FileName
             +' with these values:');
       for I := 0 to Table2.FieldCount - 1 do
           Writeln(F, Table2.Fields[I].FieldName + ' = '
           + (Table2.Fields[I].AsString));
     end;
   Table2.Next;
   end;
 {Tidy up}
 CloseFile(F);
 Table1.First;
 Table2.First;

 {Open Scanlog.txt using NOTEPAD.EXE}
 WinExec('NOTEPAD.EXE Scanlog.txt',SW_SHOWNORMAL);

 EXCEPT
  on EDatabaseError do
   begin
    MessageDlg('Problem detected when examining data tables.',
              mtError, [mbOk], 0);
    {Tidy up}
    CloseFile(F);
    Table1.First;
    Table2.First;
   end;
  on EDBEngineError do
   begin
    MessageDlg('Problem detected when examining data tables.',
              mtError, [mbOk], 0);
    {Tidy up}
    CloseFile(F);
    Table1.First;
    Table2.First;
   end;
 END;
END;

procedure TMain.SpeedButton1Click(Sender: TObject);
begin
 if OpenDialog1.Execute then
 begin
 Table1.Active := False;  {Ensure existing selection is deactivated}
 Label1.Caption := OpenDialog1.FileName;
 Table1.TableName := OpenDialog1.FileName;
 Table1.Active := True;
 end;
end;

procedure TMain.SpeedButton2Click(Sender: TObject);
begin
if OpenDialog2.Execute then
 begin
 Table2.Active := False;  {Ensure existing selection is deactivated}
 Label2.Caption := OpenDialog2.FileName;
 Table2.TableName := OpenDialog2.FileName;
 Table2.Active := True;
 end;
end;

procedure TMain.DBGrid1Enter(Sender: TObject);
begin
 {Assign DBNavigator to DataSource looking at Table1}
 DBNavigator1.DataSource := DataSource1;
end;

procedure TMain.DBGrid2Enter(Sender: TObject);
begin
 {Assign DBNavigator to DataSource looking at Table2}
 DBNavigator1.DataSource := DataSource2;
end;

procedure TMain.BitBtn2Click(Sender: TObject);
begin
 {Disable datasets}
 Table1.Active := False;
 Table2.Active := False;
 {Change captions}
 Label1.Caption := 'Select table';
 Label2.Caption := 'Select table';
end;

procedure TMain.SpeedCloseClick(Sender: TObject);
begin
 {Close program}
 Close;
end;

procedure TMain.SpeedHelpClick(Sender: TObject);
begin
 {Ensure that the TabbedNotebook is displaying the first tab}
 ScanHelp.TabbedNotebook1.PageIndex := 0;
 ScanHelp.ShowModal;
end;

procedure TMain.About1Click(Sender: TObject);
begin
 {Show incredible AboutBox for massive EGO boost!}
 AboutBox.ShowModal;
end;

end.