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
#	User	Rev	Content
1	tony	31	unit Unit1;
2
3			{$mode objfpc}{$H+}
4
5			interface
6
7			uses
8			Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
9	tony	45	IBServices, IB, Unit2, Unit3, ListUsersUnit, LimboTransactionsUnit;
10	tony	31
11			type
12
13			{ TForm1 }
14
15			TForm1 = class(TForm)
16			Button1: TButton;
17	tony	45	Button2: TButton;
18			Button3: TButton;
19			Button4: TButton;
20			Button5: TButton;
21			Button6: TButton;
22			Button7: TButton;
23			Button8: TButton;
24			IBLogService1: TIBLogService;
25	tony	31	IBServerProperties1: TIBServerProperties;
26	tony	45	IBStatisticalService1: TIBStatisticalService;
27			IBValidationService1: TIBValidationService;
28	tony	31	Memo1: TMemo;
29			procedure Button1Click(Sender: TObject);
30	tony	45	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	tony	31	procedure FormShow(Sender: TObject);
38			private
39			{ private declarations }
40	tony	45	procedure DoBackup(Data: PtrInt);
41			procedure DoRestore(Data: PtrInt);
42	tony	31	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	tony	45	var i: integer;
57	tony	31	begin
58	tony	45	Form3.IBRestoreService1.DatabaseName.Clear;
59			Form3.IBRestoreService1.DatabaseName.Add(GetTempDir + 'mytest.fdb');
60	tony	31	with IBServerProperties1 do
61			begin
62	tony	45	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	tony	31	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	tony	45	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	tony	31	end;
89			end;
90
91	tony	45	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	tony	31	procedure TForm1.Button1Click(Sender: TObject);
163			begin
164			Close
165			end;
166
167	tony	45	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	tony	31	end.
268