fastdbquery.pas

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

var
  flds: TFieldDescriptors;
  i,nFields : Integer;
  FieldData : TFastDbField;
  GetProc: TArrayFieldGetValue;
  SetProc: TArrayFieldSetValue;
begin
  FFieldList.Clear;

  nFields := FSession.DescribeTable(GetTableName, flds);
  try
    for i:=0 to nFields-1 do begin // Build the FieldList
      FieldData := TFastDbField.Create(FFieldList);
      with FieldData do begin
        Name := string(flds[i].name);
        FieldType  := TCliVarType(flds[i].FieldType);
        FieldFlags := flds[i].flags;
        RefTable   := string(flds[i].refTableName);
        InverseRefField := string(flds[i].inverseRefFieldName);

        if Assigned(FOnDescribeField) then
          begin
            FOnDescribeField(FieldData, GetProc, SetProc);
            OnArrayGetValue := GetProc;
            OnArraySetValue := SetProc;
          end;
      end;
    end;
  finally
    SetLength(flds, 0);
  end;
end;

//---------------------------------------------------------------------------
procedure TFastDbQuery.FreeStatement(const CheckError: Boolean);
var rc : Integer;
begin
  if FStatement > FastDbUnilitializedHandle then
    begin
      // For threaded access detach this thread from the database
      if FSession.Threaded then
        FSession.Detach;

      {$IFDEF CLI_DEBUG}
      TraceDebugProcedure(Format('cli_free(%d)', [FStatement]), True);
      {$ENDIF}
      rc := cli_free(FStatement);
      {$IFDEF CLI_DEBUG}
      TraceDebugProcedure(Format('%d', [rc]), False);
      {$ENDIF}
      if CheckError then
        FSession.CliCheck(rc, 'cli_free failed');

      Fields.UnBindFromStatement;
      Variables.UnBindFromStatement;
      FStatement := FastDbUnilitializedHandle;
      FDescribed := False;
    end;
end;

//---------------------------------------------------------------------------
procedure TFastDbQuery.InternalBindFields;
var i: Integer;
begin
  for i:=0 to FFieldList.Count-1 do
    FFieldList[i].BindToStatement(FStatement);
end;

//---------------------------------------------------------------------------
procedure TFastDbQuery.InternalBindVariables;
var i: Integer;
begin
  for i:=0 to FVariables.Count-1 do
    FVariables[i].BindToStatement(FStatement);
end;

//---------------------------------------------------------------------------
function TFastDbQuery.Next: Boolean;
var n : Integer;
begin
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_get_next(%d)', [FStatement]), True);
  {$ENDIF}
  n := cli_get_next(FStatement);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [n]), False);
  {$ENDIF}
  FEof := n <> cli_ok;
  FBof := False;
  Result := not FEof;
  if Result then
    Inc(FRecNo);
end;

//---------------------------------------------------------------------------
procedure TFastDbQuery.SetSession(ASession: TFastDbSession);
begin
  FSession := ASession;
end;

//---------------------------------------------------------------------------
procedure TFastDbQuery.SetSQL(Value: string);
begin
  if Value <> FSql then
    begin
      FSql := Trim(Value);
      FDescribed := False;
      FSqlChanged := True;
    end;
end;

//---------------------------------------------------------------------------
{procedure TFastDbQuery.SetVariables(Value: TFastDbVariables);
begin
  FVariables.Assign(Value);
end;

//---------------------------------------------------------------------------
procedure TFastDbQuery.SetFields(const Value: TFastDbFields);
begin
  FFieldList.Assign(Value);
end;
}
//---------------------------------------------------------------------------
function TFastDbQuery.VariableIndex(AName: string): Integer;
var i: Integer;
begin
  for i:=0 to FVariables.Count-1 do
    // Note: StrIComp() works much faster than SameText()
    if StrIComp(PChar(TFastDbVariable(FVariables[i]).Name), PChar(AName)) = 0 then
      begin
        Result := i;
        exit;
      end;
  Result := -1;
end;

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

//---------------------------------------------------------------------------
procedure TFastDbQuery.Last;
var rc : Integer;
begin
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_get_last(%d)', [FStatement]), True);
  {$ENDIF}
  rc := cli_get_last(FStatement);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [rc]), False);
  {$ENDIF}
  FSession.CliCheck(rc, 'cli_get_last failed');
  FBof := False;
  FEof := True;
  FRecNo := FRowCount;
end;

//---------------------------------------------------------------------------
function TFastDbQuery.GetOID: TCliOid;
begin
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_get_oid(%d)', [FStatement]), True);
  {$ENDIF}
  Result := cli_get_oid(FStatement);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [Result]), False);
  {$ENDIF}
end;

//---------------------------------------------------------------------------
function TFastDbQuery.Prev: Boolean;
var rc : Integer;
begin
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_get_prev(%d)', [FStatement]), True);
  {$ENDIF}
  rc := cli_get_prev(FStatement);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [rc]), False);
  {$ENDIF}
  FBof := rc <> cli_ok;
  FEof := False;
  Result := not FBof;
  if Result then
    Dec(FRecNo);
end;

//---------------------------------------------------------------------------
function TFastDbQuery.Seek(const AOid: TCliOID): Integer;   // returns new RecNo
begin
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_seek(%d)', [FStatement]), True);
  {$ENDIF}
  FRecNo := cli_seek(FStatement, AOid);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [FRecNo]), False);
  {$ENDIF}
  Result := FSession.CliCheck(FRecNo, 'cli_seek failed');
end;

