Question

如何在程序中建立Firebird嵌入版数据库

Answer 1

unit Unit1;

//这是测试的代码
interface

 

uses

    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

    Dialogs, StdCtrls;

 

type

    TForm1 = class(TForm)

        Button1: TButton;

        procedure Button1Click(Sender: TObject);

    private

        { Private declarations }

    public

        { Public declarations }

    end;

 

var

    Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

type

    //复制自ibheader.pas

    ISC_STATUS = LongInt;

    PISC_STATUS = ^ISC_STATUS;

    TISC_DB_HANDLE = THandle;

    PISC_DB_HANDLE = ^TISC_DB_HANDLE;

    TISC_TR_HANDLE = THandle;

    PISC_TR_HANDLE = ^TISC_TR_HANDLE;

    TStatusVector = array[0..19] of ISC_STATUS;

    PStatusVector = ^TStatusVector;

    PShort = ^Short;

    PPChar = ^PChar;

    UShort = Word;

    PVoid = Pointer;

    ISC_LONG = LongInt;

    UISC_LONG = ULong;

    ISC_INT64 = Int64;

 

    UISC_STATUS = ULong;

    PISC_LONG = ^ISC_LONG;

    PUISC_LONG = ^UISC_LONG;

    PPISC_STATUS = ^PISC_STATUS;

    PUISC_STATUS = ^UISC_STATUS;

    TISC_BLOB_HANDLE = PVoid;

    PISC_BLOB_HANDLE = ^TISC_BLOB_HANDLE;

    TISC_STMT_HANDLE = PVoid;

    PISC_STMT_HANDLE = ^TISC_STMT_HANDLE;      

 

    { Declare the extended SQLDA }

    TXSQLVAR = record

        sqltype: Short; { datatype of field }

        sqlscale: Short; { scale factor }

        sqlsubtype: Short; { datatype subtype - BLOBs }

        { & text types only }

        sqllen: Short; { length of data area }

        sqldata: PChar; { address of data }

        sqlind: PSmallInt; { address of indicator }

        { variable }

        sqlname_length: Short; { length of sqlname field }

        { name of field, name length + space for NULL }

        sqlname: array[0..31] of Char;

        relname_length: Short; { length of relation name }

        { field's relation name + space for NULL }

        relname: array[0..31] of Char;

        ownname_length: Short; { length of owner name }

        { relation's owner name + space for NULL }

        ownname: array[0..31] of Char;

        aliasname_length: Short; { length of alias name }

        { relation's alias name + space for NULL }

        aliasname: array[0..31] of Char;

    end;

    PXSQLVAR = ^TXSQLVAR;

    TXSQLDA = record

        version: Short; { version of this XSQLDA }

        { XSQLDA name field }

        sqldaid: array[0..7] of Char;

        sqldabc: ISC_LONG; { length in bytes of SQLDA }

        sqln: Short; { number of fields allocated }

        sqld: Short; { actual number of fields }

        { first field address }

        sqlvar: array[0..0] of TXSQLVAR;

    end;

    PXSQLDA = ^TXSQLDA;

var

    isc_create_database: function(user_status: Pointer; file_length: Smallint;

        file_name: PChar; handle: Pointer; dpb_length: Smallint; dpb: PChar;

        db_type: Smallint): longint; stdcall;

 

    isc_detach_database: function(status_vector: PISC_STATUS;

        db_handle: PISC_DB_HANDLE): ISC_STATUS; stdcall;

 

    isc_dsql_execute_immediate: function(status_vector: PISC_STATUS;

        db_handle: PISC_DB_HANDLE;

        tran_handle: PISC_TR_HANDLE;

        length: Word;

        statement: PChar;

        dialect: Word;

        xsqlda: PXSQLDA): ISC_STATUS; stdcall;

 

procedure TForm1.Button1Click(Sender: TObject);

var

    dbCreateSql: AnsiString;

    FileName: string;

    strCreateDatabaseSql: AnsiString;

    StatusVector: TStatusVector;

    StatusVector1: TStatusVector;

    DBHandle: PPointer;

    dbhandle1: PPointer;

    TRHandle: PPointer;

    GDS32Lib: cardinal;

    errcode: integer;

begin  

    dbCreateSql := AnsiString(Format('CREATE DATABASE ''%s'' user ''%s'' PASSWORD ''%s'' PAGE_SIZE 8192 DEFAULT CHARACTER SET GBK',

        ['test.fdb', 'sysdba', 'masterkey']));

    FileName := 'test1.fdb';

    DeleteFile(FileName);

    DeleteFile('test.fdb');

 

    DBHandle := nil;

    DBHandle1 := nil;

    TRHandle := nil;

 

    GDS32Lib := LoadLibrary('fbembed.dll');

 

    try

        isc_create_database := GetProcAddress(GDS32Lib, 'isc_create_database');

        if not assigned(isc_create_database) then

            raise exception.create('isc_create_database = nil');

 

        isc_detach_database := GetProcAddress(GDS32Lib, 'isc_detach_database');

        if not assigned(isc_detach_database) then

            raise exception.create('isc_detach_database = nil');

 

        isc_dsql_execute_immediate := GetProcAddress(GDS32Lib, 'isc_dsql_execute_immediate');

        if not assigned(isc_dsql_execute_immediate) then

            raise exception.create('isc_dsql_execute_immediate = nil');

 

        errcode := isc_create_database(@StatusVector, Length(FileName), PChar(FileName), @DBHandle1, 0, nil, 0);

        if errcode <> 0 then

            raise exception.create('isc_create_database create database error. ' +  'error ' + inttostr(errcode));

        errcode := isc_detach_database(@statusVector, @dbhandle1);

        if errcode <> 0 then

            raise exception.create('error ' + inttostr(errcode));

         DBHandle1 := nil;

 

        errcode := isc_dsql_execute_immediate(@statusVector, @DBHandle, @TRHandle, 0, PAnsiChar(dbCreateSql), 3, nil);

        if errcode <> 0 then

            raise exception.create('isc_dsql_execute_immediate create database error. ' +  'error ' + inttostr(errcode));

 

        errcode := isc_detach_database(@statusVector, @dbhandle);

        if errcode <> 0 then

            raise exception.create('error ' + inttostr(errcode));

        DBHandle := nil;         

    finally

        FreeLibrary(GDS32Lib);

    end;

    //MessageDlg('done', mtInformation, [mbok], 0);

end;

 

end.