zdiribsql.pas

控件名称：WINZEOS.ZIP 2002年08月03日 作者：CapellaDevelopment Zeos系列构件套件包含一组可直接存取Linux知名的免费数据库MySQL、Postgre

  if not FPrepared then Exit;

  IbConnect := TDirIbSqlConnect(Connect);
  IbTransact := TDirIbSqlTransact(Transact);

  { Execute statement }
  try
    case FStatementType of
      stExecProc:
        begin
          D_res := isc_dsql_execute2(@IbConnect.FStatusVector, @IbTransact.Handle, @FHandle,
            IbConnect.Dialect, FInSqlDa, FOutSqlDa);

          //For (pre V6.0) only
          //if error --> try prepare with dialect 1 and ReExecute
          if (D_res <> 0) and (D_res <> 335544345) then //335544345 = isc_lock_conflict
          begin
            isc_dsql_prepare(@IbConnect.FStatusVector, @IbTransact.Handle, @FHandle, 0,
              PChar(Sql), 1 {IbConnect.Dialect}, nil);

            isc_dsql_execute2(@IbConnect.FStatusVector, @IbTransact.Handle, @FHandle,
              IbConnect.Dialect, FInSqlDa, FOutSqlDa);
          end;

          SetBOF(True);
          SetRecNo(0);
        end;
      stSelect, stSelectForUpdate:
        begin
          isc_dsql_execute(@IbConnect.FStatusVector, @IbTransact.Handle, @FHandle,
            IbConnect.Dialect, FInSqlDa);
          SetBOF(False);
        end;
      else
        begin
          isc_dsql_execute(@IbConnect.FStatusVector, @IbTransact.Handle, @FHandle,
            IbConnect.Dialect, FInSqlDa);
          Abort; //go to except for freestatement
        end;
    end;
    AbortOnError;

    SetEOF(False);
    SetActive(True);
    SetStatus(qsTuplesOk);
    if Status <> qsTuplesOk then
      SetActive(False);

    if FStatementType in [stSelect, stSelectForUpdate] then
      Next;
  except
    FreeStatement;
  end;
  Result := (Status <> qsFail);
end;

procedure TDirIbSqlQuery.Open;
begin
  inherited Open;
  ExecStatement;
  if Assigned(Connect) then
    TDirIbSqlConnect(Connect).CheckResult(Sql)
  else
    MonitorList.InvokeEvent(Sql, Error, True);
end;

(*
{ Open a sql query with result set }
procedure TDirIbSqlQuery.Open;
var
  I: Integer;
  IbConnect: TDirIbSqlConnect;
  IbTransact: TDirIbSqlTransact;
  SqlVar: PXSQLVAR;
begin
  inherited Open;
  FPrepared := False;

  { Check connect and transaction status }
  SetStatus(qsFail);
  if not Assigned(Connect) or not Assigned(Transact)
    or not (Connect.Active and Transact.Active) then
  begin
    TDirIbSqlConnect(Connect).CheckResult(Sql);
    Exit;
  end;

  IbConnect := TDirIbSqlConnect(Connect);
  IbTransact := TDirIbSqlTransact(Transact);

  try
    { Allocate an sql statement }
    FHandle := nil;
    isc_dsql_alloc_statement2(@IbConnect.FStatusVector, @IbConnect.Handle, @FHandle);
    AbortOnError;

    { Prepare an sql statement }
    isc_dsql_prepare(@IbConnect.FStatusVector, @IbTransact.Handle, @FHandle, 0,
      {$IFDEF DELETE_QUERY_SPACES}
      PChar(ClearSpaces(Sql)), IbConnect.Dialect, FOutSqlDa);
    {$ELSE}
      PChar(Sql), IbConnect.Dialect, FOutSqlDa);
    {$ENDIF}
    AbortOnError;

    FPrepared := True;
    SqlStatementType;

    { Resize XSQLDA structure if needed }
    if FOutSqlDa.sqld > FOutSqlDa.sqln then
    begin
      IbReallocMem(FOutSqlDa, XSQLDA_LENGTH(FOutSqlDa.sqln), XSQLDA_LENGTH(FOutSqlDa.sqld));
      FOutSqlDa.sqln := FOutSqlDa.sqld;
      isc_dsql_describe(@IbConnect.FStatusVector, @FHandle, IbConnect.Dialect,
        FOutSqlDa);
      AbortOnError;
    end;

    { Allocate memory for result set }
    for I := 0 to FOutSqlDa.sqld - 1 do
    begin
      SqlVar := @FOutSqlDa.SqlVar[I];

      case SqlVar.sqltype and (not 1) of
        SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_DATE,
        SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT,
        SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
          begin
            if (SqlVar.sqllen = 0) then
              { Make sure you get a valid pointer anyway select '' from sqltable }
              GetMem(SqlVar.sqldata, 1)
            else
              GetMem(SqlVar.sqldata, SqlVar.sqllen)
          end;
        SQL_VARYING:
          begin
            GetMem(SqlVar.sqldata, SqlVar.sqllen + 2);
          end;
      end;
      if (SqlVar.sqltype and 1) <> 0 then
        GetMem(SqlVar.sqlind, SizeOf(Short))
      else
        SqlVar.sqlind := nil;
    end;

    { Execute a query }
    isc_dsql_execute(@IbConnect.FStatusVector, @IbTransact.Handle, @FHandle,
      IbConnect.Dialect, nil);
    AbortOnError;

    SetActive(True);
    SetStatus(qsTuplesOk);
    SetBOF(False);
    SetEOF(False);
    Next;
    if Status <> qsTuplesOk then
      SetActive(False);
  except
    FreeStatement;
  end;
