Home: Code Repository: Mastering Delphi 5

Project LOCKTEST

Project Structure

LOCKTEST.DPR
LOCKFORM.PAS
LOCKFORM.DFM

program LockTest;

uses
  Forms,
  LockForm in 'LockForm.pas' {NavigForm};

{$R *.RES}

begin
  Application.CreateForm(TNavigForm, NavigForm);
  Application.CreateForm(TNavigForm, NavigForm);
  Application.Run;
end.

unit LockForm;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, DBCtrls, StdCtrls, Mask, DB, DBTables;

type
  TNavigForm = class(TForm)
    DataSource1: TDataSource;
    Table1: TTable;
    DBEdit1: TDBEdit;
    DBEdit2: TDBEdit;
    Label1: TLabel;
    Label2: TLabel;
    DBNavigator1: TDBNavigator;
    Label3: TLabel;
    DBEdit3: TDBEdit;
    Timer1: TTimer;
    procedure DataSource1DataChange(Sender: TObject; Field: TField);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    procedure TestLockStatus;
  end;

var
  NavigForm: TNavigForm;

implementation

{$R *.DFM}

uses
  BDE;

function IsRecordLocked (Table: TTable): Boolean;
var
  Locked: BOOL;
  hCur: hDBICur;
    rslt: DBIResult;
begin
    Table.UpdateCursorPos;
  // test if the record is locked by the current session
  Check (DbiIsRecordLocked (Table.Handle, Locked));
  Result := Locked;
  // otherwise check all sessions
  if (Result = False) then
    begin
    // get a new cursor to the same record
    Check (DbiCloneCursor (Table.Handle, False, False, hCur));
        try
      // try to place a write lock in the record
      rslt := DbiGetRecord (hCur, dbiWRITELOCK, nil, nil);
      // don't call Check: we want to do special actions
      // instead of raising an exception
      if rslt <> DBIERR_NONE then
            begin
        // if a lock error occured
        if HiByte (rslt) = ERRCAT_LOCKCONFLICT then
          Result := True
        else
          // if some other error happened
          Check (rslt); // raise the exception
      end
            else
        // if the function was successful, release the lock
        Check (DbiRelRecordLock (hCur, False));
        finally
      // close the cloned cursor 
      Check (DbiCloseCursor (hCur));
    end;
  end;
end;

procedure TNavigForm.TestLockStatus;
begin
  // if the table is not in edit mode
  if Table1.State in [dsEdit, dsInsert] then
    Caption := 'LockTest - Record in edit mode'
  else if IsRecordLocked (Table1) then
  begin
    DbEdit1.ReadOnly := True;
    DbEdit2.ReadOnly := True;
    DbEdit3.ReadOnly := True;
    Caption := 'LockTest - Record already locked';
  end
  else
  begin
    DbEdit1.ReadOnly := False;
    DbEdit2.ReadOnly := False;
    DbEdit3.ReadOnly := False;
    Caption := 'LockTest - Record not locked';
  end;
end;

procedure TNavigForm.DataSource1DataChange(Sender: TObject; Field: TField);
begin
  // if the record changed
  if (Field = nil) then
    TestLockStatus;
end;

procedure TNavigForm.Timer1Timer(Sender: TObject);
begin
  TestLockStatus;
end;

end.

object NavigForm: TNavigForm
  Left = 258
  Top = 135
  Width = 337
  Height = 215
  ActiveControl = DBEdit1
  Caption = 'Edit Demo'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 40
    Top = 56
    Width = 39
    Height = 13
    Caption = 'Country:'
  end
  object Label2: TLabel
    Left = 40
    Top = 91
    Width = 35
    Height = 13
    Caption = 'Capital:'
  end
  object Label3: TLabel
    Left = 40
    Top = 124
    Width = 48
    Height = 13
    Caption = 'Continent:'
  end
  object DBEdit1: TDBEdit
    Left = 104
    Top = 52
    Width = 169
    Height = 21
    DataField = 'Name'
    DataSource = DataSource1
    MaxLength = 24
    TabOrder = 0
  end
  object DBEdit2: TDBEdit
    Left = 104
    Top = 86
    Width = 169
    Height = 21
    DataField = 'Capital'
    DataSource = DataSource1
    MaxLength = 24
    TabOrder = 1
  end
  object DBNavigator1: TDBNavigator
    Left = 0
    Top = 0
    Width = 329
    Height = 25
    DataSource = DataSource1
    VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbEdit, nbPost, nbCancel]
    Align = alTop
    Flat = True
    TabOrder = 2
  end
  object DBEdit3: TDBEdit
    Left = 104
    Top = 120
    Width = 169
    Height = 21
    DataField = 'Continent'
    DataSource = DataSource1
    TabOrder = 3
  end
  object DataSource1: TDataSource
    DataSet = Table1
    OnDataChange = DataSource1DataChange
    Left = 64
    Top = 144
  end
  object Table1: TTable
    Active = True
    DatabaseName = 'DBDEMOS'
    TableName = 'COUNTRY.DB'
    Left = 16
    Top = 144
  end
  object Timer1: TTimer
    Interval = 5000
    OnTimer = Timer1Timer
    Left = 8
    Top = 40
  end
end