ib_services.pas

FIBPlus is a component suite intended for work with InterBase. It is direct, fast and flexible Inter

  TTransactionState = (LimboState, CommitState, RollbackState, UnknownState);
  TTransactionAdvise = (CommitAdvise, RollbackAdvise, UnknownAdvise);
  TServiceTransactionAction = (CommitAction, RollbackAction);

  TLimboTransactionInfo = class
  public
    MultiDatabase: Boolean;
    ID: Integer;
    HostSite: String;
    RemoteSite: String;
    RemoteDatabasePath: String;
    State: TTransactionState;
    Advise: TTransactionAdvise;
    Action: TServiceTransactionAction;
  end;

  TpFIBValidationService = class(TpFIBControlAndQueryService)
  private
    FDatabaseName: string;
    FOptions: TValidateOptions;
    FLimboTransactionInfo: array of TLimboTransactionInfo;
    FGlobalAction: TTransactionGlobalAction;
    procedure SetDatabaseName(const Value: string);
    function GetLimboTransactionInfo(index: integer): TLimboTransactionInfo;
    function GetLimboTransactionInfoCount: integer;

  protected
    procedure SetServiceStartOptions; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure FetchLimboTransactionInfo;
    procedure FixLimboTransactionErrors;
    property LimboTransactionInfo[Index: integer]: TLimboTransactionInfo read GetLimboTransactionInfo;
    property LimboTransactionInfoCount: Integer read GetLimboTransactionInfoCount;

  published
    property DatabaseName: string read FDatabaseName write SetDatabaseName;
    property Options: TValidateOptions read FOptions write FOptions;
    property GlobalAction: TTransactionGlobalAction read FGlobalAction
                                         write FGlobalAction;
    property OnTextNotify;
  end;

  TUserInfo = class
  public
    UserName: string;
    FirstName: string;
    MiddleName: string;
    LastName: string;
    GroupID: Integer;
    UserID: Integer;
  end;

  TSecurityAction = (ActionAddUser, ActionDeleteUser, ActionModifyUser, ActionDisplayUser);
  TSecurityModifyParam = (ModifyFirstName, ModifyMiddleName, ModifyLastName, ModifyUserId,
                         ModifyGroupId, ModifyPassword);
  TSecurityModifyParams = set of TSecurityModifyParam;

  TpFIBSecurityService = class(TpFIBControlAndQueryService)
  private
    FUserID: Integer;
    FGroupID: Integer;
    FFirstName: string;
    FUserName: string;
    FPassword: string;
    FSQLRole: string;
    FLastName: string;
    FMiddleName: string;
    FUserInfo: array of TUserInfo;
    FSecurityAction: TSecurityAction;
    FModifyParams: TSecurityModifyParams;
    procedure ClearParams;
    procedure SetSecurityAction (Value: TSecurityAction);
    procedure SetFirstName (Value: String);
    procedure SetMiddleName (Value: String);
    procedure SetLastName (Value: String);
    procedure SetPassword (Value: String);
    procedure SetUserId (Value: Integer);
    procedure SetGroupId (Value: Integer);

    procedure FetchUserInfo;
    function GetUserInfo(Index: Integer): TUserInfo;
    function GetUserInfoCount: Integer;

  protected
    procedure Loaded; override;
    procedure SetServiceStartOptions; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DisplayUsers;
    procedure DisplayUser(UserName: string);
    procedure AddUser;
    procedure DeleteUser;
    procedure ModifyUser;
    property  UserInfo[Index: Integer]: TUserInfo read GetUserInfo;
    property  UserInfoCount: Integer read GetUserInfoCount;

  published
    property SecurityAction: TSecurityAction read FSecurityAction
                                             write SetSecurityAction;
    property SQlRole : string read FSQLRole write FSQLrole;
    property UserName : string read FUserName write FUserName;
    property FirstName : string read FFirstName write SetFirstName;
    property MiddleName : string read FMiddleName write SetMiddleName;
    property LastName : string read FLastName write SetLastName;
    property UserID : Integer read FUserID write SetUserID;
    property GroupID : Integer read FGroupID write SetGroupID;
    property Password : string read FPassword write setPassword;
  end;

{$ENDIF}

implementation

{$IFDEF  INC_SERVICE_SUPPORT}
uses
  StrUtil,
  {$IFNDEF NO_MONITOR}
  FIBSQLMonitor,
  {$ENDIF}
  fib;

{ TpFIBCustomService }

procedure TpFIBCustomService.Attach;
var
  SPB: String;
  ConnectString: String;
