runtime/nongui/IBJournal.pas

unit IBJournal;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, IB, IBDatabase, IBUtils, IBInternals;

{ Database Journalling.

  This component is intended to support a client side journal of all database
  updates, inserts and deletes made by the client during a session. Support for
  creating the Journal is provided by the fbintf package. This component is an
  IBX front end.
}

type
  { TIBJournal }

  TIBJournal = class(TComponent)
  private
    const DefaultVendor          = 'Snake Oil (Sales) Ltd';
    const DefaultJournalTemplate = 'Journal.%d.log';
  private
    FApplicationName: string;
    FBase: TIBBase;
    FEnabled: boolean;
    FJournalFileTemplate: string;
    FJournalFilePath: string;
    FOptions: TJournalOptions;
    FRetainJournal: boolean;
    FVendorName: string;
    FSessionId: integer;
    procedure EnsurePathExists(FileName: string);
    function GetDatabase: TIBDatabase;
    function GetJournalFilePath: string;
    procedure SetDatabase(AValue: TIBDatabase);
    procedure SetEnabled(AValue: boolean);
    procedure HandleBeforeDatabaseDisconnect(Sender: TObject);
    procedure HandleDatabaseConnect(Sender: TObject);
    procedure HandleDatabaseDisconnect(Sender: TObject);
    procedure StartSession;
    procedure EndSession;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property JournalFilePath: string read FJournalFilePath;
    property SessionID: integer read FSessionID;
  published
    property Database: TIBDatabase read GetDatabase write SetDatabase;
      {When enabled is true, journaling is performed. Enabled may be set before
       a database is opened, in which case, journaling starts as soon as
       }
    property Enabled: boolean read FEnabled write SetEnabled;
     {JournalFileTemplate determines the name of the journal file and should
      include a %d where %d is replaced with the session no at run time.}
    property JournalFileTemplate: string read FJournalFileTemplate write FJournalFileTemplate;
     {Journaling options - see fbintf/doc/README.ClientSideJournaling.pdf }
    property Options: TJournalOptions read FOptions write FOptions;
     {Vendor Name and ApplicationName determine the location of the Journal file.
      The Journal file is saved in:

      Unix:
      $HOME/.<vendor name>/<application name>/

      Windows:
      <User Application Data Dir>\<vendor name>\<application name>\
     }
    property VendorName: string read FVendorName write FVendorName;
    property ApplicationName: string read FApplicationName write FApplicationName;
     {If RetainJournal is true then when journaling terminats Enabled := false,
      or a normal database close, the journal file and journal table (IBX$JOURNALS)
      entries are retained. Otherwise, they are discarded. Note: always retained
      on a Force Disconnect or a lost connection}
    property RetainJournal: boolean read FRetainJournal write FRetainJournal;
  end;


implementation

uses IBMessages {$IFDEF WINDOWS}, Windows ,Windirs {$ENDIF};

{ TIBJournal }

procedure TIBJournal.EnsurePathExists(FileName: string);
var Path: string;
begin
  Path := ExtractFileDir(FileName);
  if (Path <> '') and not DirectoryExists(Path) then
    EnsurePathExists(Path);
  CreateDir(Path);
end;

function TIBJournal.GetDatabase: TIBDatabase;
begin
  Result := FBase.Database;
end;

function TIBJournal.GetJournalFilePath: string;
begin
  Result := Format(FJournalFileTemplate,[Database.Attachment.GetAttachmentID]);
  if FApplicationName <> '' then
    Result := ApplicationName +  DirectorySeparator + Result
  else
  if Sysutils.ApplicationName <> '' then
    Result := Sysutils.ApplicationName +  DirectorySeparator + Result
  else
    Result := ExtractFileName(ParamStr(0));
  if VendorName <> '' then
    Result := VendorName + DirectorySeparator + Result
  else
  if Sysutils.VendorName <> '' then
    Result := SysUtils.VendorName + DirectorySeparator + Result;
  {$IFDEF UNIX}
  Result := GetUserDir + '.' + Result;
  {$ENDIF}
  {$IFDEF WINDOWS}
  Result := GetWindowsSpecialDir(CSIDL_LOCAL_APPDATA) + Result;
  {$ENDIF}
end;

procedure TIBJournal.SetDatabase(AValue: TIBDatabase);
begin
  if AValue = FBase.Database then Exit;
  FBase.Database := AValue;
end;

