fastdbquery.pas

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

{-< FastDbQuery.pas >----------------------------------------------*
  FastDbQuery Version 1.0
    (c) 2002 Serge Aleynikov ([e-mail])
  Main Memory Database Management System
  Created:     11/11/2002 Serge Aleynikov ([e-mail])
  Last update:
    8/20/2003  Added TFastDbQuery.Variable() method
    8/19/2003  Added DeleteAllRecords()
    4/8/2003   Added additional debugging details for cli_insert
    1/22/2003  Added support for cli_attach and cli_detach
    12/06/2002 Serge Aleynikov

-------------------------------------------------------------------*
  Database Query component
-------------------------------------------------------------------*}
unit FastDbQuery;

{$I FastDbConfig.inc}

interface

uses
  SysUtils, Classes, Math, StrUtils, FastDbCLI, FastDbSession, FastDbVar
  {$IFDEF MSWINDOWS}
  , Windows
  {$ENDIF}
  {$IFDEF LINUX}
  , Libc
  {$ENDIF}
  ;

type
  TFastDbQuery = class;

  TOnDescribeFieldEvent = procedure(Sender: TFastDbField; var GetProc: TArrayFieldGetValue; var SetProc: TArrayFieldSetValue) of object;

  EFastDbQuery = class(Exception);

  TFastDbQuery = class(TComponent)
  private
    FVariables       : TFastDbVariables;
    FFieldList       : TFastDbFields;
    FSession         : TFastDbSession;
    FStatement       : Integer;
    FSQL             : string;
    FBof             : Boolean;
    FEof             : Boolean;
    FDebug           : Boolean;
    FRowCount        : LongWord;
    FRecNo           : LongWord;
    FBeforeQuery     : TNotifyEvent;      // Gets called on an Execute
    FAfterQuery      : TNotifyEvent;
    FOnDescribeField : TOnDescribeFieldEvent;
    FSqlChanged      : Boolean;
    FTableName       : string;
    FInsertQuery     : Boolean;
    FDescribed       : Boolean;
    FReadOnly        : Boolean;

    procedure SetSession(ASession: TFastDbSession);
    procedure SetSQL(Value: string);
    //procedure SetVariables(Value: TFastDbVariables);
    //procedure SetFields(const Value: TFastDbFields);
    function  GetTableName: string;
    //function  FindVariable(var AName: string): Integer;
    procedure FindVariables(var SQL: string; var Vars: TStringList);
    procedure ReplaceSubstVariables(var s: string);
    function  GetOID: TCliOid;
    procedure InternalDescribe;
    procedure InternalBindFields;
    procedure InternalBindVariables;
    procedure FreeStatement(const CheckError: Boolean=True);
    //function  ReplaceVariables(S: string): string;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    procedure Close;
    procedure Describe;
    function  IsOpen: Boolean;
    property  Handle: Integer read FStatement;
    property  ReadOnly: Boolean read FReadOnly;

    function  Execute(const AReadOnly: Boolean=True): LongWord; virtual;
    function  Insert(const IntoTableName: string=''): TCliOid;
    procedure Update;    // updates currently selected record.  Execute must be done qtForUpdate
    procedure Delete;    // deletes all selected records.       Execute must be done qtForUpdate
    procedure RefreshRecord;
    procedure Freeze;    // freezes the statement so that it is possible to issue a session.commit and to preserve the statement's state
    procedure UnFreeze;  // Unfreezes the statement frozen with Freeze

    property  SqlChanged: Boolean read FSqlChanged write FSqlChanged;  // set to True to force Describe before an Execute.

    procedure First;
    procedure Last;
    function  Next: Boolean;
    function  Prev: Boolean;
    procedure Skip(const Records: Integer; const RefreshOnNoSkip: Boolean=False);
    function  Seek(const AOid: TCliOID): Integer;   // returns new RecNo
    property  Eof: Boolean read FEof;
    property  Bof: Boolean read FBof;

    property  RowCount: LongWord read FRowCount;
    property  RecNo: LongWord    read FRecNo;
    property  OID: TCliOid read GetOID;
    function  RecordSize: Integer;

    function  Field(const FieldId: Integer): TFastDbField; overload;
    function  Field(const Field: string): TFastDbField;    overload;

    function  Variable(const Index: Integer): TFastDbVariable; overload;
    function  Variable(const Name: string):   TFastDbVariable; overload;

    function  FieldIndex(const Field: string): Integer;
    function  VariableIndex(AName: string): Integer;

    procedure Clear;
    procedure ClearVariables;

    function  SubstitutedSQL: string;
  published
    property SQL: string read FSQL write SetSQL;
    property Session: TFastDbSession read FSession write SetSession;
    property Debug: Boolean read FDebug write FDebug;

    property Fields:    TFastDbFields    read FFieldList{ write SetFields};
    property Variables: TFastDbVariables read FVariables{ write SetVariables};

    property TableName: string read GetTableName;

    property OnBeforeQuery: TNotifyEvent read FBeforeQuery write FBeforeQuery;
    property OnAfterQuery: TNotifyEvent read FAfterQuery write FAfterQuery;
    property OnDescribeField: TOnDescribeFieldEvent read FOnDescribeField write FOnDescribeField;
  end;

  // Detele all records from a table
  TCommitType = (ctNone, ctPreCommit, ctCommit);
  procedure DeleteAllRecords(ASession: TFastDbSession; const ATableName: string; const ACommit: TCommitType=ctNone);

