⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fastdbcli.pas

📁 俄国人写的内存数据库的delphi封装
💻 PAS
📖 第 1 页 / 共 5 页
字号:
        GetAddr(@cli_statement                 , 'cli_statement');
        GetAddr(@cli_parameter                 , 'cli_parameter');
        GetAddr(@cli_column                    , 'cli_column');
        //GetAddr(@cli_array_column           , 'cli_array_column');  This procedure is not needed.
        GetAddr(@cli_array_column_ex           , 'cli_array_column_ex');
        GetAddr(@cli_fetch                     , 'cli_fetch');
        GetAddr(@cli_insert                    , 'cli_insert');
        GetAddr(@cli_get_first                 , 'cli_get_first');
        GetAddr(@cli_get_last                  , 'cli_get_last');
        GetAddr(@cli_get_next                  , 'cli_get_next');
        GetAddr(@cli_get_prev                  , 'cli_get_prev');
        GetAddr(@cli_get_oid                   , 'cli_get_oid');
        GetAddr(@cli_skip                      , 'cli_skip');
        GetAddr(@cli_seek                      , 'cli_seek');
        GetAddr(@cli_update                    , 'cli_update');
        GetAddr(@cli_remove                    , 'cli_remove');
        GetAddr(@cli_free                      , 'cli_free');
        GetAddr(@cli_commit                    , 'cli_commit');
        GetAddr(@cli_precommit                 , 'cli_precommit');
        GetAddr(@cli_abort                     , 'cli_abort');
        GetAddr(@cli_describe                  , 'cli_describe');
        GetAddr(@cli_get_field_size            , 'cli_get_field_size');
        GetAddr(@cli_get_field_offset          , 'cli_get_field_offset');
        GetAddr(@cli_show_tables               , 'cli_show_tables');
        GetAddr(@cli_create_table              , 'cli_create_table');
        GetAddr(@cli_alter_table               , 'cli_alter_table');
        GetAddr(@cli_drop_table                , 'cli_drop_table');
        GetAddr(@cli_alter_index               , 'cli_alter_index');
        GetAddr(@__cli_set_error_handler       , 'cli_set_error_handler');
        GetAddr(@cli_freeze                    , 'cli_freeze');
        GetAddr(@cli_unfreeze                  , 'cli_unfreeze');
        GetAddr(@cli_attach                    , 'cli_attach');
        GetAddr(@__cli_detach                  , 'cli_detach');
        GetAddr(@cli_free_memory               , 'cli_free_memory');
        GetAddr(@cli_get_database_state        , 'cli_get_database_state');
        GetAddr(@cli_set_trace_function        , 'cli_set_trace_function');
        GetAddr(@cli_prepare_query             , 'cli_prepare_query');
        GetAddr(@cli_execute_query             , 'cli_execute_query');
        GetAddr(@cli_insert_struct             , 'cli_insert_struct');

        {$IFDEF GIGABASE}
        GetAddr(@cli_clear_connection_pool     , 'cli_clear_connection_pool');
        {$ENDIF}
        
        //ExitProc := @DLLExit;
      except
        on e: Exception do
          begin
            FreeLibrary(DLLHandle);
            DLLHandle := 0;
            raise;
          end
      end;
  end;
end; {LoadDLL}

//--------------------------------------------------------------
function cli_open(const ServerURL: string;
                  const MaxConnectAttempts: Integer;
                  const ReconnectTimeoutSec: Integer
                  {$IFDEF GIGABASE}
				  ; UserName, Password: string;
                  PooledConnection: Boolean                  {$ENDIF}
                  ): Integer;
{$IFDEF GIGABASE}
var
  n : Integer;
{$ENDIF}
begin
  LoadDLL;
  {$IFDEF GIGABASE}
  if PooledConnection then n := 1 else n := 0;
  {$ENDIF}
  {$IFDEF CLI_DEBUG}
    {$IFDEF GIGABASE}
    TraceDebugProcedure(Format('cli_open(%s, %d, %d, "%s", "%s", %d)', [ServerURL, MaxConnectAttempts, ReconnectTimeoutSec, Username, Password, n]), True);
    {$ELSE}
    TraceDebugProcedure(Format('cli_open(%s, %d, %d)', [ServerURL, MaxConnectAttempts, ReconnectTimeoutSec]), True);
    {$ENDIF}
  {$ENDIF}
  Result := __cli_open(PChar(ServerURL), MaxConnectAttempts, ReconnectTimeoutSec
                       {$IFDEF GIGABASE}
                       , Username, Password, n
                       {$ENDIF}
                      );
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [Result]), False);
  {$ENDIF}
