fastdbsession.pas

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

      FNodeID := ANodeID;
      FNodeNames := ANodeNames;
      FTransactionCommitDelay := 0;   // TransactionCommitDelay is not supported in the replicated database
      FReplicationSupport := True;

      InternalOpenDatabase(True);
    end;
end;

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

//---------------------------------------------------------------------------
function TFastDbSession.ServerVersion: string;
begin
  Result := FastDbCli.Version;
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.SetAutoCommit(const Value: Boolean);
begin
  if FAutoCommit <> Value then
    FAutoCommit := Value;
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.SetConnected(const Value: Boolean);
begin
  if Connected <> Value then
    if Value then
      InternalOpenDatabase(True)
    else
      CloseDatabase;
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.SetDatabase(const Value: string);
begin
  if FDatabase <> Value then
    FDatabase := Value;
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.SetPort(const Value: Integer);
begin
  if FPort <> Value then
    FPort := Value;
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.SetLogonPassword(const Value: string);
begin
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.SetLogonUsername(const Value: string);
begin
end;

//---------------------------------------------------------------------------
function TFastDbSession.GetConnected: Boolean;
begin
  Result := FHandle > FastDbUnilitializedHandle;
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.SetDatabasePath(const Value: string);
begin
  if FDatabasePath <> Value then
    FDatabasePath := Value;
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.SetHost(const Value: string);
begin
  if FHost <> Value then
    FHost := Value;
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.SetTransactionCommitDelay(const Value: Integer);
begin
  if FTransactionCommitDelay <> Value then
    FTransactionCommitDelay := Value;
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.SetMaxConnectRetries(const Value: Integer);
begin
  if FMaxConnectRetries <> Value then
    FMaxConnectRetries := Value;
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.SetReconnectTimeout(const Value: Integer);
begin
  if FReconnectTimeout <> Value then
    FReconnectTimeout := Value;
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.SetInitDatabaseSize(const Value: Integer);
begin
  if FInitDatabaseSize <> Value then
    FInitDatabaseSize := Value;
end;

//---------------------------------------------------------------------------
procedure TFastDbSession.ListTables(List: TStringList);
var
  i, n : Integer;
  tbl, tables: PCliTableDescriptor;
  {$IFDEF CLI_DEBUG}
  s : string;
  {$ENDIF}
begin
  List.Clear;
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_show_tables(%d, &tables)', [FHandle]), True);
  s := '';
  {$ENDIF}
  n := cli_show_tables(FHandle, tables);
  try
    CliCheck(n, 'cli_show_tables failed');
    tbl := tables;
    for i:=0 to n-1 do begin
      List.Add(tbl^.name);
      {$IFDEF CLI_DEBUG}
      s := s + Format(',"%s"', [tbl^.name]);
      {$ENDIF}
      Inc(tbl);
    end;
  finally
    if n > 0 then
      cli_free_memory(FHandle, tables);
  end;
  {$IFDEF CLI_DEBUG}
  if s <> '' then Delete(s, 1, 1);
  TraceDebugProcedure(Format('%d tables=0x%p (%s)', [n, tables, s]), False);
  {$ENDIF}
end;

//---------------------------------------------------------------------------
function TFastDbSession.TableExists(const Table: string): Boolean;
var
  str : TStringList;
begin
  str := TStringList.Create;
  try
    ListTables(str);
    Result := str.IndexOf(Table) <> -1;
  finally
    str.Free;
  end;
end;

//---------------------------------------------------------------------------
function TFastDbSession.DumpFields(const Fields: TFieldDescriptors;
  const LeftOffset: Integer): string;
var
  m, n, k, nLen1, nLen2, nLen3 : Integer;
  s2, s3: string;
  function NullQQ(str: string): string;
  begin
    if str='' then Result := 'NULL' else Result := '"'+str+'"';
  end;

  function NilLen(s: PChar; Default: Integer): Integer;
  begin
    if s = nil then
      Result := Default
    else
      Result := strlen(s)+2;
  end;
