jvbdeqbe.pas

East make Tray Icon in delphi

            end;
            Result := Copy(Result, 1, P - 1) + Temp + Copy(Result,
              P + Length(Param.Name) + 1, MaxInt);
          end;
        end;
      until not Found;
    end;
  end;

begin
  QBEText.BeginUpdate;
  try
    for I := 0 to QBEText.Count - 1 do
      QBEText[I] := ReplaceString(QBEText[I]);
  finally
    QBEText.EndUpdate;
  end;
end;

procedure TJvQBEQuery.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
      FRowsAffected := -1;
      if ParamCount > 0 then
      begin
        TempQBE := TStringList.Create;
        try
          TempQBE.Assign(QBE);
          ReplaceParams(TempQBE);
          AText := PChar(TempQBE.Text);
          try
            FreeStatement;
            if StrLen(AText) > 1 then
              PrepareQBE(AText)
            else
              _DBError(SEmptySQLStatement);
          finally
          end;
        finally
          TempQBE.Free;
        end;
      end
      else
      begin
        if StrLen(PChar(Text)) > 1 then
          PrepareQBE(PChar(Text))
        else
          _DBError(SEmptySQLStatement);
      end;
    end
    else
    begin
      FRowsAffected := RowsAffected;
      FreeStatement;
    end;
    FPrepared := Value;
  end;
end;

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

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

procedure TJvQBEQuery.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);
      if List.FindParam(Name) = nil then
        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;

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

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

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

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

function TJvQBEQuery.SetDBFlag(Flag: Integer; Value: Boolean): Boolean;
var
  NewConnection: Boolean;
begin
  if Value then
  begin
    NewConnection := DBFlags = [];
    Result := inherited SetDBFlag(Flag, Value);
    if not (csReading in ComponentState) and NewConnection then
      FLocal := not Database.IsSQLBased;
  end
  else
  begin
    if DBFlags - [Flag] = [] then
      SetPrepared(False);
    Result := inherited SetDBFlag(Flag, Value);
  end;
end;

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

procedure TJvQBEQuery.GetStatementHandle(QBEText: PChar);
const
  DataType: array [Boolean] of Longint = (Ord(wantCanned), Ord(wantLive));
begin
  Check(DbiQAlloc(DBHandle, qrylangQBE, FStmtHandle));
  try
    Check(DbiSetProp(hDBIObj(StmtHandle), stmtLIVENESS,
      DataType[RequestLive and not ForceUpdateCallback]));
    Check(DbiSetProp(hDBIObj(StmtHandle), stmtAUXTBLS, Longint(FAuxiliaryTables)));
    if Local and RequestLive and Constrained then
      Check(DbiSetProp(hDBIObj(StmtHandle), stmtCONSTRAINED, Ord(True)));
    if FBlankAsZero then
      Check(DbiSetProp(hDBIObj(StmtHandle), stmtBLANKS, Ord(True)));
    while not CheckOpen(DbiQPrepare(FStmtHandle, QBEText)) do {Retry}
      ;
  except
    DbiQFree(FStmtHandle);
    FStmtHandle := nil;
    raise;
  end;
end;

function TJvQBEQuery.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;

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

{ TJvQBEQuery.IProviderSupport }

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

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

procedure TJvQBEQuery.PSExecute;
begin
  ExecQBE;
end;

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

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.