dbqbe.pas

灰鸽子1.23源码,,,,,,,

            Temp := Param.Text;
            if Temp = '' then begin
              if (Param.DataType = ftString) and not Param.IsNull then
                Temp := '""'
              else Temp := 'BLANK'; { special QBE operator }
            end;
            Result := Copy(Result, 1, P - 1) + Temp + Copy(Result,
              P + Length(Param.Name) + 1, MaxInt);
          end;
        end;
      until not Found;
    end;
  end;

var
  I: Integer;
begin
  for I := 0 to QBEText.Count - 1 do
    QBEText[I] := ReplaceString(QBEText[I]);
end;

procedure TQBEQuery.SetPrepared(Value: Boolean);
var
  TempQBE: TStrings;
  AText: PChar;
begin
  if Handle <> nil then _DBError(SDataSetOpen);
  if (Value <> Prepared) or (ParamCount > 0) then begin
    if Value then begin
{$IFDEF WIN32}
      FRowsAffected := -1;
{$ENDIF}
      if ParamCount > 0 then begin
        TempQBE := TStringList.Create;
        try
          TempQBE.Assign(QBE);
          ReplaceParams(TempQBE);
{$IFDEF WIN32}
          AText := PChar(TempQBE.Text);
{$ELSE}
          AText := TempQBE.GetText;
{$ENDIF}
          try
            FreeStatement;
            if StrLen(AText) > 1 then PrepareQBE(AText)
            else _DBError(SEmptySQLStatement);
          finally
{$IFNDEF WIN32}
            StrDispose(AText);
{$ENDIF}
          end;
        finally
          TempQBE.Free;
        end;
      end
      else begin
        if StrLen(PChar(Text)) > 1 then PrepareQBE(PChar(Text))
        else _DBError(SEmptySQLStatement);
      end;
    end
    else begin
{$IFDEF WIN32}
      FRowsAffected := RowsAffected;
{$ENDIF}
      FreeStatement;
    end;
    FPrepared := Value;
  end;
end;

procedure TQBEQuery.FreeStatement;
begin
  if StmtHandle <> nil then begin
    DbiQFree(FStmtHandle);
    FStmtHandle := nil;
  end;
end;

function TQBEQuery.ParamByName(const Value: string): TParam;
begin
  Result := FParams.ParamByName(Value);
end;