implementation

const
  SFieldDoesntExist = 'Field %s does not exist';
  SVarDoesntExist   = 'Variable %s does not exist';

//---------------------------------------------------------------------------
procedure DeleteAllRecords(ASession: TFastDbSession; const ATableName: string; const ACommit: TCommitType);
begin
  with TFastDbQuery.Create(nil) do
  try
    Session := ASession;
    Sql     := 'select * from ' + ATableName;
    if Execute(False) > 0 then
      Delete;
  finally
    Free;
    case ACommit of
      ctPreCommit: ASession.Commit(False);
      ctCommit:    ASession.Commit(True);
    end;
  end;
end;

//---------------------------------------------------------------------------
// TFastDbQuery
//---------------------------------------------------------------------------
constructor TFastDbQuery.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSession   := nil;
  FStatement := FastDbUnilitializedHandle;
  FDebug     := False;
  FFieldList := TFastDbFields.Create(Self);
  FVariables := TFastDbVariables.Create(Self);
end;

//---------------------------------------------------------------------------
destructor TFastDbQuery.Destroy;
begin
  Close;
  FFieldList.Free;
  FVariables.Free;
  inherited;
end;


//---------------------------------------------------------------------------
procedure TFastDbQuery.Clear;
begin
  Close;
  FVariables.Clear;
  FFieldList.Clear;
  FSql := '';
  FSqlChanged := True;
  FTableName  := '';
end;

//---------------------------------------------------------------------------
procedure TFastDbQuery.ClearVariables;
begin
  FVariables.Clear;
end;

//---------------------------------------------------------------------------
procedure TFastDbQuery.FindVariables(var SQL: string; var Vars: TStringList);
begin
  FastDbSession.FindVariables(SQL, False, Vars);
end;

//---------------------------------------------------------------------------
// Replace substitution variables
{
function TFastDbQuery.ReplaceVariables(S: string): string;
begin
var Vars: TStringList;
    i, n, p: Integer;
    Value: string;
begin
  Vars := TStringList.Create;
  try
    FindVariables(S, Vars);
    for i := Vars.Count - 1 downto 0 do begin
      n := FindVariable(Vars[i]);
      if n >= 0 then
        Value := Copy(FVariables[i], Length(Vars[i]) + 2, Length(FVariables[i]));
      else
        Value := '';
      p := Integer(Vars.Objects[i]);
      Delete(S, p, Length(Vars[i]) + 1);
      if (Length(S) > p) and (S[p] = '.') then Delete(S, p, 1);
      Insert(Value, S, p); *)
    end;
    Result := S;
  finally
    Vars.Free;
  end;
end;}

//---------------------------------------------------------------------------
// Replace substitution variables by the actual values
procedure TFastDbQuery.ReplaceSubstVariables(var s: string);
var vi, sv{, vp}: Integer;
//    ss: string;
    Ready: Boolean;
    VarList: TStringList;
    VarName: string;
begin
  // First check if there are any substitution variables
  Ready := True;
  for vi := 0 to Variables.Count - 1 do
    if Variables[vi].FieldType = ctSubst then Ready := False;
  // If so, replace them with the values
  if not Ready then
  begin
    VarList := TStringList.Create;
    try
      FindVariables(s, VarList);
      for sv := VarList.Count-1 downto 0 do begin
        VarName := VarList[sv];
        vi := VariableIndex(VarName);
        if (vi >= 0) and (Variables[vi].FieldType = ctSubst) then
          begin
            (*vv := GetVariable(VarName);
            !!!!!!!!!!!
            if VarIsNull(vv) or VarIsEmpty(vv) then ss := '' else ss := vv;
            vp := Integer(VarList.Objects[sv]);
            Delete(s, vp, Length(VarName) + 1);
            Insert(ss, s, vp);*)
          end;
      end;
    finally
      VarList.Free;
    end;
  end;
end;

