examples/services/Unit1.pas

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  IBServices, IB, Unit2, Unit3,  ListUsersUnit, LimboTransactionsUnit;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    IBLogService1: TIBLogService;
    IBServerProperties1: TIBServerProperties;
    IBStatisticalService1: TIBStatisticalService;
    IBValidationService1: TIBValidationService;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { private declarations }
    procedure DoBackup(Data: PtrInt);
    procedure DoRestore(Data: PtrInt);
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormShow(Sender: TObject);
var i: integer;
begin
  Form3.IBRestoreService1.DatabaseName.Clear;
  Form3.IBRestoreService1.DatabaseName.Add(GetTempDir + 'mytest.fdb');
  with IBServerProperties1 do
  begin
    repeat
      try
        Active := true;
      except
       on E:EIBClientError do
        begin
          Close;
          Exit
        end;
       On E:Exception do
         MessageDlg(E.Message,mtError,[mbOK],0);
      end;
    until Active; {Loop until logged in or user cancels}
    FetchVersionInfo;
    Memo1.Lines.Add('Server Version = ' + VersionInfo.ServerVersion);
    Memo1.Lines.Add('Server Implementation = ' + VersionInfo.ServerImplementation);
    Memo1.Lines.Add('Service Version = ' + IntToStr(VersionInfo.ServiceVersion));
    FetchDatabaseInfo;
    Memo1.Lines.Add('No. of attachments = ' + IntToStr(DatabaseInfo.NoOfAttachments));
    Memo1.Lines.Add('No. of databases = ' + IntToStr(DatabaseInfo.NoOfDatabases));
    for i := 0 to DatabaseInfo.NoOfDatabases - 1 do
      Memo1.Lines.Add('DB Name = ' + DatabaseInfo.DbName[i]);
    FetchConfigParams;
    Memo1.Lines.Add('Base Location = ' + ConfigParams.BaseLocation);
    Memo1.Lines.Add('Lock File Location = ' + ConfigParams.LockFileLocation);
    Memo1.Lines.Add('Security Database Location = ' + ConfigParams.SecurityDatabaseLocation);
  end;
end;

procedure TForm1.DoBackup(Data: PtrInt);
var bakfile: TFileStream;
begin
  bakfile := nil;
  with Form2 do
  begin
    IBBackupService1.ServiceIntf := IBServerProperties1.ServiceIntf;
    IBBackupService1.Active := true;
    Memo1.Lines.Add('Starting Backup');
    IBBackupService1.ServiceStart;
    try
      if IBBackupService1.BackupFileLocation = flClientSide then
        bakfile := TFileStream.Create(IBBackupService1.BackupFile[0],fmCreate);
      while not IBBackupService1.Eof do
      begin
        case IBBackupService1.BackupFileLocation of
        flServerSide:
          Memo1.Lines.Add(IBBackupService1.GetNextLine);
        flClientSide:
          IBBackupService1.WriteNextChunk(bakfile);
        end;
        Application.ProcessMessages
      end;
    finally
      if bakfile <> nil then
        bakfile.Free;
    end;
    Memo1.Lines.Add('Backup Completed');
    MessageDlg('Backup Completed',mtInformation,[mbOK],0);
  end;
end;

procedure TForm1.DoRestore(Data: PtrInt);
var bakfile: TFileStream;
    line: string;
