ztransact.pas

控件名称：WINZEOS.ZIP 2002年08月03日 作者：CapellaDevelopment Zeos系列构件套件包含一组可直接存取Linux知名的免费数据库MySQL、Postgre

{$IFNDEF NO_GUI}
  OldCursor := Screen.Cursor;
{$ENDIF}
  try
{$IFNDEF NO_GUI}
    if toHourGlass in FOptions then
      Screen.Cursor := crSqlWait;
{$ENDIF}

    FHandle.Commit;
    if FHandle.Status <> csOk then
      DatabaseError(Convert(FHandle.Error, FDatabase.Encoding, etNone));
    DoCommit;
  finally
{$IFNDEF NO_GUI}
    Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

{ Rollback transaction }
procedure TZTransact.Rollback;
{$IFNDEF NO_GUI}
var
  OldCursor: TCursor;
{$ENDIF}
begin
  if not FConnected then
    DatabaseError(SNotConnected);
{$IFNDEF NO_GUI}
  OldCursor := Screen.Cursor;
{$ENDIF}
  try
{$IFNDEF NO_GUI}
    if toHourGlass in FOptions then
      Screen.Cursor := crSqlWait;
{$ENDIF}

    FHandle.Rollback;
    if FHandle.Status <> csOk then
      DatabaseError(Convert(FHandle.Error, FDatabase.Encoding, etNone));
    DoRollback;
  finally
{$IFNDEF NO_GUI}
    Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

{ Execute a multiple queries }
function TZTransact.BatchExecSql(Sql: WideString): LongInt;
var
  Text: string;
  Scanner: TZSqlScanner;
  Stop: Boolean;
begin
  Scanner := ZSqlScanner.CreateSqlScanner(DatabaseType);
  Scanner.ShowEOL := True;
  FBatchCurPos := 0;
  FBatchCurLen := 0;
  FBatchCurrentLine := 1;
  Result := 0;
  try
    Scanner.Buffer := Sql;
    while True do
    begin
      Text := Scanner.ExtractStatement(FBatchCurPos, FBatchCurLen, FBatchCurrentLine);
      if Text='' then
        Break;
      try
        if Assigned(FOnBeforeBatchExec) then
          FOnBeforeBatchExec(Self, Text);
        Result := ExecSql(Text);
        if Assigned(FOnAfterBatchExec) then
          FOnAfterBatchExec(Self, Result);
      except
        on E: EDatabaseError do
        begin
          if Assigned(FOnBatchError) then
          begin
            Stop := True;
            FOnBatchError(Self, E, Stop);
            if Stop then
              raise;
          end
          else
            raise;
        end;
      end;
    end;
  finally
    Scanner.Free;
    if Assigned(FOnAfterBatchExec) then
      FOnAfterBatchExec(Self, Result);
  end;
end;

{ Recovery after error }
procedure TZTransact.Recovery(Force: Boolean);
begin
end;

{ Open autoactivated datasets }
procedure TZTransact.Loaded;
begin
  inherited Loaded;
  if Assigned(Database) then
    Database.OpenActiveDatasets;
end;

{ Get notify listener by index }
function TZTransact.GetNotifies(Index: Integer): TObject;
begin
  Result := FNotifies[Index];
end;

{ Get notifies count }
function TZTransact.GetNotifyCount: Integer;
begin
  Result := FNotifies.Count;
end;

{ Add new notify listener }
procedure TZTransact.AddNotify(Notify: TObject);
begin
  if FNotifies.IndexOf(Notify) >= 0 then Exit;
  FNotifies.Add(Notify);
end;

{ Delete notify listener from list }
procedure TZTransact.RemoveNotify(Notify: TObject);
var
  N: Integer;
begin
  N := FNotifies.IndexOf(Notify);
  if N >= 0 then
  try
    TZNotify(FNotifies[N]).Close;
  finally
    FNotifies.Delete(N);
  end;
end;

{ Close all notify listeners }
procedure TZTransact.CloseNotifies;
var
  I: Integer;
begin
  for I := 0 to FNotifies.Count-1 do
    try
      TZNotify(FNotifies[I]).Close;
    except
    end;
end;

{*********** TZMonitorList implementation ************}

{ Get monitor }
function TZMonitorList.GetMonitor(Index: Integer): TZMonitor;
begin
  Result := TZMonitor(Items[Index]);
end;

{ Add new monitor }
procedure TZMonitorList.AddMonitor(Value: TZMonitor);
begin
  Add(Pointer(Value));
end;

{ Delete existed monitor }
procedure TZMonitorList.DeleteMonitor(Value: TZMonitor);
var
  N: Integer;
begin
  N := IndexOf(Pointer(Value));
  if N >= 0 then
    Delete(N);
end;