end;

{$IFDEF GIGABASE}
function cli_create(const DatabasePath: string;
                    const TransactionCommitDelay: Word=0;
                    const OpenAttr: TCliOpenAttributes = [oaReadWrite];
                    const PoolSize: Integer=0
                    ): Integer;
{$ELSE}
//---------------------------------------------------------------------------
function cli_create(const DatabaseName: string;
                    const FilePath: string;
                    const InitDatabaseSize: Integer=FastDbDefaultInitDatabaseSize;
                    const TransactionCommitDelay: Word=0;
                    const OpenAttr: TCliOpenAttributes = [oaReadWrite];
                    const InitIndexSize: Integer=FastDbDefaultInitIndexSize;
                    const ExtensionQuantum: Integer=FastDbDefaultExtensionQuantum;
                    const FileSizeLimit: Integer=0
                    ): Integer;
{$ENDIF}
begin
  LoadDLL;

  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(
                      {$IFDEF GIGABASE}
                      Format('cli_create("%s",%d,%d,%d)', [
                                 DatabasePath,
                                 TransactionCommitDelay,
                                 OpenAttrToInt(OpenAttr),
                                 PoolSize])
                      {$ELSE}
                      Format('cli_create("%s","%s",%d,%d,%d,%d,%d,%d)', [
                                 DatabaseName,
                                 FilePath,
                                 TransactionCommitDelay,
                                 OpenAttrToInt(OpenAttr),
                                 InitDatabaseSize,
                                 ExtensionQuantum,
                                 InitIndexSize,
                                 FileSizeLimit])
                      {$ENDIF}
                     , True);
  {$ENDIF}
  try
    {$IFDEF GIGABASE}
    Result := __cli_create(PChar(DatabasePath), TransactionCommitDelay, OpenAttrToInt(OpenAttr), PoolSize);
    {$ELSE}
    Result := __cli_create(PChar(DatabaseName), PChar(FilePath), TransactionCommitDelay,
                           OpenAttrToInt(OpenAttr), InitDatabaseSize, ExtensionQuantum,
                           InitIndexSize, FileSizeLimit);
    {$ENDIF}
  except
    on e: Exception do
      raise EFastDbError.Create(cli_database_open_error, 'cli_create failed. '+e.message);
  end;
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [Result]), False);
  {$ENDIF}
end;

//---------------------------------------------------------------------------
function cli_create_replication_node(const NodeID: Integer;
                                     const ServerCount: Integer;
                                     const NodeNames: TStrArray;
                                     const DatabaseName: string;
                                     const FilePath: string;
                                     const InitDatabaseSize: Integer=FastDbDefaultInitDatabaseSize;
                                     //const TransactionCommitDelay: Word=0;
                                     const OpenAttr: TCliOpenAttributes = [oaReadWrite];
                                     const InitIndexSize: Integer=FastDbDefaultInitIndexSize;
                                     const ExtensionQuantum: Integer=FastDbDefaultExtensionQuantum;
                                     const FileSizeLimit: Integer=0
                                    ): Integer;
{$IFDEF CLI_DEBUG}
var
  i : Integer;
  s : string;
{$ENDIF}
begin
  {$IFDEF CLI_DEBUG}
  for i:=0 to Length(NodeNames)-1 do
    s := s + Format(',"%s"', [NodeNames[i]]);
  if s <> '' then Delete(s, 1, 1);
  TraceDebugProcedure(Format('cli_create_replication_node(%d,%d,(%s),"%s","%s",%d,%d,%d,%d,%d)', [
                                 NodeID,
                                 ServerCount,
                                 s,
                                 DatabaseName,
                                 FilePath,
                                 OpenAttrToInt(OpenAttr),
                                 InitDatabaseSize,
                                 ExtensionQuantum,
                                 InitIndexSize,
                                 FileSizeLimit]), True);
  {$ENDIF}
  Result := __cli_create_replication_node(NodeID, ServerCount, @NodeNames[0], PChar(DatabaseName),
                         PChar(FilePath), OpenAttrToInt(OpenAttr),
                         InitDatabaseSize, ExtensionQuantum, InitIndexSize, FileSizeLimit);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [Result]), False);
  {$ENDIF}
end;

//---------------------------------------------------------------------------
function cli_set_error_handler(const session: Integer;
  NewHandler: TCliErrorHandler; const UserData: Pointer): TCliErrorHandler;