procedure TIBJournal.SetEnabled(AValue: boolean);
begin
  if FEnabled = AValue then Exit;
  FEnabled := AValue;
  if not (csDesigning in ComponentState) and Database.Connected then
  begin
    if FEnabled then
      StartSession
    else
      EndSession;
  end;
end;

procedure TIBJournal.HandleBeforeDatabaseDisconnect(Sender: TObject);
begin
  if not (csDesigning in ComponentState) and Enabled then
    EndSession;
end;

procedure TIBJournal.HandleDatabaseConnect(Sender: TObject);
begin
  if not (csDesigning in ComponentState) and Enabled then
    StartSession;
end;

procedure TIBJournal.HandleDatabaseDisconnect(Sender: TObject);
begin
  EndSession;
end;

procedure TIBJournal.StartSession;
begin
  FJournalFilePath := GetJournalFilePath;
  EnsurePathExists(FJournalFilePath);
  FSessionID := Database.Attachment.StartJournaling(JournalFilePath,Options);
end;

procedure TIBJournal.EndSession;
begin
  FSessionID := -1;
  Database.Attachment.StopJournaling(RetainJournal);
end;

constructor TIBJournal.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBase := TIBBase.Create(Self);
  FBase.BeforeDatabaseDisconnect := @HandleBeforeDatabaseDisconnect;
  FBase.AfterDatabaseConnect := @HandleDatabaseConnect;
  FBase.BeforeDatabaseDisconnect := @HandleDatabaseDisconnect;
  FVendorName := DefaultVendor;
  FJournalFileTemplate := DefaultJournalTemplate;
  FOptions := [joReadWriteTransactions,joModifyQueries];
end;

destructor TIBJournal.Destroy;
begin
  Enabled := false;
  FBase.Free;
  inherited Destroy;
end;

end.