end;
*)

{ Free allocated statement }
function TDirIbSqlQuery.FreeStatement: Boolean;
var
  FStatusVector: ARRAY_ISC_STATUS;
begin
  Result := True;
  if FHandle <> nil then
  begin
    isc_dsql_free_statement(@FStatusVector, @FHandle, DSQL_drop);
    if (FStatusVector[0] = 1) and (FStatusVector[0] > 0) then
      Result := False;
    FHandle := nil;
    FPrepared := False;
    TDirIbSqlConnect(Connect).CheckResult('');
  end;
end;

{ Close a sql query with result set }
procedure TDirIbSqlQuery.Close;
var
  I: Integer;
  SqlVar: PXSQLVAR;
begin
  if not Active then Exit;
  inherited Close;

  { Check connect and transaction status }
  SetStatus(qsTuplesOk);
  if not Assigned(Connect) then Exit;

  { Free sql statement }
  FreeStatement;

  { Free output allocated memory }
  for I := 0 to FOutSqlDa.sqld - 1 do
  begin
    SqlVar := @FOutSqlDa.SqlVar[I];
    FreeMem(SqlVar.sqldata);
    FreeMem(SqlVar.sqlind);
    SqlVar.sqldata := nil;
    SqlVar.sqlind := nil;
  end;
  FOutSqlDa.sqld := 0;
end;

{ Create linked blob object }
function TDirIbSqlQuery.CreateBlobObject: TDirBlob;
var
  TempHandle: TBlobHandle;
begin
  FillChar(TempHandle, SizeOf(TBlobHandle), 0);
  Result := TDirIbSqlBlob.Create(Connect, Transact, TempHandle);
end;

function TDirIbSqlQuery.Field(FieldNum: Integer): string;
var
  SqlVar: PXSQLVAR;
  VarType: Short;
  OldSep: Char;
  TempDate: TCTimeStructure;
