ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/services/Unit1.pas
(Generate patch)

Comparing ibx/trunk/examples/services/Unit1.pas (file contents):
Revision 31 by tony, Tue Jul 14 15:31:25 2015 UTC vs.
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC

# Line 6 | Line 6 | interface
6  
7   uses
8    Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
9 <  IBServices;
9 >  IBServices, IB, Unit2, Unit3,  ListUsersUnit, LimboTransactionsUnit;
10  
11   type
12  
# Line 14 | Line 14 | type
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;
# Line 34 | Line 53 | implementation
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 <    Attach;
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  
# Line 50 | Line 164 | 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  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines