C Programming Starter Kit 2.0/SamsPublishing-CProgrammingStarterKit-v2.0-Win31.iso/bde/sdktab.pak/MAIN.PAS

Pascal/Delphi Source File | 1997-07-24 | 15.9 KB | 537 lines

{$A+,B-,D+,F-,G+,I+,K+,L+,N+,P+,Q-,R-,S+,T-,V+,W-,X+,Y+}
{$M 25600,4096}
{ unit main.pas }
unit Main;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, DB, DBTables, DbiTypes, DbiProcs, DbiErrs,
  ExtCtrls, Grids, DBGrids, TableEnh, ShowNew;

const
  copiedTable = 'COPY.DB';

type
  TMainForm = class(TForm)
    Panel1: TPanel;
    SharedBtn: TButton;
    TblLockedBtn: TButton;
    RecLockedBtn: TButton;
    SysVersionBtn: TButton;
    SysInfoBtn: TButton;
    SysConfigBtn: TButton;
    Label8: TLabel;
    Panel2: TPanel;
    Label9: TLabel;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    FastInsertBtn: TButton;
    Panel3: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    BlockInsertBtn: TButton;
    CountLabel: TLabel;
    PackTableBtn: TButton;
    CopyTableBtn: TButton;
    StatusLabel: TLabel;
    TableEnhanced1: TTableEnhanced;
    RemoveLocksBtn: TButton;
    FastAppendBtn: TButton;
    OpenDialog1: TOpenDialog;
    procedure SharedBtnClick(Sender: TObject);
    procedure TblLockedBtnClick(Sender: TObject);
    procedure RecLockedBtnClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure SysVersionBtnClick(Sender: TObject);
    procedure SysInfoBtnClick(Sender: TObject);
    procedure SysConfigBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure DataSource1DataChange(Sender: TObject; Field: TField);
    procedure FastInsertBtnClick(Sender: TObject);
    procedure PackTableBtnClick(Sender: TObject);
    procedure CopyTableBtnClick(Sender: TObject);
    procedure BlockInsertBtnClick(Sender: TObject);
    procedure RemoveLocksBtnClick(Sender: TObject);
    procedure FastAppendBtnClick(Sender: TObject);
  private
    { Private declarations }
    RecCount: Longint;
    procedure ClearLabels;
    procedure CreateTempTable;
    procedure InsertRecords;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

{ METHOD: InsertRecords
  PURPOSE: Inserts blocks of records specified by the BlockSize and
    BlockTotal parameters of TTableEnhanced.
}
procedure TMainForm.InsertRecords;
var
  W: Word;
  MoveDone: Boolean;

begin
  MoveDone := False;
  { Continue to call the WriteBlock method until it returns True }
  with TableEnhanced1 do
  begin
    repeat
      { Allocate and Initialize the record buffer }
      InitializeBuffer;
      { Fill the record buffer }
      for W := 1 to BlockSize do
      begin
        Inc(RecCount);
        InitIntegerField(FieldByName('IntField').Index, RecCount);
        InitStringField(FieldByName('StrField').Index,
                        Format('Record %d', [RecCount]));
        InitTimeField(FieldByName('TimeField').Index, SysUtils.Time);
        { After each record in the record buffer has been filled, move the
          record buffer ponter to the next record in the record buffer }
        NextRecord;
      end;
      { Place the block of records into the table }
      MoveDone := WriteBlock;
    { Check to see if all records have been placed into the table }
    until MoveDone = True;
  end
end;

{ METHOD: CreateTempTable
  PURPOSE: Creates a table that is used for this exmaple.
}
procedure TMainForm.CreateTempTable;
begin
  with TableEnhanced1 do
  begin
    TableName := 'TEMPTABL';
    TableType := ttParadox;
    FieldDefs.Clear;
    IndexDefs.Clear;
    try
      FieldDefs.Add('IntField', ftInteger, 0, True);
      FieldDefs.Add('StrField', ftString, 14, True);
      FieldDefs.Add('TimeField', ftTime, 0, True);
      IndexDefs.Add('', 'IntField', [ixPrimary]);
      CreateTable;
    except
      on E:EDatabaseError do
      begin
        Screen.Cursor := crDefault;
        if MessageDlg(E.Message + '.  Would you like to create the table in ' +
                   ' the executable''s directory?', mtConfirmation,
                   [mbYes, mbNo], 0) =  mrYes then
        begin
          DatabaseName := '';
          try
            CreateTable;
          except
            on E:EDatabaseError do
            begin
              raise EEnhDBError.Create('Application is terminating');
              Application.Terminate;
            end;
          end;
        end
        else
        begin
          raise EEnhDBError.Create('Application is terminating');
          Application.Terminate;
        end;
      end;
    end;
  end;