begin
  Result := '';
  if not Active then Exit;
  SqlVar := @FOutSqlDa.SqlVar[FieldNum];
  VarType := SqlVar.sqltype;
  if ((VarType and 1) <> 0) and ((SqlVar.sqlind^) = -1) then
    Exit;
  OldSep := DecimalSeparator;
  DecimalSeparator := '.';
  case (VarType and (not 1)) of
    SQL_VARYING:
      Result := MemPas(SqlVar.sqldata + 2, PSmallInt(SqlVar.sqldata)^);
    SQL_TEXT:
      Result := TrimRight(MemPas(SqlVar.sqldata, SqlVar.sqllen));
    SQL_LONG {$IFDEF VER100}, SQL_INT64{$ENDIF}:
      begin
        if SqlVar.sqlscale = 0 then
          Result := IntToStr(PLongInt(SqlVar.sqldata)^)
        else if Abs(SqlVar.sqlscale) <= 4 then
          Result := CurrToStr(PLongInt(SqlVar.sqldata)^
            * IntPower(10, SqlVar.sqlscale))
        else
          Result := FloatToStr(PLongInt(SqlVar.sqldata)^
            * IntPower(10, SqlVar.sqlscale));
      end;
    SQL_SHORT:
      begin
        if SqlVar.sqlscale = 0 then
          Result := IntToStr(PSmallInt(SqlVar.sqldata)^)
        else
          Result := CurrToStr(PSmallInt(SqlVar.sqldata)^
            * IntPower(10, SqlVar.sqlscale));
      end;
    SQL_DOUBLE:
      Result := FloatToStr(PDouble(SqlVar.sqldata)^);
    SQL_D_FLOAT:
      Result := FloatToStr(PDouble(SqlVar.sqldata)^);
    SQL_FLOAT:
      Result := FloatToStr(PSingle(SqlVar.sqldata)^);
    SQL_TYPE_TIME:
      begin
        isc_decode_sql_time(PISC_TIME(SqlVar.sqldata), @TempDate);
        Result := DateTimeToSqlDate(
          EncodeTime(Word(TempDate.tm_hour), Word(TempDate.tm_min),
          Word(TempDate.tm_sec), 0));
      end;
    SQL_TYPE_DATE:
      begin
        isc_decode_sql_date(PISC_DATE(SqlVar.sqldata), @TempDate);
        Result := DateTimeToSqlDate(
          EncodeDate(Word(TempDate.tm_year + 1900), Word(TempDate.tm_mon + 1),
          Word(TempDate.tm_mday)));
      end;
{$IFNDEF VER100}
    SQL_INT64: //atenttion  / mast replaced by *
      begin
        if SqlVar.sqlscale = 0 then
          Result := IntToStr(PInt64(SqlVar.sqldata)^)
        else if Abs(SqlVar.sqlscale) <= 4 then
          Result := CurrToStr(PInt64(SqlVar.sqldata)^
            * IntPower(10, SqlVar.sqlscale))
        else
          Result := FloatToStr(PInt64(SqlVar.sqldata)^
            * IntPower(10, SqlVar.sqlscale));
      end;
{$ENDIF}
    SQL_ARRAY:
      Result := '(ARRAY)';
    SQL_QUAD:
      Result := '(QUAD)';
    SQL_DATE:
      begin
        isc_decode_date(PISC_QUAD(SqlVar.sqldata), @TempDate);
        Result := DateTimeToSqlDate(EncodeDate(TempDate.tm_year + 1900,
          TempDate.tm_mon + 1, TempDate.tm_mday) + EncodeTime(TempDate.tm_hour,
          TempDate.tm_min, TempDate.tm_sec, 0));
      end;
    SQL_BLOB:
      begin
        with TDirIbSqlBlob.Create(Connect, Transact,
          PBlobHandle(SqlVar.sqldata)^) do
        try
          Result := Value;
        finally
          Free;
        end;
      end;
  end;
  DecimalSeparator := OldSep;
end;

function TDirIbSqlQuery.FieldValue(FieldNum: Integer): Variant;
var
  SqlVar: PXSQLVAR;
  VarType: Short;
  OldSep: Char;
  TempDate: TCTimeStructure;
  tmpCurrency: System.Currency;
  tmpDouble: Double;
