fpc/packages/fcl-db/examples/fbadmindemo.pp

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.