ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/services/Unit1.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 11 months ago) by tony
Content type: text/x-pascal
File size: 7606 byte(s)
Log Message:
Committing updates for Release R2-0-0

File Contents

# 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