{ Invoke SqlEvent in all connected monitors }
procedure TZMonitorList.InvokeEvent(Sql, Result: WideString; Error: Boolean);
var
  I: Integer;
begin
  for I := 0 to Count-1 do
    try
      if not Error then
        Result := 'OK.';
      if Assigned(Monitors[I].OnMonitorEvent) then
        Monitors[I].OnMonitorEvent(Sql, Result);
    except
    end;
end;

{*************** TZBatchSql implementation **************}

{ Class constructor }
constructor TZBatchSql.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSql := TStringList.Create;
end;

{ Class destructor }
destructor  TZBatchSql.Destroy;
begin
  FSql.Free;
  inherited Destroy;
end;

{ Set new sql value }
procedure TZBatchSql.SetSql(Value: TStringList);
begin
  FSql.Assign(Value);
end;

{ Process notification messages }
procedure TZBatchSql.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FTransact ) and (Operation = opRemove) then
    FTransact   := nil;
end;

{ Execute sql statements }
procedure TZBatchSql.ExecSql;
begin
  if Assigned(FTransact) then
  begin
    if Assigned(FBeforeExecute) then
      FBeforeExecute(Self);
    FTransact.Connected := True;
    FAffectedRows := FTransact.BatchExecSql(FSql.Text);
    if Assigned(FAfterExecute) then
      FAfterExecute(Self);
  end else
    DatabaseError(STransactNotDefined);
end;

{******************** TZMonitor implementation ****************}

{ Class destructor }
destructor TZMonitor.Destroy;
begin
  if Assigned(FTransact) then
    FTransact.DeleteMonitor(Self);
  inherited Destroy;
end;

{ Process notification events }
procedure TZMonitor.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FTransact) and (Operation = opRemove) then
  begin
    if Assigned(FTransact) then
      FTransact.DeleteMonitor(Self);
    FTransact := nil;
  end;
end;

{ Set new transaction }
procedure TZMonitor.SetTransact(const Value: TZTransact);
begin
  if FTransact <> Value then
  begin
    if Assigned(FTransact) then
      FTransact.DeleteMonitor(Self);
    FTransact := Value;
    if Assigned(FTransact) then
      FTransact.AddMonitor(Self);
  end;
end;

{******************** TZNotify implementation ****************}

{ TZNotify class constructor }
constructor TZNotify.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FEventsList := TStringList.Create;
  with FEventsList do
  begin
    Duplicates := dupIgnore;
    OnChange := EventsChange;
    OnChanging := EventsChanging;
  end;
  FBackEventsList := TStringList.Create;

  FTimer := TTimer.Create(Self);
  FTimer.Enabled := False;
  FTimer.Interval := 250;
  FTimer.OnTimer := TimerProc;

  FActive := False;
  FFirstConnect := True;
end;

{ TZNotify destructor }
destructor TZNotify.Destroy;
begin
  Close;
  FEventsList.Free;
  FBackEventsList.Free;
  FTimer.Free;
  FHandle.Free;
  inherited Destroy;
end;

{ Set check interval }
procedure TZNotify.SetInterval(Value: Cardinal);
begin
  FTimer.Interval := Value;
end;

{ Retrieve check interval }
function TZNotify.GetInterval;
begin
  Result := FTimer.Interval;
end;

{ Update the events list and sends register events at the server }
procedure TZNotify.SetEventsList(Value: TStringList);
var
  I: Integer;
begin
  FEventsList.Assign(Value);
  for I := 0 to FEventsList.Count -1 do
    FEventsList[I] := Trim(FEventsList[I]);
end;

{ Activate component }
procedure TZNotify.SetActive(Value: Boolean);
begin
  if FActive <> Value then
  begin
    if Value then Open
    else Close;
  end;
end;

{ Set new transaction object }
procedure TZNotify.SetTransact(Value: TZTransact);
begin
  if FTransact <> Value then
  begin
    Close;
    if FTransact <> nil then
      FTransact.RemoveNotify(Self);
    FTransact := Value;
    if FTransact <> nil then
      FTransact.AddNotify(Self);
  end;
end;

{ Process notification messages }
procedure TZNotify.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FTransact ) and (Operation = opRemove) then
    SetTransact(nil);
end;

{ Process events list changing }
procedure TZNotify.EventsChanging(Sender: TObject);
begin
  if not Active then Exit;
  FBackEventsList.Text:=FEventsList.Text;
end;

{ Process events list changing }
procedure TZNotify.EventsChange(Sender: TObject);
var
  I: Integer;
