[firebase-br] Rotina pra criar banco de dados em tempo de execução no IB 6.0

[Joelson - Souzamark]

A quem se interessar possa...

essa é uma unit q usa a biblioteca GDS32.DLL do IB 6.0 pra criar um db,
acabei de testar no FB 1.5.2 e funcionou...

{$A+,B-,C-,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y-,Z1}
{$MINSTACKSIZE $00004000}
{$MAXSTACKSIZE $00100000}
{$IMAGEBASE $00400000}
{$APPTYPE GUI}

unit IB;

interface

uses DB, SysUtils, Windows, Dialogs;

procedure CreateDatabase(DBName, User, Pswd, OptData: string);

implementation

{ Execute a SQL statment on an InterBase server }
function isc_dsql_execute_immediate(pstatus: plongint; var db_handle: plongint;
              var trans_handle: plongint; length: word; SQL: pchar; dialect: word;
              pxsqlda: pointer): longint; stdcall; external 'GDS32.DLL';

{ Drop a connection to an InterBase server }
function isc_detach_database(pStatus: plongint; var db_handle: plongint):
                 longint; stdcall; external 'GDS32.DLL';

{ Create an error code number from the status vector }
function isc_sqlcode(pstatus: plongint): longint; stdcall; external 'GDS32.DLL';

{ Build a message string from a SQL code }
function isc_sql_interprete(code: longint; buffer: pchar; size: integer): longint;
              stdcall; external 'GDS32.DLL';

{ Formulate Error -- Create an Interbase error string when an error occurs }
function FormulateError(sqlrslt: longint; vector: plongint): string;
const
  MAX_MSG = 500;
var
  sqlmsg: string;

begin
  sqlrslt := isc_sqlcode(vector);
  setlength(sqlmsg, MAX_MSG);
  isc_sql_interprete(sqlrslt, PChar(sqlmsg), MAX_MSG);
  setlength(sqlmsg, strlen(pchar(sqlmsg)));
  Result := 'SQL Code: ' + IntToStr(sqlrslt) + ', Message: ' + sqlmsg;
end;

{ CreateDatabase -- Create an InterBase Database.
  DBName = Path and Database name.
  User = User name for the specified server.
  Pswd = Password for the specified user and server.
}
procedure CreateDatabase(DBName, User, Pswd, OptData: string);
var
  status: array[1..19] of longint;
  db, tran: plongint;
  rslt: longint;
  BaseSQL: string;

begin
  { Both Database and Transaction handles must be nil for CREATE DATABASE call }
  db := nil;
  tran := nil;
  BaseSQL := 'CREATE DATABASE "' + DBName + '" USER "' + User + '" PASSWORD ' +
             '"' + Pswd + '" ' + OptData;

  { Create the specified database }
  rslt := isc_dsql_execute_immediate(@status, db, tran, 0, PChar(BaseSQL), 1, nil);
  if rslt <> 0 then
    raise EDatabaseError.Create('Error creating database!  ISC# ' +
            IntToStr(rslt) + #10#13 + FormulateError(rslt, @status));

  { Drop the connection to the newly created Database }
  rslt := isc_detach_database(@status, db);
  if rslt <> 0 then
    raise EDatabaseError.Create('Error detaching database!  ISC# ' +
            IntToStr(rslt) + #10#13 + FormulateError(rslt, @status));
end;
end.

sem mais
Joelson