paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 13:59:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Example from Reinier Olislagers to demo TFBAdmin component (bug 22012)

Browse Source 
git-svn-id: trunk@21277 -
This commit is contained in:
michael 2012-05-12 12:19:45 +00:00
parent 3296858f44
commit 264a013087
2 changed files with 150 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -1877,6 +1877,7 @@ packages/fcl-base/texts/fptemplate.txt svneol=native#text/plain
packages/fcl-db/Makefile svneol=native#text/plain
packages/fcl-db/Makefile.fpc svneol=native#text/plain
packages/fcl-db/Makefile.fpc.fpcmake svneol=native#text/plain
packages/fcl-db/examples/fbadmindemo.pp svneol=native#text/plain
packages/fcl-db/fpmake.pp svneol=native#text/plain
packages/fcl-db/src/Dataset.txt svneol=native#text/plain
packages/fcl-db/src/README.txt svneol=native#text/plain

149
packages/fcl-db/examples/fbadmindemo.pp Normal file
View File

@ -0,0 +1,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.