end;

{ METHOD: ClearLabels
  PURPOSE: Clears the IDAPI information labels.
}
procedure TMainForm.ClearLabels;
begin
  Label1.Caption := '';
  Label2.Caption := '';
  Label3.Caption := '';
  Label4.Caption := '';
  Label5.Caption := '';
  Label6.Caption := '';
  Label7.Caption := '';
end;

{ METHOD: SharedBtnClick
  PURPOSE: Check IDAPI to see if the currently opened table is shared.
}
procedure TMainForm.SharedBtnClick(Sender: TObject);
begin
  ClearLabels;
  if TableEnhanced1.IsTableShared = True then
    Label1.Caption := 'Table is shared'
  else
    Label1.Caption := 'Table is NOT shared';
end;

{ METHOD: TblLockedBtnClick
  PURPOSE: Check IDAPI to see if the currently opened table is locked.
}
procedure TMainForm.TblLockedBtnClick(Sender: TObject);
begin
  ClearLabels;
  Label1.Caption := Format('Table has %d table locks',
                    [TableEnhanced1.IsTableLocked(dbiWriteLock)]);
end;

{ METHOD: RecLockedBtnClick
  PURPOSE: Check IDAPI to see if the current record is locked.
}
procedure TMainForm.RecLockedBtnClick(Sender: TObject);
begin
  ClearLabels;
  if TableEnhanced1.IsRecordLocked = True then
    Label1.Caption := 'Current record is locked'
  else
    Label1.Caption := 'Current record is NOT locked';
end;

{ METHOD: SysVersionBtnClick
  PURPOSE:  Check IDAPI for system version information.
}
procedure TMainForm.SysVersionBtnClick(Sender: TObject);
var
  Version: SysVersion;

begin
  ClearLabels;
  Version := TableEnhanced1.GetSysVersion;
  with Version do
  begin
    Label1.Caption := Format('Engine version = %d', [iVersion]);
    Label2.Caption := Format('Client interface level = %d', [iIntfLevel]);
    Label3.Caption := 'Version date = ' + DateToStr(DateVer);
    Label4.Caption := 'Version time = ' + TimeToStr(TimeVer);
  end;
end;

{ METHOD: SysVersionBtnClick
  PURPOSE:  Check IDAPI for system information.
}
procedure TMainForm.SysInfoBtnClick(Sender: TObject);
var
  Info: SysInfo;

begin
  ClearLabels;
  Info := TableEnhanced1.GetSysInfo;
  with Info do
  begin
    Label1.Caption := Format('Buffer size in kb = %d', [iBufferSpace]);
    Label2.Caption := Format('Heap size in kb = %d', [iHeapSpace]);
    Label3.Caption := Format('# of loaded drivers = %d', [iDrivers]);
    Label4.Caption := Format('# of active clients = %d', [iClients]);
    Label5.Caption := Format('# of active sessions = %d', [iSessions]);
    Label6.Caption := Format('# of open databases = %d', [iDatabases]);
    Label7.Caption := Format('# of open cursors (all clients) = %d',
                             [iCursors]);
  end;
end;

{ METHOD: SysVersionBtnClick
  PURPOSE:  Check IDAPI for system configuration information.
}
procedure TMainForm.SysConfigBtnClick(Sender: TObject);
var
  Config: SysConfig;
begin
  ClearLabels;
  Config := TableEnhanced1.GetSysConfig;
  with Config do
  begin
    if bLocalShare = True then
      Label1.Caption := 'Table can be shared with non-idapi applications'
    else
      Label1.Caption := 'Table cannot be shared with non-idapi applications';
    Label2.Caption := 'Network type = ' + szNetType;
    Label3.Caption := 'Network user name = ' + szUserName;
    Label4.Caption := 'Configuration file name = ' + szIniFile;
    Label5.Caption := 'System language driver = ' + szLangDriver;
  end;