begin
  Result := '';
  if (Fields = nil) then exit;
  nLen1 := 0;
  nLen2 := 0;
  nLen3 := 0;
  for n:=0 to High(Fields) do begin
    nLen1 := Max(nLen1, Length(CliVarTypeAsStr(OrdToCliType(Fields[n].FieldType))));
    nLen2 := Max(nLen2, NilLen(Fields[n].name,4));
    nLen3 := Max(nLen3, NilLen(Fields[n].refTableName,4));
  end;
  for n:=0 to High(Fields) do begin
    s3 := NullQQ(Fields[n].inverseRefFieldName);
    s2 := NullQQ(Fields[n].refTableName);
    m := Max(0, NilLen(Fields[n].name,4));
    k := Max(0, NilLen(Fields[n].refTableName,4));
    Result := Result +
            Format('%*s{%-2d/*%s*/%*s %d,"%s"%*s%s%*s%s}%s', [
                     LeftOffset, ' ',
                     Fields[n].FieldType, CliVarTypeAsStr(OrdToCliType(Fields[n].FieldType)),
                     nLen1+1-Length(CliVarTypeAsStr(OrdToCliType(Fields[n].FieldType))), ',',
                     Fields[n].flags,
                     Fields[n].name, nLen2+1-m, ',',
                     s2, nLen3+1-k, ',',
                     s3,
                     ifthen(n=High(Fields), '})', #10)
                   ]);
  end;
end;

//---------------------------------------------------------------------------
function TFastDbSession.DescribeTable(const Table: string; var Fields: TFieldDescriptors;
  RaiseError: Boolean=True): Integer;
var
  p : PCliFieldDescriptor;
{$IFDEF CLI_DEBUG}
  s : string;
{$ENDIF}
begin
  CheckHandle;
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_describe(%d, "%s", [...])', [FHandle, Table]), True);
  {$ENDIF}

  Result := cli_describe(FHandle, PChar(Table), @p);

  if RaiseError then
    CliCheck(Result, 'cli_describe failed');
  if Result > 0 then
    try
      SetLength(Fields, Result);
      Move(p^, Fields[0], Result*SizeOf(TCliFieldDescriptor));
      {$IFDEF CLI_DEBUG}
      s := #10+DumpFields(Fields, 4);
      {$ENDIF}
    finally
      cli_free_memory(FHandle, p);
    end
  else
    begin
      //SetLength(Fields, 0);
      {$IFDEF CLI_DEBUG}
      s := '';
      {$ENDIF}
    end;

  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d %s', [Result, s]), False);
  {$ENDIF}
end;

//---------------------------------------------------------------------------
function TFastDbSession.DescribeTable(const Table: string; Fields: TFastDbFields;
  RaiseError: Boolean=True): Integer;
var
  flds : TFieldDescriptors;
  i    : Integer;
begin
  Result := DescribeTable(Table, flds, RaiseError);
  try
    Fields.Clear;
    for i:=0 to Result-1 do begin
      Fields.Add(string(flds[i].name),
                 OrdToCliType(flds[i].FieldType),
                 FieldFlagsToIndexTypes(flds[i].flags),
                 string(flds[i].refTableName),
                 string(flds[i].inverseRefFieldName));
    end;
  finally
    if Result > 0 then
      SetLength(flds, 0);
  end;
end;

//---------------------------------------------------------------------------
function TFastDbSession.CreateTable(const Table: string;
  var Fields: TFieldDescriptors; RefCheck: Boolean=False): Boolean;
var
  n,m : Integer;
  s : PChar;
  bHasReferences : Boolean;
  flds: TFieldDescriptors;
  bOk : Boolean;
  {$IFDEF CLI_DEBUG}
  s1 : string;
  {$ENDIF}
begin
  CheckHandle;

  s := PChar(Table);
  bHasReferences := False;

  // The following check is performed to ensure that inverseRefFieldNames for
  // non-existing tables are NULL'ed.  This is a FastDB requirement.
  flds := nil;
  try
    for n:=0 to High(Fields) do
      if Fields[n].refTableName <> '' then
        begin
          bHasReferences := True;
          if Fields[n].inverseRefFieldName <> '' then begin
            if RefCheck and (DescribeTable(Fields[n].refTableName, flds, False) > 0) then
              begin
                bOk := False;
                for m:=0 to High(flds) do
                  if SameText(flds[m].name, Fields[n].inverseRefFieldName) then
                    begin
                      bOk := SameText(flds[m].refTableName, Table) and
                             SameText(flds[m].inverseRefFieldName, Fields[n].name);
                      if not bOk then
                        raise EFastDbError.Create(cli_wrong_inverse_reference,
                                                  Format('%s.%s[%s.%s] <-mismatch-> %s.%s[%s.%s]', [
                                                     Table, Fields[n].name,
                                                         Fields[n].refTableName, Fields[n].inverseRefFieldName,
                                                     Fields[n].refTableName, flds[m].name,
                                                         flds[m].refTableName, flds[m].inverseRefFieldName
                                                  ]));
                      break;
                    end;
                if not bOk then
                  raise EFastDbError.Create(cli_wrong_inverse_reference,
                                                  Format('%0:s.%1:s[%2:s.%3:s] inverse reference not found in %2:s.%3:s', [
                                                     Table, Fields[n].name,
                                                         Fields[n].refTableName, Fields[n].inverseRefFieldName
                                                  ]));
              end;
          end;
        end;
  finally
    flds := nil;
  end;