begin
  CheckInactive;
  CheckServerName;

  if FLoginPrompt and not Login then
    FIBError(feOperationCancelled, [nil]);

  { Generate a new SPB if necessary }
  if FParamsChanged then
  begin
    FParamsChanged := False;
    GenerateSPB(FParams, SPB, FSPBLength);
    FIBAlloc(FSPB, 0, FsPBLength);
    Move(SPB[1], FSPB[0], FSPBLength);
  end;
  case FProtocol of
    TCP: ConnectString := FServerName + ':service_mgr'; {do not localize}
    SPX: ConnectString := FServerName + '@service_mgr'; {do not localize}
    NamedPipe: ConnectString := '\\' + FServerName + '\service_mgr'; {do not localize}
    Local: ConnectString := 'service_mgr'; {do not localize}
  end;
  LoadLibrary;
  if Call(FClientLibrary.isc_service_attach(StatusVector, Length(ConnectString),
                         PChar(ConnectString), @FHandle,
                         FSPBLength, FSPB), False) > 0 then
  begin
    FHandle := nil;
    IBError(FClientLibrary, Self);
  end;

  if Assigned(FOnAttach) then
    FOnAttach(Self);
{$IFNDEF NO_MONITOR}
  MonitorHook.ServiceAttach(Self);
{$ENDIF}
end;

procedure TpFIBCustomService.Loaded;
begin
  inherited Loaded;
  try
    if FStreamedActive and (not Active) then
      Attach;
  except
    if csDesigning in ComponentState then
    begin
    {$IFDEF D6+}
      if Assigned(ApplicationHandleException) then
        ApplicationHandleException(Self);
    {$ELSE}
        Application.HandleException(Self)
    {$ENDIF}
    end
    else
      raise;
  end;
end;

function TpFIBCustomService.Login: Boolean;
var
  IndexOfUser, IndexOfPassword, IndexOfRole: Integer;
  Username, Password, RoleName: String;
  LoginParams: TStrings;
begin
  if Assigned(FOnLogin) then begin
    result := True;
    LoginParams := TStringList.Create;
    try
      LoginParams.Assign(Params);
      FOnLogin(Self, LoginParams);
      Params.Assign (LoginParams);
    finally
      LoginParams.Free;
    end;
  end
  else
  begin
    IndexOfUser := IndexOfSPBConst(SPBConstantNames[isc_spb_user_name]);
    if IndexOfUser <> -1 then
      Username := Copy(Params[IndexOfUser],
                                         Pos('=', Params[IndexOfUser]) + 1, {mbcs ok}
                                         Length(Params[IndexOfUser]));
    IndexOfPassword := IndexOfSPBConst(SPBConstantNames[isc_spb_password]);
    if IndexOfPassword <> -1 then
      Password := Copy(Params[IndexOfPassword],
                                         Pos('=', Params[IndexOfPassword]) + 1, {mbcs ok}
                                         Length(Params[IndexOfPassword]));

   IndexOfRole:= IndexOfSPBConst(SPBConstantNames[isc_spb_sql_role_name]);
   if IndexOfRole<>-1 then
    RoleName := Copy(Params[IndexOfRole],
                                       Pos('=', Params[IndexOfRole]) + 1,
                                       Length(Params[IndexOfRole]));
//    if Assigned(LoginDialogExProc) then
//      result := LoginDialogExProc(serverName, Username, Password, false)
//    else
//      Result := false;
    if not Assigned(pFIBLoginDialog) then
     Result := False
    else
     Result := pFIBLoginDialog(ServerName, Username, Password,RoleName);

    if result then
    begin
      IndexOfPassword := IndexOfSPBConst(SPBConstantNames[isc_spb_password]);
      if IndexOfUser = -1 then
        Params.Add(SPBConstantNames[isc_spb_user_name] + '=' + Username)
      else
        Params[IndexOfUser] := SPBConstantNames[isc_spb_user_name] +
                                 '=' + Username;
      if IndexOfPassword = -1 then
        Params.Add(SPBConstantNames[isc_spb_password] + '=' + Password)
      else
        Params[IndexOfPassword] := SPBConstantNames[isc_spb_password] +
                                     '=' + Password;
      if IndexOfRole=-1 then
        Params.Add(SPBConstantNames[isc_spb_sql_role_name] + '=' + RoleName)
      else
        Params[IndexOfRole] := SPBConstantNames[isc_spb_sql_role_name] +
                                     '=' + RoleName;
    end;
  end;
end;

procedure TpFIBCustomService.CheckActive;
begin
  if FStreamedActive and (not Active) then
    Loaded;
  if FHandle = nil then
    FIBError(feServiceActive, [nil]);
end;

procedure TpFIBCustomService.CheckInactive;
begin
  if FHandle <> nil then
    FIBError(feServiceInActive, [nil]);