begin
  Result := Null;
  if not Active then Exit;
  SqlVar := @FOutSqlDa.SqlVar[FieldNum];
  VarType := SqlVar.sqltype;
  if ((VarType and 1) <> 0) and ((SqlVar.sqlind^) = -1) then
    Exit;
  OldSep := DecimalSeparator;
  DecimalSeparator := '.';
  case (VarType and (not 1)) of
    SQL_VARYING:
      Result := MemPas(SqlVar.sqldata + 2, PSmallInt(SqlVar.sqldata)^);
    SQL_TEXT:
      Result := TrimRight(MemPas(SqlVar.sqldata, SqlVar.sqllen));
    SQL_LONG {$IFDEF VER100}, SQL_INT64{$ENDIF}:
      begin
        if SqlVar.sqlscale = 0 then
          Result := PLongInt(SqlVar.sqldata)^
        else
          if abs(SqlVar.sqlscale) <= 4 then
          begin
            tmpCurrency := PLongInt(SqlVar.sqldata)^
              * IntPower(10, SqlVar.sqlscale);
            Result := tmpCurrency;
          end
        else
          begin
            tmpDouble := PLongInt(SqlVar.sqldata)^
              * IntPower(10, SqlVar.sqlscale);
            Result := tmpDouble;
          end
      end;
    SQL_SHORT:
      begin
        if SqlVar.sqlscale = 0 then
          Result := PSmallInt(SqlVar.sqldata)^
        else
        begin
          tmpCurrency := PSmallInt(SqlVar.sqldata)^
            * IntPower(10, SqlVar.sqlscale);
          Result := tmpCurrency;
        end;
      end;
    SQL_DOUBLE:
      Result := PDouble(SqlVar.sqldata)^;
    SQL_D_FLOAT:
      Result := PDouble(SqlVar.sqldata)^;
    SQL_FLOAT:
      Result := PSingle(SqlVar.sqldata)^;
    SQL_TYPE_TIME:
      begin
        isc_decode_sql_time(PISC_TIME(SqlVar.sqldata), @TempDate);
        Result := EncodeTime(Word(TempDate.tm_hour), Word(TempDate.tm_min),
          Word(TempDate.tm_sec), 0);
      end;
    SQL_TYPE_DATE:
      begin
        isc_decode_sql_date(PISC_DATE(SqlVar.sqldata), @TempDate);
        Result :=
          EncodeDate(Word(TempDate.tm_year + 1900), Word(TempDate.tm_mon + 1),
          Word(TempDate.tm_mday));
      end;
{$IFNDEF VER100}
    SQL_INT64:
      begin
        if SqlVar.sqlscale = 0 then
          Result := InttoStr(PInt64(SqlVar.sqldata)^)
        else if Abs(SqlVar.sqlscale) <= 4 then
        begin
          tmpCurrency := PInt64(SqlVar.sqldata)^
            * IntPower(10, SqlVar.sqlscale);
          Result := tmpCurrency;
        end
        else
        begin
          tmpDouble := PInt64(SqlVar.sqldata)^
            * IntPower(10, SqlVar.sqlscale);
          Result := tmpDouble;
        end;
      end;
{$ENDIF}
    //SQL_ARRAY: Result := '(ARRAY)';
    //SQL_QUAD: Result := '(QUAD)';
    SQL_DATE:
      begin
        isc_decode_date(PISC_QUAD(SqlVar.sqldata), @TempDate);
        Result := EncodeDate(TempDate.tm_year + 1900,
          TempDate.tm_mon + 1, TempDate.tm_mday) + EncodeTime(TempDate.tm_hour,
          TempDate.tm_min, TempDate.tm_sec, 0);
      end;
    SQL_BLOB:
      begin
        with TDirIbSqlBlob.Create(Connect, Transact,
          PBlobHandle(SqlVar.sqldata)^) do
          try
            Result := Value;
          finally
            Free;
          end;
      end;
  end;
  DecimalSeparator := OldSep;
end;

{}
function TDirIbSqlQuery.GetFieldValue(FieldNum: Integer; var Buffer): Boolean;
var
  SqlVar: PXSQLVAR;
  VarType: Short;
  OldSep: Char;
  TempTime: TDateTime;
  TempDate: TCTimeStructure;
  tmpCurrency: System.Currency;
  tmpDouble: Double;
begin
  Result := Null;
  if not Active then Exit;
  SqlVar := @FOutSqlDa.SqlVar[FieldNum];
  VarType := SqlVar.sqltype;
  if ((VarType and 1) <> 0) and ((SqlVar.sqlind^) = -1) then
    Exit;
  OldSep := DecimalSeparator;
  DecimalSeparator := '.';
  case (VarType and (not 1)) of
    SQL_VARYING:
      string(Buffer) := MemPas(SqlVar.sqldata + 2, PSmallInt(SqlVar.sqldata)^);
    SQL_TEXT:
      string(Buffer) := TrimRight(MemPas(SqlVar.sqldata, SqlVar.sqllen));
    SQL_LONG {$IFDEF VER100}, SQL_INT64{$ENDIF}:
      begin
        if SqlVar.sqlscale = 0 then
          LongInt(Buffer) := PLongInt(SqlVar.sqldata)^
        else
          if abs(SqlVar.sqlscale) <= 4 then
          begin
            tmpCurrency := PLongInt(SqlVar.sqldata)^
              * IntPower(10, SqlVar.sqlscale);