//---------------------------------------------------------------------------
// Return the SQL with substitution variables substituted
function TFastDbQuery.SubstitutedSQL: string;
var i : Integer;
begin
  Result := FSql; //FSql.Text;
  for i:=Length(Result) downto 1 do
    if Result[i] in [#10,#13] then
      System.Delete(Result, i, 1);
  ReplaceSubstVariables(Result);
end;

//---------------------------------------------------------------------------
procedure TFastDbQuery.Close;
begin
  FreeStatement(True);
end;

//---------------------------------------------------------------------------
procedure TFastDbQuery.Describe;
var
  s : string;
begin
  if FDescribed then exit;

  if FSession = nil then
    raise EFastDbError.Create(cli_session_not_assigned)
  else if Trim(FSQL) = '' then
    raise EFastDbError.Create(cli_empty_query);

  FreeStatement(False);

  if FFieldList.Count = 0 then
    InternalDescribe;

  s := SubstitutedSQL;
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_statement(%d, "%s")', [FSession.Handle, s]), True);
  {$ENDIF}
  FStatement := cli_statement(FSession.Handle, PChar(s));
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [FStatement]), False);
  {$ENDIF}
  FSession.CliCheck(FStatement, 'cli_statement failed');

  InternalBindFields;
  InternalBindVariables;

  FDescribed := True;
end;

//---------------------------------------------------------------------------
function TFastDbQuery.Execute(const AReadOnly: Boolean=True): LongWord;
var QueryType: Integer;
begin
  if not AReadOnly and not (oaReadWrite in FSession.OpenAttributes) then
    raise EFastDbQuery.Create('Cannot execute a writable query in a read-only session!');

  // For threaded access attach this thread to the database
  if FSession.Threaded then
    FSession.Attach;

  Describe;

  FReadOnly := AReadOnly;
  if AReadOnly then QueryType := 0 else QueryType := 1;

  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_fetch(%d, %d)', [FStatement, QueryType]), True);
  {$ENDIF}
  FRowCount := cli_fetch(FStatement, QueryType);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [FRowCount]), False);
  {$ENDIF}
  FRowCount := FSession.CliCheck(FRowCount, 'cli_fetch failed');

  FRecNo    := 0;
  FEof   := FRowCount <= 0;
  Result := FRowCount;
  if not FEof then
    First
  else
    FBof := False;
end;

//---------------------------------------------------------------------------
procedure TFastDbQuery.RefreshRecord;
var rc : Integer;
begin
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_skip(%d, 0)', [FStatement, 0]), True);
  {$ENDIF}
  rc := cli_skip(FStatement, 0);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [rc]), False);
  {$ENDIF}
  FSession.CliCheck(rc);
end;

//---------------------------------------------------------------------------
function TFastDbQuery.Insert(const IntoTableName: string=''): TCliOid;
var
  rc : Integer;
  {$IFDEF CLI_DEBUG}
  i : Integer;
  {$ENDIF}
  s : string;

  function ParamStr: string;
  var
    i, nLen1 : Integer;
    s1 : string;
  begin
    nLen1 := 0;
    Result := '';
    for i:=0 to Fields.Count-1 do
      nLen1 := Max(nLen1, Length(Fields[i].name));
    for i:=0 to Fields.Count-1 do begin
      if IsArrayType(Fields[i].FieldType) then
        if Fields[i].ArraySize = 0 then
          s1 := '[]'
        else
          s1 := Format('[...] (Length=%d)', [Fields[i].ArraySize])
      else if Fields[i].FieldType = ctString then
        s1 := '"'+ Fields[i].asString +'"'
      else if Fields[i].FieldType = ctOID then
        s1 := Format('(0x%x)', [Fields[i].asOID])
      else
        s1 := Fields[i].asString;
      Result := Result + Format('%*s%s%*s= %s'#10,    [8, ' ', Fields[i].name, nLen1+1-Length(Fields[i].name), ' ', s1]);
    end;
  end;
begin
  if (IntoTableName <> '') then
    begin
      s := 'insert into ' + IntoTableName;
      if not SameText(FSql, s) then
        FSql := s;
    end;

  Describe;

  // For threaded access attach this thread to the database
  if FSession.Threaded then
    FSession.Attach;

  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_insert(%d, @oid)'#10, [FStatement])+ParamStr, True);
  {$ENDIF}

  try
    rc := cli_insert(FStatement, @Result);
  except
    on e: Exception do
      raise EFastDbError.Create(cli_access_violation, ' cli_insert failed!'#10+ParamStr+#10+e.message);
  end;
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d (oid=0x%x)', [rc, Result]), False);
  {$ENDIF}

  FSession.CliCheck(rc, 'cli_insert failed');

  if FSession.Threaded then
    FSession.Detach;
  //Inc(FRecNo);
end;

//---------------------------------------------------------------------------
procedure TFastDbQuery.InternalDescribe;