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

Question

unit Unit1;
//这是我测试的代码，希望对各位有用
interfaceuses
    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.

Answer 1

直接使用Firebird嵌入版数据库就可以了