Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 5

Project LOCKTEST

Project Structure


LOCKTEST.DPR

program LockTest;

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

{$R *.RES}

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

LOCKFORM.PAS

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.

LOCKFORM.DFM

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