procedure TQBEQuery.CreateParams(List: TParams; const Value: PChar);
var
  CurPos, StartPos: PChar;
  CurChar: Char;
  Literal: Boolean;
  EmbeddedLiteral: Boolean;
  Name: string;

  function StripLiterals(Buffer: PChar): string;
  var
    Len: Word;
    TempBuf: PChar;

    procedure StripChar(Value: Char);
    begin
      if TempBuf^ = Value then
        StrMove(TempBuf, TempBuf + 1, Len - 1);
      if TempBuf[StrLen(TempBuf) - 1] = Value then
        TempBuf[StrLen(TempBuf) - 1] := #0;
    end;

  begin
    Len := StrLen(Buffer) + 1;
    TempBuf := AllocMem(Len);
    Result := '';
    try
      StrCopy(TempBuf, Buffer);
      StripChar('''');
      StripChar('"');
      Result := StrPas(TempBuf);
    finally
      FreeMem(TempBuf, Len);
    end;
  end;

begin
  CurPos := Value;
  Literal := False;
  EmbeddedLiteral := False;
  repeat
    CurChar := CurPos^;
    if (CurChar = FStartParam) and not Literal and
      ((CurPos + 1)^ <> FStartParam) then
    begin
      StartPos := CurPos;
      while (CurChar <> #0) and (Literal or not NameDelimiter(CurChar)) do
      begin
        Inc(CurPos);
        CurChar := CurPos^;
        if IsLiteral(CurChar) then begin
          Literal := Literal xor True;
          if CurPos = StartPos + 1 then EmbeddedLiteral := True;
        end;
      end;
      CurPos^ := #0;
      if EmbeddedLiteral then begin
        Name := StripLiterals(StartPos + 1);
        EmbeddedLiteral := False;
      end
      else Name := StrPas(StartPos + 1);
{$IFDEF RX_D4}
      if List.FindParam(Name) = nil then
{$ENDIF}
        List.CreateParam(ftUnknown, Name, ptUnknown);
      CurPos^ := CurChar;
      StartPos^ := '?';
      Inc(StartPos);
      StrMove(StartPos, CurPos, StrLen(CurPos) + 1);
      CurPos := StartPos;
    end
    else if (CurChar = FStartParam) and not Literal
      and ((CurPos + 1)^ = FStartParam) then
      StrMove(CurPos, CurPos + 1, StrLen(CurPos) + 1)
    else if IsLiteral(CurChar) then Literal := Literal xor True;
    Inc(CurPos);
  until CurChar = #0;
end;

{$IFNDEF RX_D3}
function TQBEQuery.IsEmpty: Boolean;
begin
  Result := IsDataSetEmpty(Self);
end;
{$ENDIF}

function TQBEQuery.CreateCursor(GenHandle: Boolean): HDBICur;
begin
  if QBE.Count > 0 then begin
    SetPrepared(True);
    Result := GetQueryCursor(GenHandle);
  end
  else Result := nil;
end;

function TQBEQuery.CreateHandle: HDBICur;
begin
  Result := CreateCursor(True)
end;

procedure TQBEQuery.ExecQBE;
begin
  CheckInActive;
  SetDBFlag(dbfExecSQL, True);
  try
    CreateCursor(False);
  finally
    SetDBFlag(dbfExecSQL, False);
  end;
end;

function TQBEQuery.GetQueryCursor(GenHandle: Boolean): HDBICur;
var
  PCursor: phDBICur;
begin
  Result := nil;
  if GenHandle then PCursor := @Result
  else PCursor := nil;
  Check(DbiQExec(StmtHandle, PCursor));
end;

{$IFDEF RX_V110}
function TQBEQuery.SetDBFlag(Flag: Integer; Value: Boolean): Boolean;
{$ELSE}
procedure TQBEQuery.SetDBFlag(Flag: Integer; Value: Boolean);
{$ENDIF}
var
  NewConnection: Boolean;
begin
  if Value then begin
    NewConnection := DBFlags = [];
{$IFDEF RX_V110}
    Result := inherited SetDBFlag(Flag, Value);
{$ELSE}
    inherited SetDBFlag(Flag, Value);
{$ENDIF}
    if not (csReading in ComponentState) and NewConnection then
      FLocal := not Database.IsSQLBased;
  end
  else begin
    if DBFlags - [Flag] = [] then SetPrepared(False);
{$IFDEF RX_V110}
    Result := inherited SetDBFlag(Flag, Value);
{$ELSE}
    inherited SetDBFlag(Flag, Value);
{$ENDIF}
  end;
end;

procedure TQBEQuery.PrepareQBE(Value: PChar);
begin
  GetStatementHandle(Value);
end;

procedure TQBEQuery.GetStatementHandle(QBEText: PChar);
const
  DataType: array[Boolean] of LongInt = (Ord(wantCanned), Ord(wantLive));
begin
{$IFDEF WIN32}
  Check(DbiQAlloc(DBHandle, qrylangQBE, FStmtHandle));
  try
    Check(DBiSetProp(hDbiObj(StmtHandle), stmtLIVENESS,
      DataType[RequestLive and not ForceUpdateCallback]));
    Check(DBiSetProp(hDbiObj(StmtHandle), stmtAUXTBLS, Longint(FAuxiliaryTables)));
{$IFDEF RX_D3}
    if Local and RequestLive and Constrained then
      Check(DBiSetProp(hDbiObj(StmtHandle), stmtCONSTRAINED, LongInt(True)));
{$ENDIF}
    if FBlankAsZero then
      Check(DbiSetProp(hDbiObj(StmtHandle), stmtBLANKS, Longint(True)));
    while not CheckOpen(DbiQPrepare(FStmtHandle, QBEText)) do {Retry};
  except
    DbiQFree(FStmtHandle);
    FStmtHandle := nil;
    raise;
  end;
{$ELSE}
  if Local then begin
    while not CheckOpen(DbiQPrepare(DBHandle, qrylangQBE, QBEText,
      FStmtHandle)) do {Retry};
    Check(DBiSetProp(hDbiObj(StmtHandle), stmtLIVENESS, DataType[RequestLive]));
  end
  else begin
    if RequestLive then
      Check(DbiQPrepareExt(DBHandle, qrylangQBE, QBEText, qprepFORUPDATE, FStmtHandle))
    else Check(DbiQPrepare(DBHandle, qrylangQBE, QBEText, FStmtHandle));
  end;
  Check(DBiSetProp(hDbiObj(StmtHandle), stmtAUXTBLS, Longint(FAuxiliaryTables)));
  if FBlankAsZero then
    Check(DbiSetProp(hDbiObj(StmtHandle), stmtBLANKS, LongInt(True)));
{$ENDIF}
end;

function TQBEQuery.GetQBEText: PChar;
var
  BufLen: Word;
  I: Integer;
  StrEnd: PChar;
  StrBuf: array[0..255] of Char;
begin
  BufLen := 1;
  for I := 0 to QBE.Count - 1 do
    Inc(BufLen, Length(QBE.Strings[I]) + 1);
  Result := StrAlloc(BufLen);
  try
    StrEnd := Result;
    for I := 0 to QBE.Count - 1 do begin
      StrPCopy(StrBuf, QBE.Strings[I]);
      StrEnd := StrECopy(StrEnd, StrBuf);
      StrEnd := StrECopy(StrEnd, ' ');
    end;
  except
    StrDispose(Result);
    raise;
  end;
end;

{$IFDEF WIN32}
function TQBEQuery.GetRowsAffected: Integer;
var
  Length: Word;
begin
  if Prepared then
    if DbiGetProp(hDBIObj(StmtHandle), stmtROWCOUNT, @Result, SizeOf(Result),
      Length) <> 0 then Result := -1
    else
  else Result := FRowsAffected;
end;
{$ENDIF}

{$IFDEF RX_D5}

{ TQBEQuery.IProviderSupport }

function TQBEQuery.PSGetParams: TParams;
begin
  Result := Params;
end;

procedure TQBEQuery.PSSetParams(AParams: TParams);
begin
  if AParams.Count <> 0 then
    Params.Assign(AParams);
  Close;
end;

procedure TQBEQuery.PSExecute;
begin
  ExecQBE;
end;

procedure TQBEQuery.PSSetCommandText(const CommandText: string);
begin
  if CommandText <> '' then
    QBE.Text := CommandText;
end;

{$ENDIF RX_D5}

end.