Форум программистов [Powered by Invision Power Board]

Код

  private
    { Private declarations }
    CritSec:TRTLCriticalSection;
    DServ:Variant;
  public
    { Public declarations }
    procedure LockForm;
    procedure UnlockForm;
    procedure SetData1;
    procedure SetData2;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SetData1;
begin
with ADOQuery1 do
 begin
  Close;
  Open;
  if RecordCount >0 then
   begin
    First;
    while not Eof do
      begin
       Edit;
       FieldByName('lockState').AsString:= 'lock';
       Post;
        // для тестирования.  Внешняя задержка
       if VarType(DServ) = varDispatch then
        begin
         DServ.Test1(7000);
        end
        else
        begin
         ShowMessage('Нет подключенного сервера');
        end;
       //Sleep(7000); // для тестирования.  Внутренняя задержка
       Next;
      end;
   end;
 end; //with
end;

procedure TForm1.SetData2;
begin
with ADOQuery1 do
 begin
  Close;
  Open;
  if RecordCount >0 then
   begin
    First;
    Edit;
    FieldByName('lockState').AsString:= 'unlock';
    Post;
   end;
 end; //with
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Color:=clRed;
 try
  LockForm;
  SetData1;
 finally
  UnlockForm;
 end;
Label1.Color:=clGreen;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 //Подключение к серверу.
  DServ := CreateOLEObject('DataServer.OfflineServer1');
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 //Отключение от сервера.
 if VarType(DServ) = varDispatch then
  begin
   DServ := Unassigned;
  end
  else
  begin
   ShowMessage('Нет подключенного сервера');
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 try
  {Открываем сеанс связи с б.д.}
  ADOConnection1.Open;
 except
  ShowMessage('Не удалось установить связь с б.д., сервер не доступен.');
 end;
 {инициализируем Критическую Секцию}
 InitializeCriticalSection(CritSec);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 {Закрываем сеанс связи с базой данных}
  ADOConnection1.Close;
 {Закрываем Критическую секцию}
  DeleteCriticalSection(CritSec);
end;

{Захват потоком критической секции}
procedure TForm1.LockForm;
 begin
  EnterCriticalSection(CritSec);
 end;

 {Освобождение потоком критической секции}
procedure TForm1.UnlockForm;
 begin
  LeaveCriticalSection(CritSec);
 end;