end;

{ METHOD: FormCloseQuery
  PURPOSE:  Close and delete the temporary table when the applivcstion
    is closed.
}
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Screen.Cursor := crHourGlass;
  try
    if TableEnhanced1.Active = true then
    begin
      TableEnhanced1.Close;
      TableEnhanced1.DeleteTable;
    end;
  except
    on E:EDatabaseError do
      MessageDlg(E.Message, mtError, [mbOk], 0);
  end;
  Screen.Cursor := crDefault;
end;

{ METHOD: FormCreate
  PURPOSE:  Create and open the temporary table.
}
procedure TMainForm.FormCreate(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  { Set the record counter to zero }
  RecCount := 0;
  Application.HintColor := clTeal;
  ClearLabels;
  try
    { Treate the temporary table }
    CreateTempTable;
    { Open the table }
    TableEnhanced1.Open;
    { Add initial records to the table }
    InsertRecords;
    { Display the new records in the DBGrid }
    TableEnhanced1.Refresh;
    { Set the cursor to the first record in the table }
    TableEnhanced1.First;
  except
    on E:EDatabaseError do
    begin
      Screen.Cursor := crDefault;
      MessageDlg(E.Message, mtError, [mbOk], 0);
      Application.Terminate;
    end;
  end;
  Screen.Cursor := crDefault;
end;

{ METHOD: DataSource1DataChange
  PURPOSE:  Update the record count whenever the data in the
    table has changed.
}
procedure TMainForm.DataSource1DataChange(Sender: TObject; Field: TField);
begin
  CountLabel.Caption := Format('Record count = %d',
                               [TableEnhanced1.RecordCount]);
end;

{ METHOD: FastInsertBtnClick
  PURPOSE:  Insert one record using the InsertFast Method.
}
procedure TMainForm.FastInsertBtnClick(Sender: TObject);
begin
  Inc(RecCount);
  { Set the BlockSize to one so extra record buffers are not allocated.
    NOTE: It would not effect the behavior of InsertFast to have BlockSize
    greater than one;  it would just be a waste of memory and
    slightly slower. }
  TableEnhanced1.BlockSize := 1;
  try
    with TableEnhanced1 do
    begin
      { Allocate and Initialize the record buffer }
      InitializeBuffer;
      { Fill the record buffer }
      InitIntegerField(FieldByName('IntField').Index, RecCount);
      InitStringField(FieldByName('StrField').Index, Format('Record %d',
                             [RecCount]));
      InitTimeField(FieldByName('TimeField').Index, SysUtils.Time);
      { Insert the record }
      InsertFast;
      { Make sure the Delphi controls are aware of the new record }
      Refresh;
      { Move the cursor to the last record in the table }
      Last;
      StatusLabel.Caption := 'Status = Success';
    end;
  except
    on E:EDatabaseError do
    begin
      Dec(RecCount);
      MessageDlg(E.Message, mtError, [mbOk], 0);
    end;
  end;
end;

{ METHOD: PackTableBtnClick
  PURPOSE:  Pack the currently opened table.
}
procedure TMainForm.PackTableBtnClick(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  StatusLabel.Caption := 'Status = Packing...';
  Application.ProcessMessages;
  try
    { Pack table }
    TableEnhanced1.Pack;
    StatusLabel.Caption := 'Status = Success';
  except
    on E:EEnhDBError do
    begin
      Screen.Cursor := crDefault;
      StatusLabel.Caption := 'Status = ERROR';
      MessageDlg(E.Message, mtError, [mbOk], 0);
    end;
  end;
  Screen.Cursor := crDefault;
end;

{ METHOD: CopyTableBtnClick
  PURPOSE:  Copy the currently opened table to another table of a
    different name.
}
procedure TMainForm.CopyTableBtnClick(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  StatusLabel.Caption := 'Status = Copying...';
  Application.ProcessMessages;
  try
    { Set the table name on the ViewNew form to "copiedTable" }
    ViewNew.TableEnhanced1.DatabaseName :=
        TableEnhanced1.DatabaseName;
    ViewNew.TableEnhanced1.TableName := copiedTable;
    { Copy the table }
    TableEnhanced1.CopyTable(copiedTable);
    { Open the table on the ViewNew form }
    ViewNew.TableEnhanced1.Open;
    Screen.Cursor := crDefault;
    StatusLabel.Caption := 'Status = Success';
    { Display the ViewNew form thus showing the copied table }
    ViewNew.ShowModal;
    ViewNew.TableEnhanced1.Close;
    { If the user decided to delete the table, delete it }
    if ViewNew.DeleteCopy.Checked = True then
      ViewNew.TableEnhanced1.DeleteTable;
  except
    { If the user decided to copy a table over a previously created
      table, ask the user if the old table should be deleted.
      NOTE: The table can always be overwritten if
      TTableEnhanced.Overwrite is True. }
    on EEnhDBFileExists do
    begin
      Screen.Cursor := crDefault;
      StatusLabel.Caption := 'Status = Table Exists';
      if MessageDlg('Table exists.  Delete', mtConfirmation, [mbYes, mbNo], 0)
                    = mrYes then
      begin
        { Delete the old table }
        ViewNew.TableEnhanced1.DeleteTable;
        StatusLabel.Caption := 'Status = Deleted';
      end
      else
        StatusLabel.Caption := 'Status = Not deleted';
    end;
    on E:EDatabaseError do
    begin
      Screen.Cursor := crDefault;
      StatusLabel.Caption := 'Status = ERROR';
      MessageDlg(E.Message, mtError, [mbOk], 0);
    end;
  end;
end;

{ METHOD: BlockInsertBtnClick
  PURPOSE: Insert a block of records into the table.
}
procedure TMainForm.BlockInsertBtnClick(Sender: TObject);
begin
  Screen.cursor := crHourGlass;
  { Set the BlockSize and BlockTotal.  The following means: Insert a
    total of 500 records, 100 records at a time. }
  TableEnhanced1.BlockTotal := 500;
  TableEnhanced1.BlockSize := 100;
  StatusLabel.Caption := 'Status = Inserting...';
  Application.ProcessMessages;
  try
    { Insert the records }
    InsertRecords;
    { Make sure the Delphi controls are aware of the new record }
    TableEnhanced1.Refresh;
    { Move the cursor to the last record in the table }
    TableEnhanced1.Last;
    StatusLabel.Caption := 'Status = Success';
    Screen.Cursor := crDefault;
  except
    on E:EDatabaseError do
    begin
      Screen.Cursor := crDefault;
      StatusLabel.Caption := 'Status = ERROR';
      MessageDlg(E.Message, mtError, [mbOk], 0);
    end;
  end;
end;

{ METHOD: RemoveLocksBtnClick
  PURPOSE: Remove all record locks on the table.  NOTE: There are
    record locks on records inserted with InsertFast.  If no locks
    are desired, set TTableEnhanced.InsertMode = "imNoLock".  Also,
    removing record locks before block or reocrd insertion increases
    performance.
}
procedure TMainForm.RemoveLocksBtnClick(Sender: TObject);
begin
  try
    { Release all record locks }
    TableEnhanced1.ReleaseRecordLock(True);
  except
    on E:EDatabaseError do
    begin
      StatusLabel.Caption := 'Status = ERROR';
      MessageDlg(E.Message, mtError, [mbOk], 0);
    end;
  end;
end;

procedure TMainForm.FastAppendBtnClick(Sender: TObject);
begin
  Inc(RecCount);
  { Set the BlockSize to one so extra record buffers are not allocated.
    NOTE: It would not effect the behavior of AppendFast to have BlockSize
    greater than one;  it would just be a waste of memory and
    slightly slower. }
  TableEnhanced1.BlockSize := 1;
  try
    with TableEnhanced1 do
    begin
      { Allocate and Initialize the record buffer }
      InitializeBuffer;
      { Fill the record buffer }
      InitIntegerField(FieldByName('IntField').Index, RecCount);
      InitStringField(FieldByName('StrField').Index, Format('Record %d',
                             [RecCount]));
      InitTimeField(FieldByName('TimeField').Index, SysUtils.Time);
      { Append the record }
      AppendFast;
      { Make sure the Delphi controls are aware of the new record }
      Refresh;
      { Move the cursor to the last record in the table }
      Last;
      StatusLabel.Caption := 'Status = Success';
    end;
  except
    on E:EDatabaseError do
    begin
      Dec(RecCount);
      MessageDlg(E.Message, mtError, [mbOk], 0);
    end;
  end;
end;

end.