//---------------------------------------------------------------------------
procedure TFastDbQuery.Skip(const Records: Integer; const RefreshOnNoSkip: Boolean=False);
var n : Integer;
begin
  if (Records = 0) and not RefreshOnNoSkip then exit;

  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_skip(%d, %d)', [FStatement, Records]), True);
  {$ENDIF}
  n := cli_skip(FStatement, Records);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [n]), False);
  {$ENDIF}
  if n = cli_not_found then
    if Records >= 0 then
      begin
        FEof := True;
        FBof := False;
        FRecNo := FRowCount;
      end
    else
      begin
        FBof := True;
        FEof := False;
        FRecNo := 0;
      end
  else  // raise error if n <> cli_ok
    begin
      FSession.CliCheck(n, 'cli_skip failed');
      Inc(FRecNo, Records);
    end;
end;

//---------------------------------------------------------------------------
function TFastDbQuery.FieldIndex(const Field: string): Integer;
var i: Integer;
begin
  for i := 0 to FFieldList.Count - 1 do
    if StrIComp(PChar(Field), PChar(FFieldList[i].Name)) = 0 then
      begin
        Result := i;
        Exit;
      end;
  Result := -1;
end;

//---------------------------------------------------------------------------
procedure TFastDbQuery.Delete;
var rc : Integer;
begin
  // For threaded access attach this thread to the database
  if FSession.Threaded then
    FSession.Attach;

  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_remove(%d)', [FStatement]), True);
  {$ENDIF}
  rc := cli_remove(FStatement);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [rc]), False);
  {$ENDIF}

  if FSession.Threaded then
    FSession.Detach;

  FSession.CliCheck(rc, 'cli_remove failed');
  FRecNo := 0;
end;

//---------------------------------------------------------------------------
procedure TFastDbQuery.Update;
var rc : Integer;
begin
  // For threaded access attach this thread to the database
  if FSession.Threaded then
    FSession.Attach;

  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('cli_update(%d)', [FStatement]), True);
  {$ENDIF}
  rc := cli_update(FStatement);
  {$IFDEF CLI_DEBUG}
  TraceDebugProcedure(Format('%d', [rc]), False);
  {$ENDIF}

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

  if FSession.Threaded then
    FSession.Detach;
end;

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

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

//---------------------------------------------------------------------------
// Determine the name of the updating table, used by DML statements
function TFastDbQuery.GetTableName: string;
var s, s1: string;
    i, From: Integer;
    InlineQuery: Boolean;
    {$IFNDEF VER160}
    function PosEx(subStr, str: string; position: Integer): integer;
    begin
      Result := Pos(subStr, Copy(str, position, MaxInt));
      if (Result > 0) and (position > 0) then
        Inc(Result, position-1);
    end;
    {$ENDIF}
begin
  // Was it already determined?
  if not FSqlChanged then
    begin
      Result := FTableName;
      Exit;
    end
  else
    Result := '';

  if FSql = '' then Exit;

  // The tablename is the first identifier after FROM
  s  := RemoveSQLComment(SubstitutedSQL);
  s1 := AnsiLowerCase(s);
  for i := 1 to Length(s) do if not (s[i] in Identifiers + ['(']) then s[i] := ' ';
  i := 1;
  repeat
    From := PosEx(' from ', s1, i);
    if From = 0 then From := PosEx(' from(', s1, i);
    if From = 0 then From := PosEx(' into ', s1, i);
    if From = 0 then Exit;
    FInsertQuery := SameText('insert', Copy(s1, i, 6));
    Inc(From, 5);
    while (From <= Length(s)) and (s[From] = ' ') do Inc(From);
    i := From;
    InlineQuery := (i <= Length(s)) and (s[i] = '(');
    if not InlineQuery then
      begin
        while (i <= Length(s)) and (s[i] in Identifiers) do Inc(i);
        s := Copy(s, From, i - From);
      end;
  until not InlineQuery;

  // Remove quotes and convert to lower case
  Result := StringReplace(s, '"', '', []);
  FTableName := Result;
end;

//---------------------------------------------------------------------------
function TFastDbQuery.Field(const FieldId: Integer): TFastDbField;
begin
  if (FieldId < 0) or (FieldId > FFieldList.Count - 1) then
    raise EFastDbQuery.Create(Format(SFieldDoesntExist, [IntToStr(FieldId)]))
  else
    Result := FFieldList[FieldId];
end;

//---------------------------------------------------------------------------
function TFastDbQuery.Field(const Field: string): TFastDbField;
var i: Integer;
begin
  i := FieldIndex(Field);
  if i = -1 then
    raise EFastDbQuery.Create(Format(SFieldDoesntExist, [Field]))
  else
    Result := FFieldList[i];
end;

//---------------------------------------------------------------------------
function TFastDbQuery.Variable(const Index: Integer): TFastDbVariable;
begin
  if (Index < 0) or (Index > FVariables.Count - 1) then
    raise EFastDbQuery.Create(Format(SVarDoesntExist, [IntToStr(Index)]))
  else
    Result := FVariables[Index];
end;

//---------------------------------------------------------------------------
function TFastDbQuery.Variable(const Name: string): TFastDbVariable;
var i: Integer;
begin
  i := VariableIndex(Name);
  if i = -1 then
    raise EFastDbQuery.Create(Format(SVarDoesntExist, [Name]))
  else
    Result := FVariables[i];
end;

//---------------------------------------------------------------------------
function TFastDbQuery.RecordSize: Integer;
var i : Integer;
begin
  Result := 0;
  for i:=0 to Fields.Count-1 do
    Result := Result + Fields[i].FieldSize;
end;

//---------------------------------------------------------------------------
function TFastDbQuery.IsOpen: Boolean;
begin
  Result := FStatement > FastDbUnilitializedHandle;
end;

end.