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

git-svn-id: trunk@21277 -

.gitattributes

@@ -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

packages/fcl-db/examples/fbadmindemo.pp

@@ -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.
+