end;

constructor TpFIBCustomService.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLibraryName := IBASE_DLL;
  // FGDSLibrary := GetGDSLibrary;
  FIBLoaded := False;
  // FGDSLibrary.CheckIBLoaded;
  FIBLoaded := True;
  FProtocol := local;
  FserverName := '';
  FParams := TStringList.Create;
  FParamsChanged := True;
  TStringList(FParams).OnChange := ParamsChange;
  TStringList(FParams).OnChanging := ParamsChanging;
  FSPB := nil;
  FQuerySPB := nil;
  FBufferSize := DefaultBufferSize;
  FHandle := nil;
  FLoginPrompt := True;
  // FTraceFlags := [];
  FOutputbuffer := nil;
  // FGDSLibrary := GetGDSLibrary;
end;

destructor TpFIBCustomService.Destroy;
begin
  if FIBLoaded and Assigned(FClientLibrary) then
  begin
    if FHandle <> nil then
      Detach;
    FreeMem(FSPB);
    FSPB := nil;
  end;
  FreeMem(FOutputBuffer);
  FParams.Free;
  // FGDSLibrary := nil;
  inherited Destroy;
end;

procedure TpFIBCustomService.Detach;
begin
  CheckActive;
  LoadLibrary;
  if (Call(FClientLibrary.isc_service_detach(StatusVector, @FHandle), False) > 0) then
  begin
    FHandle := nil;
    IBError(FClientLibrary, Self);
  end
  else
    FHandle := nil;
{$IFNDEF NO_MONITOR}
  MonitorHook.ServiceDetach(Self);
{$ENDIF}
end;

procedure TpFIBCustomService.LoadLibrary;
begin
  if not Assigned(FClientLibrary) then
    FClientLibrary := IB_Intf.GetClientLibrary(FLibraryName);
end;

function TpFIBCustomService.GetActive: Boolean;
begin
  result := FHandle <> nil;
end;

function TpFIBCustomService.GetServiceParamBySPB(const Idx: Integer): String;
var
  ConstIdx, EqualsIdx: Integer;
begin
  if (Idx > 0) and (Idx <= isc_spb_last_spb_constant) then
  begin
    ConstIdx := IndexOfSPBConst(SPBConstantNames[Idx]);
    if ConstIdx = -1 then
      result := ''
    else
    begin
      result := Params[ConstIdx];
      EqualsIdx := Pos('=', result); {mbcs ok}
      if EqualsIdx = 0 then
        result := ''
      else
        result := Copy(result, EqualsIdx + 1, Length(result));
    end;
  end
  else
    result := '';
end;

procedure TpFIBCustomService.InternalServiceQuery;
begin
  FQuerySPBLength := Length(FQueryParams);
  if FQuerySPBLength = 0 then
    FIBError(feQueryParamsError, [nil]);
  FIBAlloc(FQuerySPB, 0, FQuerySPBLength);
  Move(FQueryParams[1], FQuerySPB[0], FQuerySPBLength);
  if (FOutputBuffer = nil) then
    FIBAlloc(FOutputBuffer, 0, FBufferSize);
  try
    LoadLibrary;
    if call(FClientLibrary.isc_service_query(StatusVector, @FHandle, nil, 0, nil,
                           FQuerySPBLength, FQuerySPB,
                           FBufferSize, FOutputBuffer), False) > 0 then
    begin
      FHandle := nil;
      IBError(FClientLibrary, Self);
    end;
  finally
    FreeMem(FQuerySPB);
    FQuerySPB := nil;
    FQuerySPBLength := 0;
    FQueryParams := '';
  end;
{$IFNDEF NO_MONITOR}
  MonitorHook.ServiceQuery(Self);
{$ENDIF}
end;

procedure TpFIBCustomService.SetActive(const Value: Boolean);
begin
  if csReading in ComponentState then
    FStreamedActive := Value
  else
    if Value <> Active then   
      if Value then
        Attach
      else
        Detach;
end;

procedure TpFIBCustomService.SetBufferSize(const Value: Integer);
begin
  if (Value <> FBufferSize) then
  begin
    FBufferSize := Value;
    if FOutputBuffer <> nil then
      FIBAlloc(FOutputBuffer, 0, FBufferSize);
  end;
end;

procedure TpFIBCustomService.SetParams(const Value: TStrings);
begin
  FParams.Assign(Value);
end;

procedure TpFIBCustomService.SetServerName(const Value: string);
begin
  if FServerName <> Value then
  begin
    CheckInactive;
    FServerName := Value;
    if (FProtocol = Local) and (FServerName <> '') then