Program create; {$APPTYPE CONSOLE} uses Sysutils,Firebird,Windows; var st : IStatus; master : IMaster; util : IUtil; dpb : IXpbBuilder; prov : IProvider; att : IAttachment; tra : ITransaction; procedure PrintError(s : IStatus); var maxMessage : Integer; outMessage : PAnsiChar; begin maxMessage := 256; outMessage := PAnsiChar(StrAlloc(maxMessage)); util.formatStatus(outMessage, maxMessage, s); writeln(outMessage); StrDispose(outMessage); end; type IKeyCallback = class(ICryptKeyCallbackImpl) function callback(dataLength: Cardinal; data: Pointer; bufferLength: Cardinal; buffer: Pointer): Cardinal; override; end; function IKeyCallback.callback(dataLength: Cardinal; data: Pointer; bufferLength: Cardinal; buffer: Pointer): Cardinal; var Key: PAnsiChar; KeyLength:Integer; begin KeyLength := 0; If (bufferLength > 0) and (buffer <> nil) then begin WriteLn('Sending key'); Key := '0123456789'; KeyLength := Length(Key); WriteLn('got key request: ', PAnsiChar(Data):dataLength); Move(Key^, buffer^, KeyLength); end; Result := KeyLength; end; var param1:String; begin if ParamCount>0 then begin param1 := ParamStr(1); end; if param1<>'open' then param1 := 'create'; WriteLn('starting...('+param1+')'); master := fb_get_master_interface; if master = nil then begin WriteLn('master is nil'); Exit; end; Write('getting util interface...'); util := master.getUtilInterface; WriteLn('done.'); Write('getting status and dispatcher...'); st := master.getStatus; prov := master.getDispatcher; WriteLn('done.'); if (util = nil) or (st = nil) or (prov = nil) then begin WriteLn('null pointers'); Exit; end; try prov.setDbCryptCallback(st, IKeyCallback.create); Write('Generating DPB...'); //create DPB dpb := util.getXpbBuilder(st, IXpbBuilder.DPB, nil, 0); Write('page size...'); dpb.insertInt(st, isc_dpb_page_size, 4 * 1024); Write('user name...'); dpb.insertString(st, isc_dpb_user_name, 'sysdba'); Write('password...'); dpb.insertString(st, isc_dpb_password, 'masterkey'); WriteLn('done.'); //create empty database if param1='create' then begin att := prov.createDatabase(st, 'fbtests.fdb', dpb.getBufferLength(st), dpb.getBuffer(st)); writeln ('Database fbtests.fdb created'); //start transaction tra := att.startTransaction(st, 0, nil); //Encrypt database att.execute(st, tra, 0, 'alter database encrypt with aes128', 3, nil, nil, nil, nil); // Input parameters and output data not used //commit transaction (will close interface) tra.commit(st); tra := nil; WriteLn('Press Enter to continue'); ReadLn; //detach from database att.detach(st); att := nil; //remove unneeded tag from DPB if dpb.findFirst(st, isc_dpb_page_size) then dpb.removeCurrent(st); //attach once again att := prov.attachDatabase(st, 'fbtests.fdb', dpb.getBufferLength(st), dpb.getBuffer(st)); writeln ('Re-attached database fbtests.fdb'); //start transaction tra := att.startTransaction(st, 0, nil); //create table att.execute(st, tra, 0, 'create table dates_table (d1 date)', 3, nil, nil, nil, nil); // Input parameters and output data not used //commit transaction retaining tra.commitRetaining(st); writeln ('Table dates_table created'); //insert a record into dates_table att.execute(st, tra, 0, 'insert into dates_table values (CURRENT_DATE)', 3, nil, nil, nil, nil); // Input parameters and output data not used //commit transaction (will close interface) tra.commit(st); tra := nil; writeln ('Record inserted into dates_table'); end //open database else if param1='open' then begin att := prov.attachDatabase(st, 'fbtests.fdb', dpb.getBufferLength(st), dpb.getBuffer(st)); writeln ('Database fbtests.fdb Opened'); exit; end; //detach from the database (will close interface) att.detach(st); att := nil; dpb.dispose; dpb := nil; except on e: FbException do PrintError(e.getStatus); end; prov.release; end.