begin
  LoadDLL;
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_set_error_handler(%d, 0x%p)', [session, @NewHandler]), True);
  {$ENDIF}
  Result := __cli_set_error_handler(session, NewHandler, UserData);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('0x%p', [@Result]), False);
  {$ENDIF}
end;

//--------------------------------------------------------------
function cli_detach(session: Integer; DetachMode: TDetachModes): Integer;
begin
  Result := 0;
  if dtCommit         in DetachMode then Inc(Result, cli_commit_on_detach);
  if dtDestroyContext in DetachMode then Inc(Result, cli_destroy_context_on_detach);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_detach(%d, %d)', [session, Result]), True);
  {$ENDIF}
  Result := __cli_detach(session, Result);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [Result]), False);
  {$ENDIF}
  CliCheck(Result, 'cli_detach failed');
end;

//--------------------------------------------------------------
function CliCheck(Code: Integer; Msg: string=''): Integer;      // raises an exception in case of an error result
begin
  if Code < 0 then
    raise EFastDbError.Create(Code, Msg)
  else
    Result := Code;
end;

//--------------------------------------------------------------
function CliErrorToStr(Code: Integer): string;
begin
  if Code >= 0 then
    Result := ''
  else begin
    case Code of
      cli_bad_address                : Result := 'Invalid format of server URL';
      cli_connection_refused         : Result := 'Connection with server could not be established';
      cli_database_not_found         : Result := 'Database cannot be found';
      cli_bad_statement              : Result := 'Text of SQL statement is not correct';
      cli_parameter_not_found        : Result := 'Parameter was not found in statement';
      cli_unbound_parameter          : Result := 'Parameter was not specified';
      cli_column_not_found           : Result := 'No such colunm in the table';
      cli_incompatible_type          : Result := 'Conversion between application and database type is not possible';
      cli_network_error              : Result := 'Connection with server is broken';
      cli_runtime_error              : Result := 'Error during query execution';
      cli_bad_descriptor             : Result := 'Invalid statement/session description';
      cli_unsupported_type           : Result := 'Unsupported type for parameter or column';
      cli_not_found                  : Result := 'Record was not found';
      cli_not_update_mode            : Result := 'Attempt to update records selected by view only cursor';
      cli_table_not_found            : Result := 'There is no table with specified name in the database';
      cli_not_all_columns_specified  : Result := 'Insert statement doesn''t specify values for all table columns';
      cli_not_fetched                : Result := 'cli_fetch method was not called';
      cli_already_updated            : Result := 'cli_update method was invoked more than once for the same record';
      cli_table_already_exists       : Result := 'Attempt to create existing table';
      cli_not_implemented            : Result := 'Function is not implemented';
      //----- Severe Error Class Codes---------
      cli_query_error                : Result := 'Query error';
      cli_arithmetic_error           : Result := 'Arithmetic error';
      cli_index_out_of_range_error   : Result := 'Index out of range';
      cli_database_open_error        : Result := 'Database open error';
      cli_file_error                 : Result := 'File error';
      cli_out_of_memory_error        : Result := 'Out of memory';
      cli_deadlock                   : Result := 'Deadlock detected';
      cli_null_reference_error       : Result := 'Null reference';
      cli_lock_revoked               : Result := 'Lock revoked';
      cli_file_limit_exeeded         : Result := 'File limit exeeded';
      //----- Custom Error Codes---------------
      cli_error_loading_library      : Result := 'Error loading library';
      cli_session_not_assigned       : Result := 'Session not assigned or not connected';
      cli_database_already_open      : Result := 'Database already open';
      cli_invalid_field_size         : Result := 'Invalid field size';
      cli_empty_query                : Result := 'Query SQL text is not assigned';
      cli_item_already_defined       : Result := 'Field/Variable is already defined';
      cli_wrong_inverse_reference    : Result := 'Wrong inverse reference';
      cli_no_fields_defined          : Result := 'No fields defined';
      cli_access_violation           : Result := 'Access Violation';
    else
      Result := Format('Unknown code -%d', [Code]);
    end;
  end;
end;

initialization
  DLLHandle := 0;
  {$IFDEF CLI_DEBUG}
  DebugTrace := TDebugTrace.Create;
  TraceDebugProcedure := DebugTrace.DefaultTraceDebugProcedure;
  {$ENDIF}
  {$IFDEF CODESITE_DEBUG}
  CodeSite.Clear;
  {$ENDIF}

finalization
  {$IFDEF CLI_DEBUG}
  DebugTrace.Free;
  {$ENDIF}
  DLLExit;

end.



⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -