fastdbsession.pas

俄国人写的内存数据库的delphi封装

  {$IFDEF CLI_DEBUG}
  s1 := Format('cli_create_table(%d, "%s", %d, {'#10, [FHandle, s, Length(Fields)]) +
        DumpFields(Fields, 4);
  TraceDebugProcedure(s1, True);
  {$ENDIF}
  FLastErrorCode := cli_create_table(FHandle, s, Length(Fields), @Fields[0]);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [FLastErrorCode]), False);
  {$ENDIF}
  if (FLastErrorCode = cli_ok) or (FLastErrorCode = cli_table_not_found) then
    Result := True
  else if bHasReferences and (FLastErrorCode = cli_table_not_found) then
    // This is a special case when an inverse reference is declared and no table being referenced is
    // yet defined.  This is not considered an error.
    Result := True
  else if (FLastErrorCode = cli_table_already_exists) {or (FLastErrorCode = cli_not_implemented)} then
    Result := False
  else
    raise EFastDbError.Create(FLastErrorCode, 'cli_create_table failed');
end;

//---------------------------------------------------------------------------
function TFastDbSession.CreateTable(const Table: string; const Fields: TFastDbFields; RefCheck: Boolean=False): Boolean;
var
  fld : TFieldDescriptors;
  i : Integer;
begin
  if Fields.Count = 0 then
    raise EFastDbError.Create(cli_no_fields_defined, 'Fields parameter has no elements!');

  SetLength(fld, Fields.Count);
  try
    for i:=0 to High(fld) do
      fld[i] := FastDbFieldToFieldDescriptor(Fields[i]);
    Result := CreateTable(Table, fld, RefCheck);
  finally
    SetLength(fld, 0);
  end;
end;

//---------------------------------------------------------------------------
function TFastDbSession.AlterTable(const Table: string; var Fields: TFieldDescriptors): Boolean;
  {$IFDEF CLI_DEBUG}
var
  s : string;
  {$ENDIF}
begin
  CheckHandle;

  {$IFDEF CLI_DEBUG}
  s := Format('cli_alter_table(%d, "%s", %d, {'#10, [FHandle, Table, Length(Fields)]) + DumpFields(Fields, 4);
  TraceDebugProcedure(s, True);
  {$ENDIF}
  FLastErrorCode := cli_alter_table(FHandle, PChar(Table), Length(Fields), @Fields[0]);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [FLastErrorCode]), False);
  {$ENDIF}
  if (FLastErrorCode = cli_ok) then
    Result := True
  else
    raise EFastDbError.Create(FLastErrorCode, 'cli_create_table failed');
end;

//---------------------------------------------------------------------------
function TFastDbSession.AlterTable(const Table: string; const Fields: TFastDbFields): Boolean;
var
  fld : TFieldDescriptors;
  i : Integer;
begin
  if Fields.Count = 0 then
    raise EFastDbError.Create(cli_no_fields_defined, 'Fields parameter has no elements!');

  SetLength(fld, Fields.Count);
  try
    for i:=0 to High(fld) do
      fld[i] := FastDbFieldToFieldDescriptor(Fields[i]);
    Result := AlterTable(Table, fld);
  finally
    SetLength(fld, 0);
  end;
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.DropTable(Table: string);
var rc : Integer;
begin
  CheckHandle;
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_drop_table(%d, "%s")', [FHandle, Table]), True);
  {$ENDIF}
  rc := cli_drop_table(FHandle, PChar(Table));
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [rc]), False);
  {$ENDIF}
  CliCheck(rc, 'cli_drop_table failed');
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.AlterIndex(const Table, Field: string;
  const NewFlags: TIndexTypes);
var
  rc,n : Integer;
begin
  CheckHandle;
  n := IndexTypesToFieldFlags(NewFlags);

  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_alter_index(%d, "%s", "%s", %d)', [FHandle, Table, Field, n]), True);
  {$ENDIF}
  rc := cli_alter_index(FHandle, PChar(Table), PChar(Field), n);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [rc]), False);
  {$ENDIF}
  CliCheck(rc, 'cli_alter_index failed');
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.Attach;
var
  rc: Integer;
{  i : Integer;
  bFound : Boolean;
  p : PContextEntry;
  nThreadID : DWord;}
begin
  {nThreadID := GetCurrentThreadID;

  if nThreadID = ThreadID then
    raise EFastDbError.CreateFmt(SMultiThreadedAttach, ['Attach']);

  with FContextList.LockList do
  try
    bFound := False;
    if FThreaded then
      for i:=0 to Count-1 do
        with PContextEntry(Items[i])^ do
          if ThreadID = nThreadID then
            begin
              Inc(RefCount);
              bFound := True;
              break;
            end;

    if not bFound then
      begin
        if FThreaded then
          begin
            New(p);
            p^.ThreadID := nThreadID;
            p^.RefCount := 1;
            Add(p);
          end;
   }
        {$IFDEF CLI_DEBUG}
        TraceDebugProcedure(Format('cli_attach(%d)', [FHandle]), True);
        {$ENDIF}
        rc := cli_attach(FHandle);
        {$IFDEF CLI_DEBUG}
        TraceDebugProcedure(Format('%d', [rc]), False);
        {$ENDIF}
        CliCheck(rc, 'cli_attach failed');
  {    end;
  finally
    FContextList.UnlockList;
  end;}
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.Detach(ADetachMode: TDetachModes);
//var
  //i  : Integer;
  //bDoDetach : Boolean;
  //nThreadID: DWord;