Revision:	367
Committed:	Tue Dec 7 13:32:42 2021 UTC (2 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	5819 byte(s)
Log Message:	Added IBJournal.pas
#	Content
1	unit IBJournal;
2
3	{$mode objfpc}{$H+}
4
5	interface
6
7	uses
8	Classes, SysUtils, IB, IBDatabase, IBUtils, IBInternals;
9
10	{ Database Journalling.
11
12	This component is intended to support a client side journal of all database
13	updates, inserts and deletes made by the client during a session. Support for
14	creating the Journal is provided by the fbintf package. This component is an
15	IBX front end.
16	}
17
18	type
19	{ TIBJournal }
20
21	TIBJournal = class(TComponent)
22	private
23	const DefaultVendor = 'Snake Oil (Sales) Ltd';
24	const DefaultJournalTemplate = 'Journal.%d.log';
25	private
26	FApplicationName: string;
27	FBase: TIBBase;
28	FEnabled: boolean;
29	FJournalFileTemplate: string;
30	FJournalFilePath: string;
31	FOptions: TJournalOptions;
32	FRetainJournal: boolean;
33	FVendorName: string;
34	FSessionId: integer;
35	procedure EnsurePathExists(FileName: string);
36	function GetDatabase: TIBDatabase;
37	function GetJournalFilePath: string;
38	procedure SetDatabase(AValue: TIBDatabase);
39	procedure SetEnabled(AValue: boolean);
40	procedure HandleBeforeDatabaseDisconnect(Sender: TObject);
41	procedure HandleDatabaseConnect(Sender: TObject);
42	procedure HandleDatabaseDisconnect(Sender: TObject);
43	procedure StartSession;
44	procedure EndSession;
45	public
46	constructor Create(AOwner: TComponent); override;
47	destructor Destroy; override;
48	property JournalFilePath: string read FJournalFilePath;
49	property SessionID: integer read FSessionID;
50	published
51	property Database: TIBDatabase read GetDatabase write SetDatabase;
52	{When enabled is true, journaling is performed. Enabled may be set before
53	a database is opened, in which case, journaling starts as soon as
54	}
55	property Enabled: boolean read FEnabled write SetEnabled;
56	{JournalFileTemplate determines the name of the journal file and should
57	include a %d where %d is replaced with the session no at run time.}
58	property JournalFileTemplate: string read FJournalFileTemplate write FJournalFileTemplate;
59	{Journaling options - see fbintf/doc/README.ClientSideJournaling.pdf }
60	property Options: TJournalOptions read FOptions write FOptions;
61	{Vendor Name and ApplicationName determine the location of the Journal file.
62	The Journal file is saved in:
63
64	Unix:
65	$HOME/.<vendor name>/<application name>/
66
67	Windows:
68	<User Application Data Dir>\<vendor name>\<application name>\
69	}
70	property VendorName: string read FVendorName write FVendorName;
71	property ApplicationName: string read FApplicationName write FApplicationName;
72	{If RetainJournal is true then when journaling terminats Enabled := false,
73	or a normal database close, the journal file and journal table (IBX$JOURNALS)
74	entries are retained. Otherwise, they are discarded. Note: always retained
75	on a Force Disconnect or a lost connection}
76	property RetainJournal: boolean read FRetainJournal write FRetainJournal;
77	end;
78
79
80	implementation
81
82	uses IBMessages {$IFDEF WINDOWS}, Windows ,Windirs {$ENDIF};
83
84	{ TIBJournal }
85
86	procedure TIBJournal.EnsurePathExists(FileName: string);
87	var Path: string;
88	begin
89	Path := ExtractFileDir(FileName);
90	if (Path <> '') and not DirectoryExists(Path) then
91	EnsurePathExists(Path);
92	CreateDir(Path);
93	end;
94
95	function TIBJournal.GetDatabase: TIBDatabase;
96	begin
97	Result := FBase.Database;
98	end;
99
100	function TIBJournal.GetJournalFilePath: string;
101	begin
102	Result := Format(FJournalFileTemplate,[Database.Attachment.GetAttachmentID]);
103	if FApplicationName <> '' then
104	Result := ApplicationName + DirectorySeparator + Result
105	else
106	if Sysutils.ApplicationName <> '' then
107	Result := Sysutils.ApplicationName + DirectorySeparator + Result
108	else
109	Result := ExtractFileName(ParamStr(0));
110	if VendorName <> '' then
111	Result := VendorName + DirectorySeparator + Result
112	else
113	if Sysutils.VendorName <> '' then
114	Result := SysUtils.VendorName + DirectorySeparator + Result;
115	{$IFDEF UNIX}
116	Result := GetUserDir + '.' + Result;
117	{$ENDIF}
118	{$IFDEF WINDOWS}
119	Result := GetWindowsSpecialDir(CSIDL_LOCAL_APPDATA) + Result;
120	{$ENDIF}
121	end;
122
123	procedure TIBJournal.SetDatabase(AValue: TIBDatabase);
124	begin
125	if AValue = FBase.Database then Exit;
126	FBase.Database := AValue;
127	end;
128
129	procedure TIBJournal.SetEnabled(AValue: boolean);
130	begin
131	if FEnabled = AValue then Exit;
132	FEnabled := AValue;
133	if not (csDesigning in ComponentState) and Database.Connected then
134	begin
135	if FEnabled then
136	StartSession
137	else
138	EndSession;
139	end;
140	end;
141
142	procedure TIBJournal.HandleBeforeDatabaseDisconnect(Sender: TObject);
143	begin
144	if not (csDesigning in ComponentState) and Enabled then
145	EndSession;
146	end;
147
148	procedure TIBJournal.HandleDatabaseConnect(Sender: TObject);
149	begin
150	if not (csDesigning in ComponentState) and Enabled then
151	StartSession;
152	end;
153
154	procedure TIBJournal.HandleDatabaseDisconnect(Sender: TObject);
155	begin
156	EndSession;
157	end;
158
159	procedure TIBJournal.StartSession;
160	begin
161	FJournalFilePath := GetJournalFilePath;
162	EnsurePathExists(FJournalFilePath);
163	FSessionID := Database.Attachment.StartJournaling(JournalFilePath,Options);
164	end;
165
166	procedure TIBJournal.EndSession;
167	begin
168	FSessionID := -1;
169	Database.Attachment.StopJournaling(RetainJournal);
170	end;
171
172	constructor TIBJournal.Create(AOwner: TComponent);
173	begin
174	inherited Create(AOwner);
175	FBase := TIBBase.Create(Self);
176	FBase.BeforeDatabaseDisconnect := @HandleBeforeDatabaseDisconnect;
177	FBase.AfterDatabaseConnect := @HandleDatabaseConnect;
178	FBase.BeforeDatabaseDisconnect := @HandleDatabaseDisconnect;
179	FVendorName := DefaultVendor;
180	FJournalFileTemplate := DefaultJournalTemplate;
181	FOptions := [joReadWriteTransactions,joModifyQueries];
182	end;
183
184	destructor TIBJournal.Destroy;
185	begin
186	Enabled := false;
187	FBase.Free;
188	inherited Destroy;
189	end;
190
191	end.
192