begin
  if not Active then Exit;
  with TStringList(FEventsList) do
  begin
    OnChange := nil;
    OnChanging := nil;
  end;

  try
    { Unregistering old events }
    for I := 0 to FBackEventsList.Count-1 do
    begin
      if FEventsList.IndexOf(FBackEventsList[I]) = -1 then
      begin
        FHandle.UnListenTo(Trim(FBackEventsList[I]));
        if FHandle.Status <> nsOK then
          DatabaseError(SNotifyRegister);
      end;
    end;

    { Registering new events }
    for I := 0 to FEventsList.Count-1 do
    begin
      if FBackEventsList.IndexOf(FEventsList[I])=-1 then
      begin
        FHandle.ListenTo(Trim(FEventsList[I]));
        if FHandle.Status <> nsOK then
          DatabaseError(SNotifyRegister);
      end;
    end;
  { Restoring change event handlers }
  finally
    with TStringList(FEventsList) do
    begin
      OnChange := EventsChange;
      OnChanging := EventsChanging;
    end;
    FBackEventsList.Clear;
  end;
end;

{ Internal procedure that will be called at each timer trigger }
procedure TZNotify.TimerProc(Sender: TObject);
begin
  if not Active then
    FTimer.Enabled := False
  else CheckEvents;
end;

{ Raise exception if notify isn't active }
procedure TZNotify.CheckActive;
begin
  if not Assigned(FTransact) then
    DatabaseError(STransactNotDefined);
  if not Active then
    DatabaseError('TZNotify not in active mode');
  if not FTransact.Connected then
     DatabaseError(SNotConnected);
end;

{ Check autoopen property }
procedure TZNotify.Loaded;
begin
  inherited Loaded;
  if FAutoOpen then
  begin
    FAutoOpen := False;
    Open;
  end;
end;

{ Start the events listener }
procedure TZNotify.Open;
var
  I: Integer;
begin
  if Active then Exit;

  if not Assigned(FTransact) and (csLoading in ComponentState) then
  begin
    FAutoOpen := True;
    Exit;
  end;

  if not Assigned(FTransact) then
    DatabaseError(STransactNotDefined);
  if not FTransact.Connected then
    FTransact.Connect;

  FHandle.Connect := FTransact.Handle.Connect;
  FHandle.Transact := FTransact.Handle;

  { Registering events }
  for I := 0 to FEventsList.Count-1 do
  begin
    FHandle.ListenTo(FEventsList[I]);
    if FHandle.Status <> nsOk then
      DatabaseError(FHandle.Error);
  end;

  FActive := True;
  FTimer.Enabled := True;
end;

{ Stop the events listener }
procedure TZNotify.Close;
var
  I: Integer;
begin
  if not Active then Exit;

  FTimer.Enabled := False;

  { Unregistering events }
  for I:= 0 to FEventsList.Count-1 do
  begin
    FHandle.UnlistenTo(FEventsList[I]);
    if FHandle.Status <> nsOk then
      DatabaseError(FHandle.Error);
  end;
  FTransact.Disconnect;
  FActive := False;
end;

{ Listen to a specific event }
procedure TZNotify.ListenTo(Event: string);
begin
  if Assigned(FBeforeRegister) then
    FBeforeRegister(Self, Event);

  CheckActive;
  FHandle.ListenTo(Trim(Event));
  if FHandle.Status <> nsOk then
    DatabaseError(FHandle.Error);

  { Adding event to list }
  with FEventsList do
  begin
    OnChange := nil;
    OnChanging := nil;
    if IndexOf(Event) = -1 then
      Append(Event);
    OnChange := EventsChange;
    OnChanging := EventsChanging;
  end;

  if Assigned(FAfterRegister) then
    FAfterRegister(Self, Event);
end;

{ Generate a notify event }
procedure TZNotify.DoNotify(Event: string);
begin
  CheckActive;
  FHandle.DoNotify(Event);
  if FHandle.Status <> nsOk then
    DatabaseError(FHandle.Error);
end;

{ Stop listening to a specific event }
procedure TZNotify.UnlistenTo(Event: string);
begin
  if Assigned(FBeforeRegister) then
    FBeforeUnregister(Self, Event);

  CheckActive;
  FHandle.UnlistenTo(Trim(Event));
  if FHandle.Status <> nsOk then
    DatabaseError(FHandle.Error);

  { Removing event from list }
  with FEventsList do
  begin
    OnChange := nil;
    OnChanging := nil;
    Delete(IndexOf(Event));
    OnChange := EventsChange;
    OnChanging := EventsChanging;
  end;

  if Assigned(FAfterRegister) then
    FAfterUnregister(Self, Event);
end;

{ Checks for any pending events }
procedure TZNotify.CheckEvents;
var
  Notify: string;
begin                         
  CheckActive;
  while True do
  begin
    Notify := Trim(FHandle.CheckEvents);
    if FHandle.Status<>nsOK then
      Exit;
    if Notify = '' then Break;
    if FEventsList.IndexOf(Notify) >= 0 then
    begin
      if Assigned(FNotifyFired) then
        FNotifyFired(Self, Notify);
    end;
  end;
end;

end.