PageRenderTime 82ms CodeModel.GetById 27ms RepoModel.GetById 2ms app.codeStats 0ms

/Gedemin/IBX/IBServices.pas

http://gedemin.googlecode.com/
Pascal | 2067 lines | 1848 code | 145 blank | 74 comment | 130 complexity | 510acada417b3f00f88d5dbf6e4c4692 MD5 | raw file
Possible License(s): AGPL-3.0, MPL-2.0-no-copyleft-exception, GPL-2.0, LGPL-2.0, LGPL-2.1
  1. {************************************************************************}
  2. { }
  3. { Borland Delphi Visual Component Library }
  4. { InterBase Express core components }
  5. { }
  6. { Copyright (c) 1998-2001 Borland Software Corporation }
  7. { }
  8. { InterBase Express is based in part on the product }
  9. { Free IB Components, written by Gregory H. Deatz for }
  10. { Hoagland, Longo, Moran, Dunst & Doukas Company. }
  11. { Free IB Components is used under license. }
  12. { }
  13. { The contents of this file are subject to the InterBase }
  14. { Public License Version 1.0 (the "License"); you may not }
  15. { use this file except in compliance with the License. You may obtain }
  16. { a copy of the License at http://www.borland.com/interbase/IPL.html }
  17. { Software distributed under the License is distributed on }
  18. { an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
  19. { express or implied. See the License for the specific language }
  20. { governing rights and limitations under the License. }
  21. { The Original Code was created by InterBase Software Corporation }
  22. { and its successors. }
  23. { Portions created by Borland Software Corporation are Copyright }
  24. { (C) Borland Software Corporation. All Rights Reserved. }
  25. { Contributor(s): Jeff Overcash }
  26. { }
  27. {************************************************************************}
  28. {
  29. InterBase Express provides component interfaces to
  30. functions introduced in InterBase 6.0. The Services
  31. components (TIB*Service, TIBServerProperties) and
  32. Install components (TIBInstall, TIBUninstall, TIBSetup)
  33. function only if you have installed InterBase 6.0 or
  34. later software
  35. }
  36. unit IBServices;
  37. interface
  38. uses
  39. SysUtils, Classes,
  40. Controls, Forms,
  41. IBDialogs, IBHeader, IB, IBExternals;
  42. const
  43. DefaultBufferSize = 32000;
  44. SPBPrefix = 'isc_spb_';
  45. SPBConstantNames: array[1..isc_spb_last_spb_constant] of String = (
  46. 'user_name',
  47. 'sys_user_name',
  48. 'sys_user_name_enc',
  49. 'password',
  50. 'password_enc',
  51. 'command_line',
  52. 'db_name',
  53. 'verbose',
  54. 'options',
  55. 'connect_timeout',
  56. 'dummy_packet_interval',
  57. 'sql_role_name'
  58. );
  59. SPBConstantValues: array[1..isc_spb_last_spb_constant] of Integer = (
  60. isc_spb_user_name_mapped_to_server,
  61. isc_spb_sys_user_name_mapped_to_server,
  62. isc_spb_sys_user_name_enc_mapped_to_server,
  63. isc_spb_password_mapped_to_server,
  64. isc_spb_password_enc_mapped_to_server,
  65. isc_spb_command_line_mapped_to_server,
  66. isc_spb_dbname_mapped_to_server,
  67. isc_spb_verbose_mapped_to_server,
  68. isc_spb_options_mapped_to_server,
  69. isc_spb_connect_timeout_mapped_to_server,
  70. isc_spb_dummy_packet_interval_mapped_to_server,
  71. isc_spb_sql_role_name_mapped_to_server
  72. );
  73. type
  74. TProtocol = (TCP, SPX, NamedPipe, Local);
  75. TOutputBufferOption = (ByLine, ByChunk);
  76. TIBCustomService = class;
  77. TLoginEvent = procedure(Database: TIBCustomService;
  78. LoginParams: TStrings) of object;
  79. TIBCustomService = class(TComponent)
  80. private
  81. FIBLoaded: Boolean;
  82. FParamsChanged : Boolean;
  83. FSPB, FQuerySPB : PChar;
  84. FSPBLength, FQuerySPBLength : Short;
  85. FTraceFlags: TTraceFlags;
  86. FOnLogin: TLoginEvent;
  87. FLoginPrompt: Boolean;
  88. FBufferSize: Integer;
  89. FOutputBuffer: PChar;
  90. FQueryParams: String;
  91. FServerName: string;
  92. FHandle: TISC_SVC_HANDLE;
  93. FStreamedActive : Boolean;
  94. FOnAttach: TNotifyEvent;
  95. FOutputBufferOption: TOutputBufferOption;
  96. FProtocol: TProtocol;
  97. FParams: TStrings;
  98. function GetActive: Boolean;
  99. function GetServiceParamBySPB(const Idx: Integer): String;
  100. procedure SetActive(const Value: Boolean);
  101. procedure SetBufferSize(const Value: Integer);
  102. procedure SetParams(const Value: TStrings);
  103. procedure SetServerName(const Value: string);
  104. procedure SetProtocol(const Value: TProtocol);
  105. procedure SetServiceParamBySPB(const Idx: Integer;
  106. const Value: String);
  107. function IndexOfSPBConst(st: String): Integer;
  108. procedure ParamsChange(Sender: TObject);
  109. procedure ParamsChanging(Sender: TObject);
  110. procedure CheckServerName;
  111. function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
  112. function ParseString(var RunLen: Integer): string;
  113. function ParseInteger(var RunLen: Integer): Integer;
  114. procedure GenerateSPB(sl: TStrings; var SPB: String; var SPBLength: Short);
  115. protected
  116. procedure Loaded; override;
  117. function Login: Boolean;
  118. procedure CheckActive;
  119. procedure CheckInactive;
  120. property OutputBuffer : PChar read FOutputBuffer;
  121. property OutputBufferOption : TOutputBufferOption read FOutputBufferOption write FOutputBufferOption;
  122. property BufferSize : Integer read FBufferSize write SetBufferSize default DefaultBufferSize;
  123. procedure InternalServiceQuery;
  124. property ServiceQueryParams: String read FQueryParams write FQueryParams;
  125. public
  126. constructor Create(AOwner: TComponent); override;
  127. destructor Destroy; override;
  128. procedure Attach;
  129. procedure Detach;
  130. property Handle: TISC_SVC_HANDLE read FHandle;
  131. property ServiceParamBySPB[const Idx: Integer]: String read GetServiceParamBySPB
  132. write SetServiceParamBySPB;
  133. published
  134. property Active: Boolean read GetActive write SetActive default False;
  135. property ServerName: string read FServerName write SetServerName;
  136. property Protocol: TProtocol read FProtocol write SetProtocol default Local;
  137. property Params: TStrings read FParams write SetParams;
  138. property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt default True;
  139. property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
  140. property OnAttach: TNotifyEvent read FOnAttach write FOnAttach;
  141. property OnLogin: TLoginEvent read FOnLogin write FOnLogin;
  142. end;
  143. TDatabaseInfo = class
  144. public
  145. NoOfAttachments: Integer;
  146. NoOfDatabases: Integer;
  147. DbName: array of string;
  148. constructor Create;
  149. destructor Destroy; override;
  150. end;
  151. TLicenseInfo = class
  152. public
  153. Key: array of string;
  154. Id: array of string;
  155. Desc: array of string;
  156. LicensedUsers: Integer;
  157. constructor Create;
  158. destructor Destroy; override;
  159. end;
  160. TLicenseMaskInfo = class
  161. public
  162. LicenseMask: Integer;
  163. CapabilityMask: Integer;
  164. end;
  165. TConfigFileData = class
  166. public
  167. ConfigFileValue: array of integer;
  168. ConfigFileKey: array of integer;
  169. constructor Create;
  170. destructor Destroy; override;
  171. end;
  172. TConfigParams = class
  173. public
  174. ConfigFileData: TConfigFileData;
  175. ConfigFileParams: array of string;
  176. BaseLocation: string;
  177. LockFileLocation: string;
  178. MessageFileLocation: string;
  179. SecurityDatabaseLocation: string;
  180. constructor Create;
  181. destructor Destroy; override;
  182. end;
  183. TVersionInfo = class
  184. ServerVersion: String;
  185. ServerImplementation: string;
  186. ServiceVersion: Integer;
  187. end;
  188. TPropertyOption = (Database, License, LicenseMask, ConfigParameters, Version);
  189. TPropertyOptions = set of TPropertyOption;
  190. TIBServerProperties = class(TIBCustomService)
  191. private
  192. FOptions: TPropertyOptions;
  193. FDatabaseInfo: TDatabaseInfo;
  194. FLicenseInfo: TLicenseInfo;
  195. FLicenseMaskInfo: TLicenseMaskInfo;
  196. FVersionInfo: TVersionInfo;
  197. FConfigParams: TConfigParams;
  198. procedure ParseConfigFileData(var RunLen: Integer);
  199. public
  200. constructor Create(AOwner: TComponent); override;
  201. destructor Destroy; override;
  202. procedure Fetch;
  203. procedure FetchDatabaseInfo;
  204. procedure FetchLicenseInfo;
  205. procedure FetchLicenseMaskInfo;
  206. procedure FetchConfigParams;
  207. procedure FetchVersionInfo;
  208. property DatabaseInfo: TDatabaseInfo read FDatabaseInfo;
  209. property LicenseInfo: TLicenseInfo read FLicenseInfo;
  210. property LicenseMaskInfo: TLicenseMaskInfo read FLicenseMaskInfo;
  211. property VersionInfo: TVersionInfo read FVersionInfo;
  212. property ConfigParams: TConfigParams read FConfigParams;
  213. published
  214. property Options : TPropertyOptions read FOptions write FOptions;
  215. end;
  216. TIBControlService = class (TIBCustomService)
  217. private
  218. FStartParams: String;
  219. FStartSPB: PChar;
  220. FStartSPBLength: Integer;
  221. function GetIsServiceRunning: Boolean;
  222. protected
  223. property ServiceStartParams: String read FStartParams write FStartParams;
  224. procedure SetServiceStartOptions; virtual;
  225. procedure ServiceStartAddParam (Value: string; param: Integer); overload;
  226. procedure ServiceStartAddParam (Value: Integer; param: Integer); overload;
  227. procedure ServiceStartAddByteParam (Value: Byte; param: Integer);
  228. procedure InternalServiceStart;
  229. public
  230. constructor Create(AOwner: TComponent); override;
  231. procedure ServiceStart; virtual;
  232. property IsServiceRunning : Boolean read GetIsServiceRunning;
  233. end;
  234. TIBControlAndQueryService = class (TIBControlService)
  235. private
  236. FEof: Boolean;
  237. FAction: Integer;
  238. procedure SetAction(Value: Integer);
  239. protected
  240. property Action: Integer read FAction write SetAction;
  241. public
  242. constructor create (AOwner: TComponent); override;
  243. function GetNextLine : String;
  244. function GetNextChunk : String;
  245. property Eof: boolean read FEof;
  246. published
  247. property BufferSize;
  248. end;
  249. //TShutdownMode = (Forced, DenyTransaction, DenyAttachment);
  250. TShutdownModeEx = (smeForce, smeAttachment, smeTransaction);
  251. TOperationMode = (omNormal, omMulti, omSingle, omFull);
  252. TIBConfigService = class(TIBControlService)
  253. private
  254. FDatabaseName: string;
  255. procedure SetDatabaseName(const Value: string);
  256. protected
  257. public
  258. procedure ServiceStart; override;
  259. //procedure ShutdownDatabase (Options: TShutdownMode; Wait: Integer);
  260. procedure ShutdownDatabase (Options: TShutdownModeEx; Wait: Integer; OperationMode: TOperationMode);
  261. procedure SetSweepInterval (Value: Integer);
  262. procedure SetDBSqlDialect (Value: Integer);
  263. procedure SetPageBuffers (Value: Integer);
  264. procedure ActivateShadow;
  265. procedure BringDatabaseOnline;
  266. procedure SetReserveSpace (Value: Boolean);
  267. procedure SetAsyncMode (Value: Boolean);
  268. procedure SetReadOnly (Value: Boolean);
  269. published
  270. property DatabaseName: string read FDatabaseName write SetDatabaseName;
  271. end;
  272. TLicensingAction = (LicenseAdd, LicenseRemove);
  273. TIBLicensingService = class(TIBControlService)
  274. private
  275. FID: String;
  276. FKey: String;
  277. FAction: TLicensingAction;
  278. procedure SetAction(Value: TLicensingAction);
  279. protected
  280. procedure SetServiceStartOptions; override;
  281. public
  282. procedure AddLicense;
  283. procedure RemoveLicense;
  284. published
  285. property Action: TLicensingAction read FAction write SetAction default LicenseAdd;
  286. property Key: String read FKey write FKey;
  287. property ID: String read FID write FID;
  288. end;
  289. TIBLogService = class(TIBControlAndQueryService)
  290. private
  291. protected
  292. procedure SetServiceStartOptions; override;
  293. public
  294. published
  295. end;
  296. TStatOption = (DataPages, DbLog, HeaderPages, IndexPages, SystemRelations);
  297. TStatOptions = set of TStatOption;
  298. TIBStatisticalService = class(TIBControlAndQueryService)
  299. private
  300. FDatabaseName: string;
  301. FOptions: TStatOptions;
  302. procedure SetDatabaseName(const Value: string);
  303. protected
  304. procedure SetServiceStartOptions; override;
  305. public
  306. published
  307. property DatabaseName: string read FDatabaseName write SetDatabaseName;
  308. property Options : TStatOptions read FOptions write FOptions;
  309. end;
  310. TIBBackupRestoreService = class(TIBControlAndQueryService)
  311. private
  312. FVerbose: Boolean;
  313. protected
  314. public
  315. published
  316. property Verbose : Boolean read FVerbose write FVerbose default False;
  317. end;
  318. TBackupOption = (IgnoreChecksums, IgnoreLimbo, MetadataOnly, NoGarbageCollection,
  319. OldMetadataDesc, NonTransportable, ConvertExtTables);
  320. TBackupOptions = set of TBackupOption;
  321. TIBBackupService = class (TIBBackupRestoreService)
  322. private
  323. FDatabaseName: string;
  324. FOptions: TBackupOptions;
  325. FBackupFile: TStrings;
  326. FBlockingFactor: Integer;
  327. procedure SetBackupFile(const Value: TStrings);
  328. protected
  329. procedure SetServiceStartOptions; override;
  330. public
  331. constructor Create(AOwner: TComponent); override;
  332. destructor Destroy; override;
  333. published
  334. { a name=value pair of filename and length }
  335. property BackupFile: TStrings read FBackupFile write SetBackupFile;
  336. property BlockingFactor: Integer read FBlockingFactor write FBlockingFactor;
  337. property DatabaseName: string read FDatabaseName write FDatabaseName;
  338. property Options : TBackupOptions read FOptions write FOptions;
  339. end;
  340. TRestoreOption = (DeactivateIndexes, NoShadow, NoValidityCheck, OneRelationAtATime,
  341. Replace, CreateNewDB, UseAllSpace, FixFss);
  342. TRestoreOptions = set of TRestoreOption;
  343. TIBRestoreService = class (TIBBackupRestoreService)
  344. private
  345. FDatabaseName: TStrings;
  346. FBackupFile: TStrings;
  347. FOptions: TRestoreOptions;
  348. FPageSize: Integer;
  349. FPageBuffers: Integer;
  350. FFixFssCharacterSet: String;
  351. procedure SetBackupFile(const Value: TStrings);
  352. procedure SetDatabaseName(const Value: TStrings);
  353. protected
  354. procedure SetServiceStartOptions; override;
  355. public
  356. constructor Create(AOwner: TComponent); override;
  357. destructor Destroy; override;
  358. published
  359. { a name=value pair of filename and length }
  360. property DatabaseName: TStrings read FDatabaseName write SetDatabaseName;
  361. property BackupFile: TStrings read FBackupFile write SetBackupFile;
  362. property PageSize: Integer read FPageSize write FPageSize default 4096;
  363. property PageBuffers: Integer read FPageBuffers write FPageBuffers;
  364. property FixFssCharacterSet: String read FFixFssCharacterSet write FFixFssCharacterSet;
  365. property Options : TRestoreOptions read FOptions write FOptions default [CreateNewDB];
  366. end;
  367. TValidateOption = (LimboTransactions, CheckDB, IgnoreChecksum, KillShadows, MendDB,
  368. SweepDB, ValidateDB, ValidateFull);
  369. TValidateOptions = set of TValidateOption;
  370. TTransactionGlobalAction = (CommitGlobal, RollbackGlobal, RecoverTwoPhaseGlobal,
  371. NoGlobalAction);
  372. TTransactionState = (LimboState, CommitState, RollbackState, UnknownState);
  373. TTransactionAdvise = (CommitAdvise, RollbackAdvise, UnknownAdvise);
  374. TTransactionAction = (CommitAction, RollbackAction);
  375. TLimboTransactionInfo = class
  376. public
  377. MultiDatabase: Boolean;
  378. ID: Integer;
  379. HostSite: String;
  380. RemoteSite: String;
  381. RemoteDatabasePath: String;
  382. State: TTransactionState;
  383. Advise: TTransactionAdvise;
  384. Action: TTransactionAction;
  385. end;
  386. TIBValidationService = class(TIBControlAndQueryService)
  387. private
  388. FDatabaseName: string;
  389. FOptions: TValidateOptions;
  390. FLimboTransactionInfo: array of TLimboTransactionInfo;
  391. FGlobalAction: TTransactionGlobalAction;
  392. procedure SetDatabaseName(const Value: string);
  393. function GetLimboTransactionInfo(index: integer): TLimboTransactionInfo;
  394. function GetLimboTransactionInfoCount: integer;
  395. protected
  396. procedure SetServiceStartOptions; override;
  397. public
  398. constructor Create(AOwner: TComponent); override;
  399. destructor Destroy; override;
  400. procedure FetchLimboTransactionInfo;
  401. procedure FixLimboTransactionErrors;
  402. property LimboTransactionInfo[Index: integer]: TLimboTransactionInfo read GetLimboTransactionInfo;
  403. property LimboTransactionInfoCount: Integer read GetLimboTransactionInfoCount;
  404. published
  405. property DatabaseName: string read FDatabaseName write SetDatabaseName;
  406. property Options: TValidateOptions read FOptions write FOptions;
  407. property GlobalAction: TTransactionGlobalAction read FGlobalAction
  408. write FGlobalAction;
  409. end;
  410. TUserInfo = class
  411. public
  412. UserName: string;
  413. FirstName: string;
  414. MiddleName: string;
  415. LastName: string;
  416. GroupID: Integer;
  417. UserID: Integer;
  418. end;
  419. TSecurityAction = (ActionAddUser, ActionDeleteUser, ActionModifyUser, ActionDisplayUser);
  420. TSecurityModifyParam = (ModifyFirstName, ModifyMiddleName, ModifyLastName, ModifyUserId,
  421. ModifyGroupId, ModifyPassword);
  422. TSecurityModifyParams = set of TSecurityModifyParam;
  423. TIBSecurityService = class(TIBControlAndQueryService)
  424. private
  425. FUserID: Integer;
  426. FGroupID: Integer;
  427. FFirstName: string;
  428. FUserName: string;
  429. FPassword: string;
  430. FSQLRole: string;
  431. FLastName: string;
  432. FMiddleName: string;
  433. FUserInfo: array of TUserInfo;
  434. FSecurityAction: TSecurityAction;
  435. FModifyParams: TSecurityModifyParams;
  436. procedure ClearParams;
  437. procedure SetSecurityAction (Value: TSecurityAction);
  438. procedure SetFirstName (Value: String);
  439. procedure SetMiddleName (Value: String);
  440. procedure SetLastName (Value: String);
  441. procedure SetPassword (Value: String);
  442. procedure SetUserId (Value: Integer);
  443. procedure SetGroupId (Value: Integer);
  444. procedure FetchUserInfo;
  445. function GetUserInfo(Index: Integer): TUserInfo;
  446. function GetUserInfoCount: Integer;
  447. protected
  448. procedure Loaded; override;
  449. procedure SetServiceStartOptions; override;
  450. public
  451. constructor Create(AOwner: TComponent); override;
  452. destructor Destroy; override;
  453. procedure DisplayUsers;
  454. procedure DisplayUser(UserName: string);
  455. procedure AddUser;
  456. procedure DeleteUser;
  457. procedure ModifyUser;
  458. property UserInfo[Index: Integer]: TUserInfo read GetUserInfo;
  459. property UserInfoCount: Integer read GetUserInfoCount;
  460. published
  461. property SecurityAction: TSecurityAction read FSecurityAction
  462. write SetSecurityAction;
  463. property SQlRole : string read FSQLRole write FSQLrole;
  464. property UserName : string read FUserName write FUserName;
  465. property FirstName : string read FFirstName write SetFirstName;
  466. property MiddleName : string read FMiddleName write SetMiddleName;
  467. property LastName : string read FLastName write SetLastName;
  468. property UserID : Integer read FUserID write SetUserID;
  469. property GroupID : Integer read FGroupID write SetGroupID;
  470. property Password : string read FPassword write setPassword;
  471. end;
  472. implementation
  473. uses
  474. IBIntf,
  475. {$IFDEF GEDEMIN}
  476. IBSQLMonitor_Gedemin
  477. {$ELSE}
  478. IBSQLMonitor
  479. {$ENDIF}
  480. ;
  481. { TIBCustomService }
  482. procedure TIBCustomService.Attach;
  483. var
  484. SPB: String;
  485. ConnectString: String;
  486. begin
  487. CheckInactive;
  488. CheckServerName;
  489. if FLoginPrompt and not Login then
  490. IBError(ibxeOperationCancelled, [nil]);
  491. { Generate a new SPB if necessary }
  492. if FParamsChanged then
  493. begin
  494. FParamsChanged := False;
  495. GenerateSPB(FParams, SPB, FSPBLength);
  496. IBAlloc(FSPB, 0, FsPBLength);
  497. Move(SPB[1], FSPB[0], FSPBLength);
  498. end;
  499. case FProtocol of
  500. TCP: ConnectString := FServerName + ':service_mgr'; {do not localize}
  501. SPX: ConnectString := FServerName + '@service_mgr'; {do not localize}
  502. NamedPipe: ConnectString := '\\' + FServerName + '\service_mgr'; {do not localize}
  503. Local: ConnectString := 'service_mgr'; {do not localize}
  504. end;
  505. if call(isc_service_attach(StatusVector, Length(ConnectString),
  506. PChar(ConnectString), @FHandle,
  507. FSPBLength, FSPB), False) > 0 then
  508. begin
  509. FHandle := nil;
  510. IBDataBaseError;
  511. end;
  512. if Assigned(FOnAttach) then
  513. FOnAttach(Self);
  514. MonitorHook.ServiceAttach(Self);
  515. end;
  516. procedure TIBCustomService.Loaded;
  517. begin
  518. inherited Loaded;
  519. try
  520. if FStreamedActive and (not Active) then
  521. Attach;
  522. except
  523. if csDesigning in ComponentState then
  524. Application.HandleException(Self)
  525. else
  526. raise;
  527. end;
  528. end;
  529. function TIBCustomService.Login: Boolean;
  530. var
  531. IndexOfUser, IndexOfPassword: Integer;
  532. Username, Password: String;
  533. LoginParams: TStrings;
  534. begin
  535. if Assigned(FOnLogin) then begin
  536. result := True;
  537. LoginParams := TStringList.Create;
  538. try
  539. LoginParams.Assign(Params);
  540. FOnLogin(Self, LoginParams);
  541. Params.Assign (LoginParams);
  542. finally
  543. LoginParams.Free;
  544. end;
  545. end
  546. else
  547. begin
  548. IndexOfUser := IndexOfSPBConst(SPBConstantNames[isc_spb_user_name]);
  549. if IndexOfUser <> -1 then
  550. Username := Copy(Params[IndexOfUser],
  551. Pos('=', Params[IndexOfUser]) + 1, {mbcs ok}
  552. Length(Params[IndexOfUser]));
  553. IndexOfPassword := IndexOfSPBConst(SPBConstantNames[isc_spb_password]);
  554. if IndexOfPassword <> -1 then
  555. Password := Copy(Params[IndexOfPassword],
  556. Pos('=', Params[IndexOfPassword]) + 1, {mbcs ok}
  557. Length(Params[IndexOfPassword]));
  558. result := ServerLoginDialog(serverName, Username, Password);
  559. if result then
  560. begin
  561. IndexOfPassword := IndexOfSPBConst(SPBConstantNames[isc_spb_password]);
  562. if IndexOfUser = -1 then
  563. Params.Add(SPBConstantNames[isc_spb_user_name] + '=' + Username)
  564. else
  565. Params[IndexOfUser] := SPBConstantNames[isc_spb_user_name] +
  566. '=' + Username;
  567. if IndexOfPassword = -1 then
  568. Params.Add(SPBConstantNames[isc_spb_password] + '=' + Password)
  569. else
  570. Params[IndexOfPassword] := SPBConstantNames[isc_spb_password] +
  571. '=' + Password;
  572. end;
  573. end;
  574. end;
  575. procedure TIBCustomService.CheckActive;
  576. begin
  577. if FStreamedActive and (not Active) then
  578. Loaded;
  579. if FHandle = nil then
  580. IBError(ibxeServiceActive, [nil]);
  581. end;
  582. procedure TIBCustomService.CheckInactive;
  583. begin
  584. if FHandle <> nil then
  585. IBError(ibxeServiceInActive, [nil]);
  586. end;
  587. constructor TIBCustomService.Create(AOwner: TComponent);
  588. begin
  589. inherited Create(AOwner);
  590. FIBLoaded := False;
  591. CheckIBLoaded;
  592. FIBLoaded := True;
  593. FProtocol := local;
  594. FserverName := '';
  595. FParams := TStringList.Create;
  596. FParamsChanged := True;
  597. TStringList(FParams).OnChange := ParamsChange;
  598. TStringList(FParams).OnChanging := ParamsChanging;
  599. FSPB := nil;
  600. FQuerySPB := nil;
  601. FBufferSize := DefaultBufferSize;
  602. FHandle := nil;
  603. FLoginPrompt := True;
  604. FTraceFlags := [];
  605. FOutputbuffer := nil;
  606. end;
  607. destructor TIBCustomService.Destroy;
  608. begin
  609. if FIBLoaded then
  610. begin
  611. if FHandle <> nil then
  612. Detach;
  613. FreeMem(FSPB);
  614. FSPB := nil;
  615. FParams.Free;
  616. end;
  617. ReallocMem(FOutputBuffer, 0);
  618. inherited Destroy;
  619. end;
  620. procedure TIBCustomService.Detach;
  621. begin
  622. CheckActive;
  623. if (Call(isc_service_detach(StatusVector, @FHandle), False) > 0) then
  624. begin
  625. FHandle := nil;
  626. IBDataBaseError;
  627. end
  628. else
  629. FHandle := nil;
  630. MonitorHook.ServiceDetach(Self);
  631. end;
  632. function TIBCustomService.GetActive: Boolean;
  633. begin
  634. result := FHandle <> nil;
  635. end;
  636. function TIBCustomService.GetServiceParamBySPB(const Idx: Integer): String;
  637. var
  638. ConstIdx, EqualsIdx: Integer;
  639. begin
  640. if (Idx > 0) and (Idx <= isc_spb_last_spb_constant) then
  641. begin
  642. ConstIdx := IndexOfSPBConst(SPBConstantNames[Idx]);
  643. if ConstIdx = -1 then
  644. result := ''
  645. else
  646. begin
  647. result := Params[ConstIdx];
  648. EqualsIdx := Pos('=', result); {mbcs ok}
  649. if EqualsIdx = 0 then
  650. result := ''
  651. else
  652. result := Copy(result, EqualsIdx + 1, Length(result));
  653. end;
  654. end
  655. else
  656. result := '';
  657. end;
  658. procedure TIBCustomService.InternalServiceQuery;
  659. begin
  660. FQuerySPBLength := Length(FQueryParams);
  661. if FQuerySPBLength = 0 then
  662. IBError(ibxeQueryParamsError, [nil]);
  663. IBAlloc(FQuerySPB, 0, FQuerySPBLength);
  664. Move(FQueryParams[1], FQuerySPB[0], FQuerySPBLength);
  665. if (FOutputBuffer = nil) then
  666. IBAlloc(FOutputBuffer, 0, FBufferSize);
  667. try
  668. if call(isc_service_query(StatusVector, @FHandle, nil, 0, nil,
  669. FQuerySPBLength, FQuerySPB,
  670. FBufferSize, FOutputBuffer), False) > 0 then
  671. begin
  672. FHandle := nil;
  673. IBDataBaseError;
  674. end;
  675. finally
  676. FreeMem(FQuerySPB);
  677. FQuerySPB := nil;
  678. FQuerySPBLength := 0;
  679. FQueryParams := '';
  680. end;
  681. MonitorHook.ServiceQuery(Self);
  682. end;
  683. procedure TIBCustomService.SetActive(const Value: Boolean);
  684. begin
  685. if csReading in ComponentState then
  686. FStreamedActive := Value
  687. else
  688. if Value <> Active then
  689. if Value then
  690. Attach
  691. else
  692. Detach;
  693. end;
  694. procedure TIBCustomService.SetBufferSize(const Value: Integer);
  695. begin
  696. if (Value <> FBufferSize) then
  697. begin
  698. FBufferSize := Value;
  699. if FOutputBuffer <> nil then
  700. IBAlloc(FOutputBuffer, 0, FBufferSize);
  701. end;
  702. end;
  703. procedure TIBCustomService.SetParams(const Value: TStrings);
  704. begin
  705. FParams.Assign(Value);
  706. end;
  707. procedure TIBCustomService.SetServerName(const Value: string);
  708. begin
  709. if FServerName <> Value then
  710. begin
  711. CheckInactive;
  712. FServerName := Value;
  713. if (FProtocol = Local) and (FServerName <> '') then
  714. FProtocol := TCP
  715. else
  716. if (FProtocol <> Local) and (FServerName = '') then
  717. FProtocol := Local;
  718. end;
  719. end;
  720. procedure TIBCustomService.SetProtocol(const Value: TProtocol);
  721. begin
  722. if FProtocol <> Value then
  723. begin
  724. CheckInactive;
  725. FProtocol := Value;
  726. if (Value = Local) then
  727. FServerName := '';
  728. end;
  729. end;
  730. procedure TIBCustomService.SetServiceParamBySPB(const Idx: Integer;
  731. const Value: String);
  732. var
  733. ConstIdx: Integer;
  734. begin
  735. ConstIdx := IndexOfSPBConst(SPBConstantNames[Idx]);
  736. if (Value = '') then
  737. begin
  738. if ConstIdx <> -1 then
  739. Params.Delete(ConstIdx);
  740. end
  741. else
  742. begin
  743. if (ConstIdx = -1) then
  744. Params.Add(SPBConstantNames[Idx] + '=' + Value)
  745. else
  746. Params[ConstIdx] := SPBConstantNames[Idx] + '=' + Value;
  747. end;
  748. end;
  749. function TIBCustomService.IndexOfSPBConst(st: String): Integer;
  750. var
  751. i, pos_of_str: Integer;
  752. begin
  753. result := -1;
  754. for i := 0 to Params.Count - 1 do
  755. begin
  756. pos_of_str := Pos(st, Params[i]); {mbcs ok}
  757. if (pos_of_str = 1) or (pos_of_str = Length(SPBPrefix) + 1) then
  758. begin
  759. result := i;
  760. break;
  761. end;
  762. end;
  763. end;
  764. procedure TIBCustomService.ParamsChange(Sender: TObject);
  765. begin
  766. FParamsChanged := True;
  767. end;
  768. procedure TIBCustomService.ParamsChanging(Sender: TObject);
  769. begin
  770. CheckInactive;
  771. end;
  772. procedure TIBCustomService.CheckServerName;
  773. begin
  774. if (FServerName = '') and (FProtocol <> Local) then
  775. IBError(ibxeServerNameMissing, [nil]);
  776. end;
  777. function TIBCustomService.Call(ErrCode: ISC_STATUS;
  778. RaiseError: Boolean): ISC_STATUS;
  779. begin
  780. result := ErrCode;
  781. if RaiseError and (ErrCode > 0) then
  782. IBDataBaseError;
  783. end;
  784. function TIBCustomService.ParseString(var RunLen: Integer): string;
  785. var
  786. Len: UShort;
  787. tmp: Char;
  788. begin
  789. Len := isc_vax_integer(OutputBuffer + RunLen, 2);
  790. RunLen := RunLen + 2;
  791. if (Len <> 0) then
  792. begin
  793. tmp := OutputBuffer[RunLen + Len];
  794. OutputBuffer[RunLen + Len] := #0;
  795. result := String(PChar(@OutputBuffer[RunLen]));
  796. OutputBuffer[RunLen + Len] := tmp;
  797. RunLen := RunLen + Len;
  798. end
  799. else
  800. result := '';
  801. end;
  802. function TIBCustomService.ParseInteger(var RunLen: Integer): Integer;
  803. begin
  804. result := isc_vax_integer(OutputBuffer + RunLen, 4);
  805. RunLen := RunLen + 4;
  806. end;
  807. {
  808. * GenerateSPB -
  809. * Given a string containing a textual representation
  810. * of the Service parameters, generate a service
  811. * parameter buffer, and return it and its length
  812. * in SPB and SPBLength, respectively.
  813. }
  814. procedure TIBCustomService.GenerateSPB(sl: TStrings; var SPB: String;
  815. var SPBLength: Short);
  816. var
  817. i, j : Integer;
  818. SPBVal, SPBServerVal: UShort;
  819. param_name, param_value: String;
  820. begin
  821. { The SPB is initially empty, with the exception that
  822. the SPB version must be the first byte of the string.
  823. }
  824. SPBLength := 2;
  825. SPB := Char(isc_spb_version);
  826. SPB := SPB + Char(isc_spb_current_version);
  827. { Iterate through the textual service parameters, constructing
  828. a SPB on-the-fly}
  829. for i := 0 to sl.Count - 1 do
  830. begin
  831. { Get the parameter's name and value from the list,
  832. and make sure that the name is all lowercase with
  833. no leading 'isc_spb_' prefix }
  834. if (Trim(sl.Names[i]) = '') then
  835. continue;
  836. param_name := LowerCase(sl.Names[i]); {mbcs ok}
  837. param_value := Copy(sl[i], Pos('=', sl[i]) + 1, Length(sl[i])); {mbcs ok}
  838. if (Pos(SPBPrefix, param_name) = 1) then {mbcs ok}
  839. Delete(param_name, 1, Length(SPBPrefix));
  840. { We want to translate the parameter name to some integer
  841. value. We do this by scanning through a list of known
  842. service parameter names (SPBConstantNames, defined above). }
  843. SPBVal := 0;
  844. SPBServerVal := 0;
  845. { Find the parameter }
  846. for j := 1 to isc_spb_last_spb_constant do
  847. if (param_name = SPBConstantNames[j]) then
  848. begin
  849. SPBVal := j;
  850. SPBServerVal := SPBConstantValues[j];
  851. break;
  852. end;
  853. case SPBVal of
  854. isc_spb_user_name, isc_spb_password:
  855. begin
  856. SPB := SPB +
  857. Char(SPBServerVal) +
  858. Char(Length(param_value)) +
  859. param_value;
  860. Inc(SPBLength, 2 + Length(param_value));
  861. end;
  862. else
  863. begin
  864. if (SPBVal > 0) and
  865. (SPBVal <= isc_dpb_last_dpb_constant) then
  866. IBError(ibxeSPBConstantNotSupported,
  867. [SPBConstantNames[SPBVal]])
  868. else
  869. IBError(ibxeSPBConstantUnknown, [SPBVal]);
  870. end;
  871. end;
  872. end;
  873. end;
  874. { TIBServerProperties }
  875. constructor TIBServerProperties.Create(AOwner: TComponent);
  876. begin
  877. inherited Create(AOwner);
  878. FDatabaseInfo := TDatabaseInfo.Create;
  879. FLicenseInfo := TLicenseInfo.Create;
  880. FLicenseMaskInfo := TLicenseMaskInfo.Create;
  881. FVersionInfo := TVersionInfo.Create;
  882. FConfigParams := TConfigParams.Create;
  883. end;
  884. destructor TIBServerProperties.Destroy;
  885. begin
  886. FDatabaseInfo.Free;
  887. FLicenseInfo.Free;
  888. FLicenseMaskInfo.Free;
  889. FVersionInfo.Free;
  890. FConfigParams.Free;
  891. inherited Destroy;
  892. end;
  893. procedure TIBServerProperties.ParseConfigFileData(var RunLen: Integer);
  894. begin
  895. Inc(RunLen);
  896. with FConfigParams.ConfigFileData do
  897. begin
  898. SetLength (ConfigFileValue, Length(ConfigFileValue)+1);
  899. SetLength (ConfigFileKey, Length(ConfigFileKey)+1);
  900. ConfigFileKey[High(ConfigFileKey)] := Integer(OutputBuffer[RunLen-1]);
  901. ConfigFileValue[High(ConfigFileValue)] := ParseInteger(RunLen);
  902. end;
  903. end;
  904. procedure TIBServerProperties.Fetch;
  905. begin
  906. if (Database in Options) then
  907. FetchDatabaseInfo;
  908. if (License in Options) then
  909. FetchLicenseInfo;
  910. if (LicenseMask in Options) then
  911. FetchLicenseMaskInfo;
  912. if (ConfigParameters in Options) then
  913. FetchConfigParams;
  914. if (Version in Options) then
  915. FetchVersionInfo;
  916. end;
  917. procedure TIBServerProperties.FetchConfigParams;
  918. var
  919. RunLen: Integer;
  920. begin
  921. ServiceQueryParams := Char(isc_info_svc_get_config) +
  922. Char(isc_info_svc_get_env) +
  923. Char(isc_info_svc_get_env_lock) +
  924. Char(isc_info_svc_get_env_msg) +
  925. Char(isc_info_svc_user_dbpath);
  926. InternalServiceQuery;
  927. RunLen := 0;
  928. While (not (Integer(OutputBuffer[RunLen]) = isc_info_end)) do
  929. begin
  930. case Integer(OutputBuffer[RunLen]) of
  931. isc_info_svc_get_config:
  932. begin
  933. FConfigParams.ConfigFileData.ConfigFileKey := nil;
  934. FConfigParams.ConfigFileData.ConfigFileValue := nil;
  935. Inc (RunLen);
  936. while (not (Integer(OutputBuffer[RunLen]) = isc_info_flag_end)) do
  937. ParseConfigFileData (RunLen);
  938. if (Integer(OutputBuffer[RunLen]) = isc_info_flag_end) then
  939. Inc (RunLen);
  940. end;
  941. isc_info_svc_get_env:
  942. begin
  943. Inc (RunLen);
  944. FConfigParams.BaseLocation := ParseString(RunLen);
  945. end;
  946. isc_info_svc_get_env_lock:
  947. begin
  948. Inc (RunLen);
  949. FConfigParams.LockFileLocation := ParseString(RunLen);
  950. end;
  951. isc_info_svc_get_env_msg:
  952. begin
  953. Inc (RunLen);
  954. FConfigParams.MessageFileLocation := ParseString(RunLen);
  955. end;
  956. isc_info_svc_user_dbpath:
  957. begin
  958. Inc (RunLen);
  959. FConfigParams.SecurityDatabaseLocation := ParseString(RunLen);
  960. end;
  961. else
  962. IBError(ibxeOutputParsingError, [nil]);
  963. end;
  964. end;
  965. end;
  966. procedure TIBServerProperties.FetchDatabaseInfo;
  967. var
  968. i, RunLen: Integer;
  969. begin
  970. ServiceQueryParams := Char(isc_info_svc_svr_db_info);
  971. InternalServiceQuery;
  972. if (OutputBuffer[0] <> Char(isc_info_svc_svr_db_info)) then
  973. IBError(ibxeOutputParsingError, [nil]);
  974. RunLen := 1;
  975. if (OutputBuffer[RunLen] <> Char(isc_spb_num_att)) then
  976. IBError(ibxeOutputParsingError, [nil]);
  977. Inc(RunLen);
  978. FDatabaseInfo.NoOfAttachments := ParseInteger(RunLen);
  979. if (OutputBuffer[RunLen] <> Char(isc_spb_num_db)) then
  980. IBError(ibxeOutputParsingError, [nil]);
  981. Inc(RunLen);
  982. FDatabaseInfo.NoOfDatabases := ParseInteger(RunLen);
  983. FDatabaseInfo.DbName := nil;
  984. SetLength(FDatabaseInfo.DbName, FDatabaseInfo.NoOfDatabases);
  985. i := 0;
  986. while (OutputBuffer[RunLen] <> Char(isc_info_flag_end)) do
  987. begin
  988. if (OutputBuffer[RunLen] <> Char(SPBConstantValues[isc_spb_dbname])) then
  989. IBError(ibxeOutputParsingError, [nil]);
  990. Inc(RunLen);
  991. FDatabaseInfo.DbName[i] := ParseString(RunLen);
  992. Inc (i);
  993. end;
  994. end;
  995. procedure TIBServerProperties.FetchLicenseInfo;
  996. var
  997. i, RunLen: Integer;
  998. done: Integer;
  999. begin
  1000. ServiceQueryParams := Char(isc_info_svc_get_license) +
  1001. Char(isc_info_svc_get_licensed_users);
  1002. InternalServiceQuery;
  1003. RunLen := 0;
  1004. done := 0;
  1005. i := 0;
  1006. FLicenseInfo.key := nil;
  1007. FLicenseInfo.id := nil;
  1008. FLicenseInfo.desc := nil;
  1009. While done < 2 do begin
  1010. Inc(Done);
  1011. Inc(RunLen);
  1012. case Integer(OutputBuffer[RunLen-1]) of
  1013. isc_info_svc_get_license:
  1014. begin
  1015. while (OutputBuffer[RunLen] <> Char(isc_info_flag_end)) do
  1016. begin
  1017. if (i >= Length(FLicenseInfo.key)) then
  1018. begin
  1019. SetLength(FLicenseInfo.key, i + 10);
  1020. SetLength(FLicenseInfo.id, i + 10);
  1021. SetLength(FLicenseInfo.desc, i + 10);
  1022. end;
  1023. if (OutputBuffer[RunLen] <> Char(isc_spb_lic_id)) then
  1024. IBError(ibxeOutputParsingError, [nil]);
  1025. Inc(RunLen);
  1026. FLicenseInfo.id[i] := ParseString(RunLen);
  1027. if (OutputBuffer[RunLen] <> Char(isc_spb_lic_key)) then
  1028. IBError(ibxeOutputParsingError, [nil]);
  1029. Inc(RunLen);
  1030. FLicenseInfo.key[i] := ParseString(RunLen);
  1031. if (OutputBuffer[RunLen] <> Char(7)) then
  1032. IBError(ibxeOutputParsingError, [nil]);
  1033. Inc(RunLen);
  1034. FLicenseInfo.desc[i] := ParseString(RunLen);
  1035. Inc(i);
  1036. end;
  1037. Inc(RunLen);
  1038. if (Length(FLicenseInfo.key) > i) then
  1039. begin
  1040. SetLength(FLicenseInfo.key, i);
  1041. SetLength(FLicenseInfo.id, i);
  1042. SetLength(FLicenseInfo.desc, i);
  1043. end;
  1044. end;
  1045. isc_info_svc_get_licensed_users:
  1046. FLicenseInfo.LicensedUsers := ParseInteger(RunLen);
  1047. else
  1048. IBError(ibxeOutputParsingError, [nil]);
  1049. end;
  1050. end;
  1051. end;
  1052. procedure TIBServerProperties.FetchLicenseMaskInfo();
  1053. var
  1054. done,RunLen:integer;
  1055. begin
  1056. ServiceQueryParams := Char(isc_info_svc_get_license_mask) +
  1057. Char(isc_info_svc_capabilities);
  1058. InternalServiceQuery;
  1059. RunLen := 0;
  1060. done := 0;
  1061. While done <= 1 do
  1062. begin
  1063. Inc(done);
  1064. Inc(RunLen);
  1065. case Integer(OutputBuffer[RunLen-1]) of
  1066. isc_info_svc_get_license_mask:
  1067. FLicenseMaskInfo.LicenseMask := ParseInteger(RunLen);
  1068. isc_info_svc_capabilities:
  1069. FLicenseMaskInfo.CapabilityMask := ParseInteger(RunLen);
  1070. else
  1071. IBError(ibxeOutputParsingError, [nil]);
  1072. end;
  1073. end;
  1074. end;
  1075. procedure TIBServerProperties.FetchVersionInfo;
  1076. var
  1077. RunLen: Integer;
  1078. done: Integer;
  1079. begin
  1080. ServiceQueryParams := Char(isc_info_svc_version) +
  1081. Char(isc_info_svc_server_version) +
  1082. Char(isc_info_svc_implementation);
  1083. InternalServiceQuery;
  1084. RunLen := 0;
  1085. done := 0;
  1086. While done <= 2 do
  1087. begin
  1088. Inc(done);
  1089. Inc(RunLen);
  1090. case Integer(OutputBuffer[RunLen-1]) of
  1091. isc_info_svc_version:
  1092. FVersionInfo.ServiceVersion := ParseInteger(RunLen);
  1093. isc_info_svc_server_version:
  1094. FVersionInfo.ServerVersion := ParseString(RunLen);
  1095. isc_info_svc_implementation:
  1096. FVersionInfo.ServerImplementation := ParseString(RunLen);
  1097. else
  1098. IBError(ibxeOutputParsingError, [nil]);
  1099. end;
  1100. end;
  1101. end;
  1102. { TIBControlService }
  1103. procedure TIBControlService.SetServiceStartOptions;
  1104. begin
  1105. end;
  1106. function TIBControlService.GetIsServiceRunning: Boolean;
  1107. var
  1108. RunLen: Integer;
  1109. begin
  1110. ServiceQueryParams := Char(isc_info_svc_running);
  1111. InternalServiceQuery;
  1112. if (OutputBuffer[0] <> Char(isc_info_svc_running)) then
  1113. IBError(ibxeOutputParsingError, [nil]);
  1114. RunLen := 1;
  1115. if (ParseInteger(RunLen) = 1) then
  1116. result := True
  1117. else
  1118. result := False;
  1119. end;
  1120. procedure TIBControlService.ServiceStartAddParam (Value: string; param: Integer);
  1121. var
  1122. Len: UShort;
  1123. begin
  1124. Len := Length(Value);
  1125. if Len > 0 then
  1126. begin
  1127. FStartParams := FStartParams +
  1128. Char(Param) +
  1129. PChar(@Len)[0] +
  1130. PChar(@Len)[1] +
  1131. Value;
  1132. end;
  1133. end;
  1134. procedure TIBControlService.ServiceStartAddParam (Value: Integer; param: Integer);
  1135. begin
  1136. FStartParams := FStartParams +
  1137. Char(Param) +
  1138. PChar(@Value)[0] +
  1139. PChar(@Value)[1] +
  1140. PChar(@Value)[2] +
  1141. PChar(@Value)[3];
  1142. end;
  1143. procedure TIBControlService.ServiceStartAddByteParam (Value: Byte; param: Integer);
  1144. begin
  1145. FStartParams := FStartParams +
  1146. Char(Param) +
  1147. PChar(@Value)[0];
  1148. end;
  1149. constructor TIBControlService.Create(AOwner: TComponent);
  1150. begin
  1151. inherited create(AOwner);
  1152. FStartParams := '';
  1153. FStartSPB := nil;
  1154. FStartSPBLength := 0;
  1155. end;
  1156. procedure TIBControlService.InternalServiceStart;
  1157. begin
  1158. FStartSPBLength := Length(FStartParams);
  1159. if FStartSPBLength = 0 then
  1160. IBError(ibxeStartParamsError, [nil]);
  1161. IBAlloc(FStartSPB, 0, FStartSPBLength);
  1162. Move(FStartParams[1], FStartSPB[0], FstartSPBLength);
  1163. try
  1164. if call(isc_service_start(StatusVector, @FHandle, nil,
  1165. FStartSPBLength, FStartSPB), False) > 0 then
  1166. begin
  1167. FHandle := nil;
  1168. IBDataBaseError;
  1169. end;
  1170. finally
  1171. FreeMem(FStartSPB);
  1172. FStartSPB := nil;
  1173. FStartSPBLength := 0;
  1174. FStartParams := '';
  1175. end;
  1176. MonitorHook.ServiceStart(Self);
  1177. end;
  1178. procedure TIBControlService.ServiceStart;
  1179. begin
  1180. CheckActive;
  1181. SetServiceStartOptions;
  1182. InternalServiceStart;
  1183. end;
  1184. { TIBConfigService }
  1185. procedure TIBConfigService.ServiceStart;
  1186. begin
  1187. IBError(ibxeUseSpecificProcedures, [nil]);
  1188. end;
  1189. procedure TIBConfigService.ActivateShadow;
  1190. begin
  1191. ServiceStartParams := Char(isc_action_svc_properties);
  1192. ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  1193. ServiceStartAddParam (isc_spb_prp_activate, SPBConstantValues[isc_spb_options]);
  1194. InternalServiceStart;
  1195. end;
  1196. procedure TIBConfigService.BringDatabaseOnline;
  1197. begin
  1198. ServiceStartParams := Char(isc_action_svc_properties);
  1199. ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  1200. ServiceStartAddParam (isc_spb_prp_db_online, SPBConstantValues[isc_spb_options]);
  1201. InternalServiceStart;
  1202. end;
  1203. procedure TIBConfigService.SetAsyncMode(Value: Boolean);
  1204. begin
  1205. ServiceStartParams := Char(isc_action_svc_properties);
  1206. ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  1207. ServiceStartParams := ServiceStartParams +
  1208. Char(isc_spb_prp_write_mode);
  1209. if Value then
  1210. ServiceStartParams := ServiceStartParams +
  1211. Char(isc_spb_prp_wm_async)
  1212. else
  1213. ServiceStartParams := ServiceStartParams +
  1214. Char(isc_spb_prp_wm_sync);
  1215. InternalServiceStart;
  1216. end;
  1217. procedure TIBConfigService.SetDatabaseName(const Value: string);
  1218. begin
  1219. FDatabaseName := Value;
  1220. end;
  1221. procedure TIBConfigService.SetPageBuffers(Value: Integer);
  1222. begin
  1223. ServiceStartParams := Char(isc_action_svc_properties);
  1224. ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  1225. ServiceStartAddParam (Value, isc_spb_prp_page_buffers);
  1226. InternalServiceStart;
  1227. end;
  1228. procedure TIBConfigService.SetReadOnly(Value: Boolean);
  1229. begin
  1230. ServiceStartParams := Char(isc_action_svc_properties);
  1231. ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  1232. ServiceStartParams := ServiceStartParams +
  1233. Char(isc_spb_prp_access_mode);
  1234. if Value then
  1235. ServiceStartParams := ServiceStartParams +
  1236. Char(isc_spb_prp_am_readonly)
  1237. else
  1238. ServiceStartParams := ServiceStartParams +
  1239. Char(isc_spb_prp_am_readwrite);
  1240. InternalServiceStart;
  1241. end;
  1242. procedure TIBConfigService.SetReserveSpace(Value: Boolean);
  1243. begin
  1244. ServiceStartParams := Char(isc_action_svc_properties);
  1245. ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  1246. ServiceStartParams := ServiceStartParams +
  1247. Char(isc_spb_prp_reserve_space);
  1248. if Value then
  1249. ServiceStartParams := ServiceStartParams +
  1250. Char(isc_spb_prp_res)
  1251. else
  1252. ServiceStartParams := ServiceStartParams +
  1253. Char(isc_spb_prp_res_use_full);
  1254. InternalServiceStart;
  1255. end;
  1256. procedure TIBConfigService.SetSweepInterval(Value: Integer);
  1257. begin
  1258. ServiceStartParams := Char(isc_action_svc_properties);
  1259. ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  1260. ServiceStartAddParam (Value, isc_spb_prp_sweep_interval);
  1261. InternalServiceStart;
  1262. end;
  1263. procedure TIBConfigService.SetDBSqlDialect(Value: Integer);
  1264. begin
  1265. ServiceStartParams := Char(isc_action_svc_properties);
  1266. ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  1267. ServiceStartAddParam (Value, isc_spb_prp_set_sql_dialect);
  1268. InternalServiceStart;
  1269. end;
  1270. {
  1271. changes for 2.5 as discussed here:
  1272. http://firebird.1100200.n4.nabble.com/New-shutdown-online-mode-via-Delphi-unrecognized-service-parameter-block-td1126894.html
  1273. }
  1274. procedure TIBConfigService.ShutdownDatabase(Options: TShutdownModeEx;
  1275. Wait: Integer; OperationMode: TOperationMode);
  1276. begin
  1277. ServiceStartParams := AnsiChar(isc_action_svc_properties);
  1278. ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  1279. case OperationMode of
  1280. omNormal: ServiceStartAddByteParam(isc_spb_prp_sm_normal, isc_spb_prp_shutdown_mode);
  1281. omMulti: ServiceStartAddByteParam(isc_spb_prp_sm_multi, isc_spb_prp_shutdown_mode);
  1282. omSingle: ServiceStartAddByteParam(isc_spb_prp_sm_single, isc_spb_prp_shutdown_mode);
  1283. omFull: ServiceStartAddByteParam(isc_spb_prp_sm_full, isc_spb_prp_shutdown_mode);
  1284. end;
  1285. case Options of
  1286. smeForce: ServiceStartAddParam(Wait, isc_spb_prp_force_shutdown);
  1287. smeAttachment: ServiceStartAddParam(Wait, isc_spb_prp_attachments_shutdown);
  1288. smeTransaction: ServiceStartAddParam(Wait, isc_spb_prp_transactions_shutdown);
  1289. end;
  1290. {ServiceStartParams := Char(isc_action_svc_properties);
  1291. ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  1292. if (Options = Forced) then
  1293. ServiceStartAddParam (Wait, isc_spb_prp_shutdown_db)
  1294. else if (Options = DenyTransaction) then
  1295. ServiceStartAddParam (Wait, isc_spb_prp_deny_new_transactions)
  1296. else
  1297. ServiceStartAddParam (Wait, isc_spb_prp_deny_new_attachments);}
  1298. InternalServiceStart;
  1299. end;
  1300. { TIBLicensingService }
  1301. procedure TIBLicensingService.SetAction(Value: TLicensingAction);
  1302. begin
  1303. FAction := Value;
  1304. if (Value = LicenseRemove) then
  1305. FID := '';
  1306. end;
  1307. procedure TIBLicensingService.AddLicense;
  1308. begin
  1309. Action := LicenseAdd;
  1310. Servicestart;
  1311. end;
  1312. procedure TIBLicensingService.RemoveLicense;
  1313. begin
  1314. Action := LicenseRemove;
  1315. Servicestart;
  1316. end;
  1317. procedure TIBLicensingService.SetServiceStartOptions;
  1318. begin
  1319. if (FAction = LicenseAdd) then begin
  1320. ServiceStartParams := Char(isc_action_svc_add_license);
  1321. ServiceStartAddParam (FKey, isc_spb_lic_key);
  1322. ServiceStartAddParam (FID, isc_spb_lic_id);
  1323. end
  1324. else begin
  1325. ServiceStartParams := Char(isc_action_svc_remove_license);
  1326. ServiceStartAddParam (FKey, isc_spb_lic_key);
  1327. end;
  1328. end;
  1329. { TIBStatisticalService }
  1330. procedure TIBStatisticalService.SetDatabaseName(const Value: string);
  1331. begin
  1332. FDatabaseName := Value;
  1333. end;
  1334. procedure TIBStatisticalService.SetServiceStartOptions;
  1335. var
  1336. param: Integer;
  1337. begin
  1338. if FDatabaseName = '' then
  1339. IBError(ibxeStartParamsError, [nil]);
  1340. param := 0;
  1341. if (DataPages in Options) then
  1342. param := param or isc_spb_sts_data_pages;
  1343. if (DbLog in Options) then
  1344. param := param or isc_spb_sts_db_log;
  1345. if (HeaderPages in Options) then
  1346. param := param or isc_spb_sts_hdr_pages;
  1347. if (IndexPages in Options) then
  1348. param := param or isc_spb_sts_idx_pages;
  1349. if (SystemRelations in Options) then
  1350. param := param or isc_spb_sts_sys_relations;
  1351. Action := isc_action_svc_db_stats;
  1352. ServiceStartParams := Char(isc_action_svc_db_stats);
  1353. ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  1354. ServiceStartAddParam (param, SPBConstantValues[isc_spb_options]);
  1355. end;
  1356. { TIBBackupService }
  1357. procedure TIBBackupService.SetServiceStartOptions;
  1358. var
  1359. param, i: Integer;
  1360. value: String;
  1361. begin
  1362. if FDatabaseName = '' then
  1363. IBError(ibxeStartParamsError, [nil]);
  1364. param := 0;
  1365. if (IgnoreChecksums in Options) then
  1366. param := param or isc_spb_bkp_ignore_checksums;
  1367. if (IgnoreLimbo in Options) then
  1368. param := param or isc_spb_bkp_ignore_limbo;
  1369. if (MetadataOnly in Options) then
  1370. param := param or isc_spb_bkp_metadata_only;
  1371. if (NoGarbageCollection in Options) then
  1372. param := param or isc_spb_bkp_no_garbage_collect;
  1373. if (OldMetadataDesc in Options) then
  1374. param := param or isc_spb_bkp_old_descriptions;
  1375. if (NonTransportable in Options) then
  1376. param := param or isc_spb_bkp_non_transportable;
  1377. if (ConvertExtTables in Options) then
  1378. param := param or isc_spb_bkp_convert;
  1379. Action := isc_action_svc_backup;
  1380. ServiceStartParams := Char(isc_action_svc_backup);
  1381. ServiceStartAddParam(FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  1382. ServiceStartAddParam(param, SPBConstantValues[isc_spb_options]);
  1383. if Verbose then
  1384. ServiceStartParams := ServiceStartParams + Char(SPBConstantValues[isc_spb_verbose]);
  1385. if FBlockingFactor > 0 then
  1386. ServiceStartAddParam(FBlockingFactor, isc_spb_bkp_factor);
  1387. for i := 0 to FBackupFile.Count - 1 do
  1388. begin
  1389. if (Trim(FBackupFile[i]) = '') then
  1390. continue;
  1391. if (Pos('=', FBackupFile[i]) <> 0) then
  1392. begin {mbcs ok}
  1393. ServiceStartAddParam(FBackupFile.Names[i], isc_spb_bkp_file);
  1394. value := Copy(FBackupFile[i], Pos('=', FBackupFile[i]) + 1, Length(FBackupFile.Names[i])); {mbcs ok}
  1395. param := StrToInt(value);
  1396. ServiceStartAddParam(param, isc_spb_bkp_length);
  1397. end
  1398. else
  1399. ServiceStartAddParam(FBackupFile[i], isc_spb_bkp_file);
  1400. end;
  1401. end;
  1402. constructor TIBBackupService.Create(AOwner: TComponent);
  1403. begin
  1404. inherited Create(AOwner);
  1405. FBackupFile := TStringList.Create;
  1406. end;
  1407. destructor TIBBackupService.Destroy;
  1408. begin
  1409. FBackupFile.Free;
  1410. inherited Destroy;
  1411. end;
  1412. procedure TIBBackupService.SetBackupFile(const Value: TStrings);
  1413. begin
  1414. FBackupFile.Assign(Value);
  1415. end;
  1416. { TIBRestoreService }
  1417. procedure TIBRestoreService.SetServiceStartOptions;
  1418. var
  1419. param, i: Integer;
  1420. value: String;
  1421. begin
  1422. param := 0;
  1423. if (DeactivateIndexes in Options) then
  1424. param := param or isc_spb_res_deactivate_idx;
  1425. if (NoShadow in Options) then
  1426. param := param or isc_spb_res_no_shadow;
  1427. if (NoValidityCheck in Options) then
  1428. param := param or isc_spb_res_no_validity;
  1429. if (OneRelationAtATime in Options) then
  1430. param := param or isc_spb_res_one_at_a_time;
  1431. if (Replace in Options) then
  1432. param := param or isc_spb_res_replace;
  1433. if (CreateNewDB in Options) then
  1434. param := param or isc_spb_res_create;
  1435. if (UseAllSpace in Options) then
  1436. param := param or isc_spb_res_use_all_space;
  1437. Action := isc_action_svc_restore;
  1438. ServiceStartParams := Char(isc_action_svc_restore);
  1439. ServiceStartAddParam(param, SPBConstantValues[isc_spb_options]);
  1440. if Verbose then ServiceStartParams := ServiceStartParams + Char(SPBConstantValues[isc_spb_verbose]);
  1441. if FPageSize > 0 then
  1442. ServiceStartAddParam(FPageSize, isc_spb_res_page_size);
  1443. if FPageBuffers > 0 then
  1444. ServiceStartAddParam(FPageBuffers, isc_spb_res_buffers);
  1445. // ??????? ???????? ??? ??????????? ?? ? ODS 11.1 +
  1446. if FFixFssCharacterSet <> '' then
  1447. begin
  1448. ServiceStartAddParam(FixFssCharacterSet, isc_spb_res_fix_fss_data);
  1449. ServiceStartAddParam(FixFssCharacterSet, isc_spb_res_fix_fss_metadata);
  1450. end;
  1451. for i := 0 to FBackupFile.Count - 1 do
  1452. begin
  1453. if (Trim(FBackupFile[i]) = '') then continue;
  1454. if (Pos('=', FBackupFile[i]) <> 0) then {mbcs ok}
  1455. begin
  1456. ServiceStartAddParam(FBackupFile.Names[i], isc_spb_bkp_file);
  1457. value := Copy(FBackupFile[i], Pos('=', FBackupFile[i]) + 1, Length(FBackupFile.Names[i])); {mbcs ok}
  1458. param := StrToInt(value);
  1459. ServiceStartAddParam(param, isc_spb_bkp_length);
  1460. end
  1461. else
  1462. ServiceStartAddParam(FBackupFile[i], isc_spb_bkp_file);
  1463. end;
  1464. for i := 0 to FDatabaseName.Count - 1 do
  1465. begin
  1466. if (Trim(FDatabaseName[i]) = '') then continue;
  1467. if (Pos('=', FDatabaseName[i]) <> 0) then {mbcs ok}
  1468. begin
  1469. ServiceStartAddParam(FDatabaseName.Names[i], SPBConstantValues[isc_spb_dbname]);
  1470. value := Copy(FDatabaseName[i], Pos('=', FDatabaseName[i]) + 1, Length(FDatabaseName[i])); {mbcs ok}
  1471. param := StrToInt(value);
  1472. ServiceStartAddParam(param, isc_spb_res_length);
  1473. end
  1474. else
  1475. ServiceStartAddParam(FDatabaseName[i], SPBConstantValues[isc_spb_dbname]);
  1476. end;
  1477. end;
  1478. constructor TIBRestoreService.Create(AOwner: TComponent);
  1479. begin
  1480. inherited Create(AOwner);
  1481. FDatabaseName := TStringList.Create;
  1482. FBackupFile := TStringList.Create;
  1483. Include (FOptions, CreateNewDB);
  1484. FPageSize := 4096;
  1485. FixFssCharacterSet := '';
  1486. end;
  1487. destructor TIBRestoreService.Destroy;
  1488. begin
  1489. FDatabaseName.Free;
  1490. FBackupFile.Free;
  1491. inherited Destroy;
  1492. end;
  1493. procedure TIBRestoreService.SetBackupFile(const Value: TStrings);
  1494. begin
  1495. FBackupFile.Assign(Value);
  1496. end;
  1497. procedure TIBRestoreService.SetDatabaseName(const Value: TStrings);
  1498. begin
  1499. FDatabaseName.Assign(Value);
  1500. end;
  1501. { TIBValidationService }
  1502. constructor TIBValidationService.Create(AOwner: TComponent);
  1503. begin
  1504. inherited Create(AOwner);
  1505. end;
  1506. destructor TIBValidationService.Destroy;
  1507. var
  1508. i : Integer;
  1509. begin
  1510. for i := 0 to High(FLimboTransactionInfo) do
  1511. FLimboTransactionInfo[i].Free;
  1512. FLimboTransactionInfo := nil;
  1513. inherited Destroy;
  1514. end;
  1515. procedure TIBValidationService.FetchLimboTransactionInfo;
  1516. var
  1517. i, RunLen: Integer;
  1518. Value: Char;
  1519. begin
  1520. ServiceQueryParams := Char(isc_info_svc_limbo_trans);
  1521. InternalServiceQuery;
  1522. RunLen := 0;
  1523. if (OutputBuffer[RunLen] <> Char(isc_info_svc_limbo_trans)) then
  1524. IBError(ibxeOutputParsingError, [nil]);
  1525. Inc(RunLen, 3);
  1526. for i := 0 to High(FLimboTransactionInfo) do
  1527. FLimboTransactionInfo[i].Free;
  1528. FLimboTransactionInfo := nil;
  1529. i := 0;
  1530. while (OutputBuffer[RunLen] <> Char(isc_info_end)) do
  1531. begin
  1532. if (i >= Length(FLimboTransactionInfo)) then
  1533. SetLength(FLimboTransactionInfo, i + 10);
  1534. if FLimboTransactionInfo[i] = nil then
  1535. FLimboTransactionInfo[i] := TLimboTransactionInfo.Create;
  1536. with FLimboTransactionInfo[i] do
  1537. begin
  1538. if (OutputBuffer[RunLen] = Char(isc_spb_single_tra_id)) then
  1539. begin
  1540. Inc(RunLen);
  1541. MultiDatabase := False;
  1542. ID := ParseInteger(RunLen);
  1543. end
  1544. else
  1545. begin
  1546. Inc(RunLen);
  1547. MultiDatabase := True;
  1548. ID := ParseInteger(RunLen);
  1549. HostSite := ParseString(RunLen);
  1550. if (OutputBuffer[RunLen] <> Char(isc_spb_tra_state)) then
  1551. IBError(ibxeOutputParsingError, [nil]);
  1552. Inc(RunLen);
  1553. Value := OutputBuffer[RunLen];
  1554. Inc(RunLen);
  1555. if (Value = Char(isc_spb_tra_state_limbo)) then
  1556. State := LimboState
  1557. else
  1558. if (Value = Char(isc_spb_tra_state_commit)) then
  1559. State := CommitState
  1560. else
  1561. if (Value = Char(isc_spb_tra_state_rollback)) then
  1562. State := RollbackState
  1563. else
  1564. State := UnknownState;
  1565. RemoteSite := ParseString(RunLen);
  1566. RemoteDatabasePath := ParseString(RunLen);
  1567. Value := OutputBuffer[RunLen];
  1568. Inc(RunLen);
  1569. if (Value = Char(isc_spb_tra_advise_commit)) then
  1570. begin
  1571. Advise := CommitAdvise;
  1572. Action:= CommitAction;
  1573. end
  1574. else
  1575. if (Value = Char(isc_spb_tra_advise_rollback)) then
  1576. begin
  1577. Advise := RollbackAdvise;
  1578. Action := RollbackAction;
  1579. end
  1580. else
  1581. begin
  1582. { if no advice commit as default }
  1583. Advise := UnknownAdvise;
  1584. Action:= CommitAction;
  1585. end;
  1586. end;
  1587. Inc (i);
  1588. end;
  1589. end;
  1590. if (i > 0) then
  1591. SetLength(FLimboTransactionInfo, i+1);
  1592. end;
  1593. procedure TIBValidationService.FixLimboTransactionErrors;
  1594. var
  1595. i: Integer;
  1596. begin
  1597. ServiceStartParams := Char(isc_action_svc_repair);
  1598. ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  1599. if (FGlobalAction = NoGlobalAction) then
  1600. begin
  1601. i := 0;
  1602. while (FLimboTransactionInfo[i].ID <> 0) do
  1603. begin
  1604. if (FLimboTransactionInfo[i].Action = CommitAction) then
  1605. ServiceStartAddParam (FLimboTransactionInfo[i].ID, isc_spb_rpr_commit_trans)
  1606. else
  1607. ServiceStartAddParam (FLimboTransactionInfo[i].ID, isc_spb_rpr_rollback_trans);
  1608. Inc(i);
  1609. end;
  1610. end
  1611. else
  1612. begin
  1613. i := 0;
  1614. if (FGlobalAction = CommitGlobal) then
  1615. while (FLimboTransactionInfo[i].ID <> 0) do
  1616. begin
  1617. ServiceStartAddParam (FLimboTransactionInfo[i].ID, isc_spb_rpr_commit_trans);
  1618. Inc(i);
  1619. end
  1620. else
  1621. while (FLimboTransactionInfo[i].ID <> 0) do
  1622. begin
  1623. ServiceStartAddParam (FLimboTransactionInfo[i].ID, isc_spb_rpr_rollback_trans);
  1624. Inc(i);
  1625. end;
  1626. end;
  1627. InternalServiceStart;
  1628. end;
  1629. function TIBValidationService.GetLimboTransactionInfo(index: integer): TLimboTransactionInfo;
  1630. begin
  1631. if index <= High(FLimboTransactionInfo) then
  1632. result := FLimboTransactionInfo[index]
  1633. else
  1634. result := nil;
  1635. end;
  1636. function TIBValidationService.GetLimboTransactionInfoCount: integer;
  1637. begin
  1638. Result := High(FLimboTransactionInfo);
  1639. end;
  1640. procedure TIBValidationService.SetDatabaseName(const Value: string);
  1641. begin
  1642. FDatabaseName := Value;
  1643. end;
  1644. procedure TIBValidationService.SetServiceStartOptions;
  1645. var
  1646. param: Integer;
  1647. begin
  1648. Action := isc_action_svc_repair;
  1649. if FDatabaseName = '' then
  1650. IBError(ibxeStartParamsError, [nil]);
  1651. param := 0;
  1652. if (SweepDB in Options) then
  1653. param := param or isc_spb_rpr_sweep_db;
  1654. if (ValidateDB in Options) then
  1655. param := param or isc_spb_rpr_validate_db;
  1656. ServiceStartParams := Char(isc_action_svc_repair);
  1657. ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  1658. if param > 0 then
  1659. ServiceStartAddParam (param, SPBConstantValues[isc_spb_options]);
  1660. param := 0;
  1661. if (LimboTransactions in Options) then
  1662. param := param or isc_spb_rpr_list_limbo_trans;
  1663. if (CheckDB in Options) then
  1664. param := param or isc_spb_rpr_check_db;
  1665. if (IgnoreChecksum in Options) then
  1666. param := param or isc_spb_rpr_ignore_checksum;
  1667. if (KillShadows in Options) then
  1668. param := param or isc_spb_rpr_kill_shadows;
  1669. if (MendDB in Options) then
  1670. param := param or isc_spb_rpr_mend_db;
  1671. if (ValidateFull in Options) then
  1672. begin
  1673. param := param or isc_spb_rpr_full;
  1674. if not (MendDB in Options) then
  1675. param := param or isc_spb_rpr_validate_db;
  1676. end;
  1677. if param > 0 then
  1678. ServiceStartAddParam (param, SPBConstantValues[isc_spb_options]);
  1679. end;
  1680. { TIBSecurityService }
  1681. constructor TIBSecurityService.Create(AOwner: TComponent);
  1682. begin
  1683. inherited Create(AOwner);
  1684. FModifyParams := [];
  1685. end;
  1686. destructor TIBSecurityService.Destroy;
  1687. var
  1688. i : Integer;
  1689. begin
  1690. for i := 0 to High(FUserInfo) do
  1691. FUserInfo[i].Free;
  1692. FUserInfo := nil;
  1693. inherited Destroy;
  1694. end;
  1695. procedure TIBSecurityService.FetchUserInfo;
  1696. var
  1697. i, RunLen: Integer;
  1698. begin
  1699. ServiceQueryParams := Char(isc_info_svc_get_users);
  1700. InternalServiceQuery;
  1701. RunLen := 0;
  1702. if (OutputBuffer[RunLen] <> Char(isc_info_svc_get_users)) then
  1703. IBError(ibxeOutputParsingError, [nil]);
  1704. Inc(RunLen);
  1705. for i := 0 to High(FUserInfo) do
  1706. FUserInfo[i].Free;
  1707. FUserInfo := nil;
  1708. i := 0;
  1709. { Don't have any use for the combined length
  1710. so increment past by 2 }
  1711. Inc(RunLen, 2);
  1712. while (OutputBuffer[RunLen] <> Char(isc_info_end)) do
  1713. begin
  1714. if (i >= Length(FUSerInfo)) then
  1715. SetLength(FUserInfo, i + 10);
  1716. if (OutputBuffer[RunLen] <> Char(isc_spb_sec_username)) then
  1717. IBError(ibxeOutputParsingError, [nil]);
  1718. Inc(RunLen);
  1719. if FUserInfo[i] = nil then
  1720. FUserInfo[i] := TUserInfo.Create;
  1721. FUserInfo[i].UserName := ParseString(RunLen);
  1722. if (OutputBuffer[RunLen] <> Char(isc_spb_sec_firstname)) then
  1723. IBError(ibxeOutputParsingError, [nil]);
  1724. Inc(RunLen);
  1725. FUserInfo[i].FirstName := ParseString(RunLen);
  1726. if (OutputBuffer[RunLen] <> Char(isc_spb_sec_middlename)) then
  1727. IBError(ibxeOutputParsingError, [nil]);
  1728. Inc(RunLen);
  1729. FUserInfo[i].MiddleName := ParseString(RunLen);
  1730. if (OutputBuffer[RunLen] <> Char(isc_spb_sec_lastname)) then
  1731. IBError(ibxeOutputParsingError, [nil]);
  1732. Inc(RunLen);
  1733. FUserInfo[i].LastName := ParseString(RunLen);
  1734. if (OutputBuffer[RunLen] <> Char(isc_spb_sec_userId)) then
  1735. IBError(ibxeOutputParsingError, [nil]);
  1736. Inc(RunLen);
  1737. FUserInfo[i].UserId := ParseInteger(RunLen);
  1738. if (OutputBuffer[RunLen] <> Char(isc_spb_sec_groupid)) then
  1739. IBError(ibxeOutputParsingError, [nil]);
  1740. Inc(RunLen);
  1741. FUserInfo[i].GroupID := ParseInteger(RunLen);
  1742. Inc (i);
  1743. end;
  1744. if (i > 0) then
  1745. SetLength(FUserInfo, i+1);
  1746. end;
  1747. function TIBSecurityService.GetUserInfo(Index: Integer): TUserInfo;
  1748. begin
  1749. if Index <= High(FUSerInfo) then
  1750. result := FUserInfo[Index]
  1751. else
  1752. result := nil;
  1753. end;
  1754. function TIBSecurityService.GetUserInfoCount: Integer;
  1755. begin
  1756. Result := High(FUSerInfo);
  1757. end;
  1758. procedure TIBSecurityService.AddUser;
  1759. begin
  1760. SecurityAction := ActionAddUser;
  1761. ServiceStart;
  1762. end;
  1763. procedure TIBSecurityService.DeleteUser;
  1764. begin
  1765. SecurityAction := ActionDeleteUser;
  1766. ServiceStart;
  1767. end;
  1768. procedure TIBSecurityService.DisplayUsers;
  1769. begin
  1770. SecurityAction := ActionDisplayUser;
  1771. ServiceStartParams := Char(isc_action_svc_display_user);
  1772. InternalServiceStart;
  1773. FetchUserInfo;
  1774. end;
  1775. procedure TIBSecurityService.DisplayUser(UserName: String);
  1776. begin
  1777. SecurityAction := ActionDisplayUser;
  1778. ServiceStartParams := Char(isc_action_svc_display_user);
  1779. ServiceStartAddParam (UserName, isc_spb_sec_username);
  1780. InternalServiceStart;
  1781. FetchUserInfo;
  1782. end;
  1783. procedure TIBSecurityService.ModifyUser;
  1784. begin
  1785. SecurityAction := ActionModifyUser;
  1786. ServiceStart;
  1787. end;
  1788. procedure TIBSecurityService.SetSecurityAction (Value: TSecurityAction);
  1789. begin
  1790. FSecurityAction := Value;
  1791. if Value = ActionDeleteUser then
  1792. ClearParams;
  1793. end;
  1794. procedure TIBSecurityService.ClearParams;
  1795. begin
  1796. FModifyParams := [];
  1797. FFirstName := '';
  1798. FMiddleName := '';
  1799. FLastName := '';
  1800. FGroupID := 0;
  1801. FUserID := 0;
  1802. FPassword := '';
  1803. end;
  1804. procedure TIBSecurityService.SetFirstName (Value: String);
  1805. begin
  1806. FFirstName := Value;
  1807. Include (FModifyParams, ModifyFirstName);
  1808. end;
  1809. procedure TIBSecurityService.SetMiddleName (Value: String);
  1810. begin
  1811. FMiddleName := Value;
  1812. Include (FModifyParams, ModifyMiddleName);
  1813. end;
  1814. procedure TIBSecurityService.SetLastName (Value: String);
  1815. begin
  1816. FLastName := Value;
  1817. Include (FModifyParams, ModifyLastName);
  1818. end;
  1819. procedure TIBSecurityService.SetPassword (Value: String);
  1820. begin
  1821. FPassword := Value;
  1822. Include (FModifyParams, ModifyPassword);
  1823. end;
  1824. procedure TIBSecurityService.SetUserId (Value: Integer);
  1825. begin
  1826. FUserId := Value;
  1827. Include (FModifyParams, ModifyUserId);
  1828. end;
  1829. procedure TIBSecurityService.SetGroupId (Value: Integer);
  1830. begin
  1831. FGroupId := Value;
  1832. Include (FModifyParams, ModifyGroupId);
  1833. end;
  1834. procedure TIBSecurityService.Loaded;
  1835. begin
  1836. inherited Loaded;
  1837. ClearParams;
  1838. end;
  1839. procedure TIBSecurityService.SetServiceStartOptions;
  1840. var
  1841. Len: UShort;
  1842. begin
  1843. case FSecurityAction of
  1844. ActionAddUser:
  1845. begin
  1846. Action := isc_action_svc_add_user;
  1847. if ( Pos(' ', FUserName) > 0 ) then
  1848. IBError(ibxeStartParamsError, [nil]);
  1849. Len := Length(FUserName);
  1850. if (Len = 0) then
  1851. IBError(ibxeStartParamsError, [nil]);
  1852. ServiceStartParams := Char(isc_action_svc_add_user);
  1853. ServiceStartAddParam (FUserName, isc_spb_sec_username);
  1854. ServiceStartAddParam (FUserID, isc_spb_sec_userid);
  1855. ServiceStartAddParam (FGroupID, isc_spb_sec_groupid);
  1856. ServiceStartAddParam (FPassword, isc_spb_sec_password);
  1857. ServiceStartAddParam (FFirstName, isc_spb_sec_firstname);
  1858. ServiceStartAddParam (FMiddleName, isc_spb_sec_middlename);
  1859. ServiceStartAddParam (FLastName, isc_spb_sec_lastname);
  1860. ServiceStartAddParam (FSQLRole, SPBConstantValues[isc_spb_sql_role_name]);
  1861. end;
  1862. ActionDeleteUser:
  1863. begin
  1864. Action := isc_action_svc_delete_user;
  1865. Len := Length(FUserName);
  1866. if (Len = 0) then
  1867. IBError(ibxeStartParamsError, [nil]);
  1868. ServiceStartParams := Char(isc_action_svc_delete_user);
  1869. ServiceStartAddParam (FUserName, isc_spb_sec_username);
  1870. end;
  1871. ActionModifyUser:
  1872. begin
  1873. Action := isc_action_svc_modify_user;
  1874. Len := Length(FUserName);
  1875. if (Len = 0) then
  1876. IBError(ibxeStartParamsError, [nil]);
  1877. ServiceStartParams := Char(isc_action_svc_modify_user);
  1878. ServiceStartAddParam (FUserName, isc_spb_sec_username);
  1879. if (ModifyUserId in FModifyParams) then
  1880. ServiceStartAddParam (FUserID, isc_spb_sec_userid);
  1881. if (ModifyGroupId in FModifyParams) then
  1882. ServiceStartAddParam (FGroupID, isc_spb_sec_groupid);
  1883. if (ModifyPassword in FModifyParams) then
  1884. ServiceStartAddParam (FPassword, isc_spb_sec_password);
  1885. if (ModifyFirstName in FModifyParams) then
  1886. ServiceStartAddParam (FFirstName, isc_spb_sec_firstname);
  1887. if (ModifyMiddleName in FModifyParams) then
  1888. ServiceStartAddParam (FMiddleName, isc_spb_sec_middlename);
  1889. if (ModifyLastName in FModifyParams) then
  1890. ServiceStartAddParam (FLastName, isc_spb_sec_lastname);
  1891. ServiceStartAddParam (FSQLRole, SPBConstantValues[isc_spb_sql_role_name]);
  1892. end;
  1893. end;
  1894. ClearParams;
  1895. end;
  1896. { TIBUnStructuredService }
  1897. constructor TIBControl