begin
  {nThreadID := GetCurrentThreadID;

  if nThreadID = ThreadID then
    raise EFastDbError.CreateFmt(SMultiThreadedAttach, ['Detach']);

  with FContextList.LockList do
  try
    nDisconnectMode := 0; // cli_commit_on_detach;  <-- This one does hard commit, 0 does precommit;
    bDoDetach := not FThreaded;

    if FThreaded then
      for i:=0 to Count-1 do
        with PContextEntry(Items[i])^ do
          if ThreadID = nThreadID then
            begin
              Dec(RefCount);
              if RefCount <= 0 then
                begin
                  Dispose(PContextEntry(Items[i]));
                  Delete(i);
                  nDisconnectMode := cli_destroy_context_on_detach or nDisconnectMode;
                  bDoDetach := True;
                end;
              break;
            end;

    if bDoDetach then
      begin}
        cli_detach(FHandle, ADetachMode);
{      end;
  finally
    FContextList.UnlockList;
  end;}
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.CheckHandle;
begin
  if FHandle = -1 then
    raise EFastDbError.Create(cli_session_not_assigned);
end;

//---------------------------------------------------------------------------
function TFastDbSession.ExtractTableDDL(const TableName: string): string;
const
  IDX_STR = 'create %s on %s.%s;'#10;
var
  Fields: TFieldDescriptors;
  i,n,nLen : Integer;
  it : TIndexTypes;
begin
  SetLength(Result, 20*1048);
  SetLength(Fields, 100);
  n := DescribeTable(TableName, Fields);
  Result := 'create table '+TableName + '('#10;
  nLen := 0;
  for i:=0 to n-1 do
    nLen := Max(nLen, Length(Fields[i].name));
  for i:=0 to n-1 do begin
    Result := Result + Format('%*s%-*s %s%s%s'#10,
                                [10, ' ', nLen, Fields[i].name,
                                 CliVarTypeAsStr(OrdToCliType(Fields[i].FieldType), True),
                                 iif(Fields[i].refTableName <> '', ' to '+Fields[i].refTableName, ''),
                                 iif(i=(n-1), '', ',')]);
  end;
  Result := Result + ');'#10;
  for i:=0 to n-1 do begin
    it := FieldFlagsToIndexTypes(Fields[i].flags);
    if itHash in it then Result := Result + Format(IDX_STR, ['hash',  TableName, Fields[i].name]);
    if itTree in it then Result := Result + Format(IDX_STR, ['index', TableName, Fields[i].name]);
  end;
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.SaveDDLtoFile(FileName: string);
var
  str : TStringList;
  s   : string;
  i   : Integer;
begin
  with TFileStream.Create(FileName, fmCreate) do
  try
    str := TStringList.Create;
    try
      ListTables(str);
      s := Format('open ''%s'';'#10, [FDatabase]);
      Write(s[1], Length(s));
      for i:=0 to str.Count-1 do begin
        s := ExtractTableDDL(str[i]);
        Write(s[1], Length(s));
      end;
      s := 'commit;'#10;
      Write(s[1], Length(s));
      s := 'exit;'#10;
      Write(s[1], Length(s));
    finally
      str.Free;
    end;
  finally
    Free;
  end;
end;

//---------------------------------------------------------------------------
function TFastDbSession.GetDatabaseState: TCliDatabaseMonitor;
var rc : Integer;
begin
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_get_database_state', [FHandle]), True);
  {$ENDIF}
  rc := cli_get_database_state(FHandle, @Result);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [rc]), False);
  {$ENDIF}
  CliCheck(rc, 'cli_get_database_state failed');
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.SetOnTraceEvent(const Value: TDbTraceEvent);
begin
  FOnTraceEvent := Value;
  if FHandle <> -1 then
    begin
      {$IFDEF CLI_DEBUG}
      TraceDebugProcedure(Format('cli_set_trace_function', [FHandle]), True);
      {$ENDIF}
      if Assigned(Value) then
        cli_set_trace_function(@FTraceHandlerThunk)
      else
        cli_set_trace_function(nil);
      {$IFDEF CLI_DEBUG}
      TraceDebugProcedure(Format('%d', [cli_ok]), False);
      {$ENDIF}
    end;
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.SessionTraceHandler(Msg: PChar);
begin
  if Assigned(FOnTraceEvent) then
    FOnTraceEvent(Self, string(Msg));
end;

{$IFDEF GIGABASE}
//---------------------------------------------------------------------------
procedure TFastDbSession.ClearConnectionPool;
var rc : Integer;
begin
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_clear_connection_pool', [FHandle]), True);
  {$ENDIF}
  rc := cli_clear_connection_pool;
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [rc]), False);
  {$ENDIF}
  CliCheck(rc, 'cli_clear_connection_pool failed');
end;
{$ENDIF}

end.