begin
  bakfile := nil;
  with Form3 do
  begin
    IBRestoreService1.ServiceIntf := IBServerProperties1.ServiceIntf;
    IBRestoreService1.Active := true;
    if IBRestoreService1.IsServiceRunning then
      Exception.Create('A Service is still running');
    IBRestoreService1.ServiceStart;
    Memo1.Lines.Add('Restore Started');
    try
      if IBRestoreService1.BackupFileLocation = flClientSide then
        bakfile := TFileStream.Create(IBRestoreService1.BackupFile[0],fmOpenRead);
      while not IBRestoreService1.Eof do
      begin
        case IBRestoreService1.BackupFileLocation of
        flServerSide:
          Memo1.Lines.Add(Trim(IBRestoreService1.GetNextLine));
        flClientSide:
          begin
            IBRestoreService1.SendNextChunk(bakfile,line);
            if line <> '' then
              Memo1.Lines.Add(line);
          end;
        end;
        Application.ProcessMessages
      end;
    finally
      if bakfile <> nil then
        bakfile.Free;
    end;
    Memo1.Lines.Add('Restore Completed');
    MessageDlg('Restore Completed',mtInformation,[mbOK],0);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if Form2.ShowModal = mrOK then
    Application.QueueAsyncCall(@DoBackup,0);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if Form3.ShowModal = mrOK then
    Application.QueueAsyncCall(@DoRestore,0);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  Memo1.Lines.Add('Server Log');
  IBLogService1.ServiceIntf := IBServerProperties1.ServiceIntf;
  with IBLogService1 do
  begin
    Active := true;
    ServiceStart;
    while not Eof do
    begin
      Memo1.Lines.Add(GetNextLine);
      Application.ProcessMessages;
    end;
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
var DBName: string;
begin
  DBName := IBStatisticalService1.DatabaseName;
  if InputQuery('Select Database','Enter Database Name on ' + IBStatisticalService1.ServerName,
         DBName) then
  begin
    IBStatisticalService1.DatabaseName := DBName;
    Memo1.Lines.Add('Database Statistics for ' + IBStatisticalService1.DatabaseName);
    IBStatisticalService1.ServiceIntf := IBServerProperties1.ServiceIntf;
    with IBStatisticalService1 do
    begin
      Active := true;
      ServiceStart;
      while not Eof do
      begin
        Memo1.Lines.Add(GetNextLine);
        Application.ProcessMessages;
      end;
    end;
  end;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  ListUsersForm.IBSecurityService1.ServiceIntf := IBServerProperties1.ServiceIntf;
  ListUsersForm.ShowModal;
end;

procedure TForm1.Button7Click(Sender: TObject);
var DBName: string;
begin
  DBName := IBValidationService1.DatabaseName;
  if InputQuery('Select Database','Enter Database Name on ' + IBValidationService1.ServerName,
         DBName) then
  begin
    IBValidationService1.DatabaseName := DBName;
    Memo1.Lines.Add('Database Validation for ' + IBValidationService1.DatabaseName);
    Memo1.Lines.Add('Running...');
    IBValidationService1.ServiceIntf := IBServerProperties1.ServiceIntf;
    Application.ProcessMessages;
    with IBValidationService1 do
    begin
      Active := true;
      ServiceStart;
      while not Eof do
      begin
        Memo1.Lines.Add(GetNextLine);
        Application.ProcessMessages;
      end;
    end;
    Memo1.Lines.Add('Validation Completed');
    MessageDlg('Validation Completed',mtInformation,[mbOK],0);
  end;
end;

procedure TForm1.Button8Click(Sender: TObject);
var DBName: string;
begin
  with LimboTransactionsForm do
  begin
    DBName := IBValidationService1.DatabaseName;
    if InputQuery('Select Database','Enter Database Name on ' + IBValidationService1.ServerName,
           DBName) then
    begin
      IBValidationService1.ServiceIntf := IBServerProperties1.ServiceIntf;
      IBValidationService1.DatabaseName := DBName;
      ShowModal;
    end;
  end;
end;

end.

Revision:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (7 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	7606 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	Content
1	unit Unit1;
2
3	{$mode objfpc}{$H+}
4
5	interface
6
7	uses
8	Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
9	IBServices, IB, Unit2, Unit3, ListUsersUnit, LimboTransactionsUnit;
10
11	type
12
13	{ TForm1 }
14
15	TForm1 = class(TForm)
16	Button1: TButton;
17	Button2: TButton;
18	Button3: TButton;
19	Button4: TButton;
20	Button5: TButton;
21	Button6: TButton;
22	Button7: TButton;
23	Button8: TButton;
24	IBLogService1: TIBLogService;
25	IBServerProperties1: TIBServerProperties;
26	IBStatisticalService1: TIBStatisticalService;
27	IBValidationService1: TIBValidationService;
28	Memo1: TMemo;
29	procedure Button1Click(Sender: TObject);
30	procedure Button2Click(Sender: TObject);
31	procedure Button3Click(Sender: TObject);
32	procedure Button4Click(Sender: TObject);
33	procedure Button5Click(Sender: TObject);
34	procedure Button6Click(Sender: TObject);
35	procedure Button7Click(Sender: TObject);
36	procedure Button8Click(Sender: TObject);
37	procedure FormShow(Sender: TObject);
38	private
39	{ private declarations }
40	procedure DoBackup(Data: PtrInt);
41	procedure DoRestore(Data: PtrInt);
42	public
43	{ public declarations }
44	end;
45
46	var
47	Form1: TForm1;
48
49	implementation
50
51	{$R *.lfm}
52
53	{ TForm1 }
54
55	procedure TForm1.FormShow(Sender: TObject);
56	var i: integer;
57	begin
58	Form3.IBRestoreService1.DatabaseName.Clear;
59	Form3.IBRestoreService1.DatabaseName.Add(GetTempDir + 'mytest.fdb');
60	with IBServerProperties1 do
61	begin
62	repeat
63	try
64	Active := true;
65	except
66	on E:EIBClientError do
67	begin
68	Close;
69	Exit
70	end;
71	On E:Exception do
72	MessageDlg(E.Message,mtError,[mbOK],0);
73	end;
74	until Active; {Loop until logged in or user cancels}
75	FetchVersionInfo;
76	Memo1.Lines.Add('Server Version = ' + VersionInfo.ServerVersion);
77	Memo1.Lines.Add('Server Implementation = ' + VersionInfo.ServerImplementation);
78	Memo1.Lines.Add('Service Version = ' + IntToStr(VersionInfo.ServiceVersion));
79	FetchDatabaseInfo;
80	Memo1.Lines.Add('No. of attachments = ' + IntToStr(DatabaseInfo.NoOfAttachments));
81	Memo1.Lines.Add('No. of databases = ' + IntToStr(DatabaseInfo.NoOfDatabases));
82	for i := 0 to DatabaseInfo.NoOfDatabases - 1 do
83	Memo1.Lines.Add('DB Name = ' + DatabaseInfo.DbName[i]);
84	FetchConfigParams;
85	Memo1.Lines.Add('Base Location = ' + ConfigParams.BaseLocation);
86	Memo1.Lines.Add('Lock File Location = ' + ConfigParams.LockFileLocation);
87	Memo1.Lines.Add('Security Database Location = ' + ConfigParams.SecurityDatabaseLocation);
88	end;
89	end;
90
91	procedure TForm1.DoBackup(Data: PtrInt);
92	var bakfile: TFileStream;
93	begin
94	bakfile := nil;
95	with Form2 do
96	begin
97	IBBackupService1.ServiceIntf := IBServerProperties1.ServiceIntf;
98	IBBackupService1.Active := true;
99	Memo1.Lines.Add('Starting Backup');
100	IBBackupService1.ServiceStart;
101	try
102	if IBBackupService1.BackupFileLocation = flClientSide then
103	bakfile := TFileStream.Create(IBBackupService1.BackupFile[0],fmCreate);
104	while not IBBackupService1.Eof do
105	begin
106	case IBBackupService1.BackupFileLocation of
107	flServerSide:
108	Memo1.Lines.Add(IBBackupService1.GetNextLine);
109	flClientSide:
110	IBBackupService1.WriteNextChunk(bakfile);
111	end;
112	Application.ProcessMessages
113	end;
114	finally
115	if bakfile <> nil then
116	bakfile.Free;
117	end;
118	Memo1.Lines.Add('Backup Completed');
119	MessageDlg('Backup Completed',mtInformation,[mbOK],0);
120	end;
121	end;
122
123	procedure TForm1.DoRestore(Data: PtrInt);
124	var bakfile: TFileStream;
125	line: string;
126	begin
127	bakfile := nil;
128	with Form3 do
129	begin
130	IBRestoreService1.ServiceIntf := IBServerProperties1.ServiceIntf;
131	IBRestoreService1.Active := true;
132	if IBRestoreService1.IsServiceRunning then
133	Exception.Create('A Service is still running');
134	IBRestoreService1.ServiceStart;
135	Memo1.Lines.Add('Restore Started');
136	try
137	if IBRestoreService1.BackupFileLocation = flClientSide then
138	bakfile := TFileStream.Create(IBRestoreService1.BackupFile[0],fmOpenRead);
139	while not IBRestoreService1.Eof do
140	begin
141	case IBRestoreService1.BackupFileLocation of
142	flServerSide:
143	Memo1.Lines.Add(Trim(IBRestoreService1.GetNextLine));
144	flClientSide:
145	begin
146	IBRestoreService1.SendNextChunk(bakfile,line);
147	if line <> '' then
148	Memo1.Lines.Add(line);
149	end;
150	end;
151	Application.ProcessMessages
152	end;
153	finally
154	if bakfile <> nil then
155	bakfile.Free;
156	end;
157	Memo1.Lines.Add('Restore Completed');
158	MessageDlg('Restore Completed',mtInformation,[mbOK],0);
159	end;
160	end;
161
162	procedure TForm1.Button1Click(Sender: TObject);
163	begin
164	Close
165	end;
166
167	procedure TForm1.Button2Click(Sender: TObject);
168	begin
169	if Form2.ShowModal = mrOK then
170	Application.QueueAsyncCall(@DoBackup,0);
171	end;
172
173	procedure TForm1.Button3Click(Sender: TObject);
174	begin
175	if Form3.ShowModal = mrOK then
176	Application.QueueAsyncCall(@DoRestore,0);
177	end;
178
179	procedure TForm1.Button4Click(Sender: TObject);
180	begin
181	Memo1.Lines.Add('Server Log');
182	IBLogService1.ServiceIntf := IBServerProperties1.ServiceIntf;
183	with IBLogService1 do
184	begin
185	Active := true;
186	ServiceStart;
187	while not Eof do
188	begin
189	Memo1.Lines.Add(GetNextLine);
190	Application.ProcessMessages;
191	end;
192	end;
193	end;
194
195	procedure TForm1.Button5Click(Sender: TObject);
196	var DBName: string;
197	begin
198	DBName := IBStatisticalService1.DatabaseName;
199	if InputQuery('Select Database','Enter Database Name on ' + IBStatisticalService1.ServerName,
200	DBName) then
201	begin
202	IBStatisticalService1.DatabaseName := DBName;
203	Memo1.Lines.Add('Database Statistics for ' + IBStatisticalService1.DatabaseName);
204	IBStatisticalService1.ServiceIntf := IBServerProperties1.ServiceIntf;
205	with IBStatisticalService1 do
206	begin
207	Active := true;
208	ServiceStart;
209	while not Eof do
210	begin
211	Memo1.Lines.Add(GetNextLine);
212	Application.ProcessMessages;
213	end;
214	end;
215	end;
216	end;
217
218	procedure TForm1.Button6Click(Sender: TObject);
219	begin
220	ListUsersForm.IBSecurityService1.ServiceIntf := IBServerProperties1.ServiceIntf;
221	ListUsersForm.ShowModal;
222	end;
223
224	procedure TForm1.Button7Click(Sender: TObject);
225	var DBName: string;
226	begin
227	DBName := IBValidationService1.DatabaseName;
228	if InputQuery('Select Database','Enter Database Name on ' + IBValidationService1.ServerName,
229	DBName) then
230	begin
231	IBValidationService1.DatabaseName := DBName;
232	Memo1.Lines.Add('Database Validation for ' + IBValidationService1.DatabaseName);
233	Memo1.Lines.Add('Running...');
234	IBValidationService1.ServiceIntf := IBServerProperties1.ServiceIntf;
235	Application.ProcessMessages;
236	with IBValidationService1 do
237	begin
238	Active := true;
239	ServiceStart;
240	while not Eof do
241	begin
242	Memo1.Lines.Add(GetNextLine);
243	Application.ProcessMessages;
244	end;
245	end;
246	Memo1.Lines.Add('Validation Completed');
247	MessageDlg('Validation Completed',mtInformation,[mbOK],0);
248	end;
249	end;
250
251	procedure TForm1.Button8Click(Sender: TObject);
252	var DBName: string;
253	begin
254	with LimboTransactionsForm do
255	begin
256	DBName := IBValidationService1.DatabaseName;
257	if InputQuery('Select Database','Enter Database Name on ' + IBValidationService1.ServerName,
258	DBName) then
259	begin
260	IBValidationService1.ServiceIntf := IBServerProperties1.ServiceIntf;
261	IBValidationService1.DatabaseName := DBName;
262	ShowModal;
263	end;
264	end;
265	end;
266
267	end.
268