1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
program fbadmindemo;
{
Program that tests/demonstrates Ludo Brands' FBAdmin unit
It shows getting server info, log, and backing up
It doesn't restore as that might delete data.
}
{$mode objfpc}{$H+}
{$APPTYPE CONSOLE}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes,
SysUtils,
ibconnection { for EIBDatabaseError},
FBAdmin;
function AskUser(const Question: string): string;
begin
writeln(Question);
readln(result);
end;
function ConnectToServer(TheServer: TFBAdmin): boolean;
var
Response:string;
begin
Response:=AskUser('Host name/IP address (empty for 127.0.0.1)?');
if trim(Response)='' then Response:='127.0.0.1';
TheServer.Host:=Response;
Response:=AskUser('Services port (empty for 3050)?');
if trim(Response)='' then
TheServer.Port:=3050
else
TheServer.Port:=StrToInt(Response);
Response:=AskUser('Username (empty for SYSDBA)?');
if trim(Response)='' then Response:='SYSDBA';
TheServer.User:=Response;
Response:=AskUser('Password (empty for masterkey)?');
if trim(Response)='' then Response:='masterkey';
TheServer.Password:=Response;
// Big change server supports TCP/IP
// Change this if you use embedded.
TheServer.Protocol:=IBSPTCPIP;
// We'll just abort our program if there's any error.
// Easier to use exceptions then.
TheServer.UseExceptions:=true;
try
result:=TheServer.Connect;
except
on B: EIBDatabaseError do
begin
writeln('Database error: ', B.ClassName, '/', B.Message,
'. GDS error code: ', B.GDSErrorCode);
end;
on E: Exception do
begin
writeln('Exception: ', E.ClassName, '/', E.Message);
end;
end;
end;
var
Database: string;
TheServer:TFBAdmin;
Users: TStringList;
// For filling user details:
GroupName,FirstName,MiddleName,LastName:string;
UserID, GroupID: longint;
begin
TheServer:=TFBAdmin.Create(nil);
try
if ConnectToServer(TheServer)=false then
begin
writeln('Aborting.');
halt(13);
end;
try
writeln('Server type: '+TheServer.ServerImplementation);
writeln('Server version: '+TheServer.ServerVersion);
// Handy to know for backup purposes...
writeln('Server root directory: '+TheServer.ServerRootDir);
Users:=TStringList.Create;
try
if TheServer.GetUsers(Users) then
writeln('List of users:'+Users.Text)
else
writeln('Sorry, could not get user list.');
finally
Users.Free;
end;
// Get details for current user:
if TheServer.GetUser(TheServer.User,GroupName,FirstName,MiddleName,LastName,UserID, GroupID) then
begin
writeln('Name: '+TheServer.User);
writeln('Full name: '+Trim(Trim(FirstName+Trim(' '+MiddleName)+' ')+LastName));
writeln('User ID: '+IntToStr(UserID));
writeln('Group: '+GroupName);
writeln('Group ID: '+IntToStr(GroupID));
end
else
writeln('Sorry, could not get user details for '+TheServer.User);
writeln('If you want to try a backup, please enter the');
writeln('path on the server where the database is.');
writeln('(Aliases will not work)');
Database:=Trim(AskUser('Enter nothing if you do not want a backup.'));
if Database<>'' then
begin
writeln('Starting backup to '+Database+'.fbk');
TheServer.Backup(Database, Database+'.fbk',[],'');
writeln('Output:');
writeln(TheServer.Output.Text);
AskUser('Please press enter to continue...');
end;
writeln('Database log:');
if TheServer.GetDatabaseLog then
writeln (TheServer.Output.Text)
else
writeln('Could not get database log, sorry.');
//We're at the end so it doesn't matter...
//AskUser('Please press enter to continue...');
TheServer.DisConnect;
except
on B: EIBDatabaseError do
begin
writeln('Database error: ', B.ClassName, '/', B.Message,
'. GDS error code: ', B.GDSErrorCode);
end;
on E: Exception do
begin
writeln('Exception: ', E.ClassName, '/', E.Message);
end;
end;
finally
TheServer.Free;
end;
writeln('Program finished.');
end.
|
