zdiribsql.pas

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

  begin
    StatementLen := isc_vax_integer(@StatementBuffer[1], 2);
    FStatementType := TIbSqlStmtType(isc_vax_integer(@StatementBuffer[3],
      StatementLen));
    Result := True;
  end;
end;

function TDirIbSqlQuery.ExecuteImmediate: LongInt;
begin
  inherited Execute;

  SetStatus(qsFail);
  Result := 0;
  if Assigned(Connect) and Assigned(Transact) then
  begin
    isc_dsql_execute_immediate(@TDirIbSqlConnect(Connect).FStatusVector,
      @TDirIbSqlConnect(Connect).Handle, @TDirIbSqlTransact(Transact).Handle,
{$IFDEF DELETE_QUERY_SPACES}
      0, PChar(ClearSpaces(Sql)), TDirIbSqlConnect(Connect).Dialect, nil);
{$ELSE}
      0, PChar(Sql), TDirIbSqlConnect(Connect).Dialect, nil);
{$ENDIF}

    TDirIbSqlConnect(Connect).CheckResult('');
    if Connect.Status = csOk then
      SetStatus(qsCommandOk);
  end;
end;

{ Execute an SQL statement }
function TDirIbSqlQuery.Execute: LongInt;
var
  IbConnect: TDirIbSqlConnect;
  IbTransact: TDirIbSqlTransact;
begin
  inherited Execute;
  FPrepared := False;

  SetStatus(qsFail);
  Result := 0;
  if Assigned(Connect) and Assigned(Transact) then
  try
    IbConnect := TDirIbSqlConnect(Connect);
    IbTransact := TDirIbSqlTransact(Transact);

    if Active then Close;
    FHandle := nil;
    isc_dsql_alloc_statement2(@ibConnect.FStatusVector, @ibConnect.Handle, @FHandle);
    AbortOnError;

    isc_dsql_prepare(@ibConnect.FStatusVector, @ibTransact.Handle, @FHandle, 0,
{$IFDEF DELETE_QUERY_SPACES}
      PChar(ClearSpaces(Sql)), IbConnect.Dialect, nil);
{$ELSE}
      PChar(Sql), IbConnect.Dialect, nil);
{$ENDIF}
    AbortOnError;

    FPrepared := True;
    { Statement information }
    SQLStatementType;

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

    if Connect.Status = csOk then
      SetStatus(qsCommandOk);
    SetAffectedRows(SQLAffectedRows);
    Result := AffectedRows;
    FreeStatement;
  except
    FreeStatement;
  end;
  TDirIbSqlConnect(Connect).CheckResult(Sql);
end;

{ Execute an SQL statement with params }
function TDirIbSqlQuery.ExecuteParams(Params: TVarRecArray; ParamCount: Integer): LongInt;
var
  I: Short;
  IbConnect: TDirIbSqlConnect;
  IbTransact: TDirIbSqlTransact;
  SqlVar: PXSQLVAR;
begin
  FStatementType := stUnknown;
  FPrepared := False;

  { Check connect and transaction status }
  Result := inherited Execute;
  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);

  { Allocate an sql statement }
  FHandle := nil;

  try
    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, nil);
{$ELSE}
      PChar(Sql), IbConnect.Dialect, nil);
{$ENDIF}
    AbortOnError;

    FPrepared := True;

    { Statement information}
    SqlStatementType;

    isc_dsql_describe_bind(@IbConnect.FStatusVector, @FHandle, IbConnect.Dialect,
      FInSqlDa);
    AbortOnError;

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

    { Allocate memory for result set }
    for I := 0 to FInSqlDa.sqld - 1 do
    begin
      SqlVar := @FInSqlDa.SqlVar[I];
      if (I > ParamCount) or (I > High(Params)) then
      begin
        SqlVar.sqldata := nil;
        SqlVar.sqltype := SqlVar.sqltype or 1;
        SqlVar.sqlind := @NULL_FLAG;
      end
      else
      begin
        SqlVar.sqltype := SqlVar.sqltype and (not 1);
        case SqlVar.sqltype of
          SQL_VARYING, SQL_TEXT:
            begin
              SqlVar.sqldata := @Params[I];
              //SqlVar.sqllen := Length(string(Params[I]));
            end
          else
            SqlVar.sqldata := @Params[I];
          end;
          SqlVar.sqlind := nil;
        end;
      end;

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

    SetStatus(qsCommandOk);
    SetAffectedRows(SqlAffectedRows);
    Result := AffectedRows;
    FreeStatement;
  except
    FreeStatement;
  end;
  TDirIbSqlConnect(Connect).CheckResult(Sql);
end;

function DateTimeToIbTimeStamp(Value: TDateTime): TISC_TIMESTAMP;
var
  TmDate: TCTimeStructure;
  Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
begin
  DecodeDate(Value, Yr, Mn, Dy);
  DecodeTime(Value, Hr, Mt, S, Ms);
  with TmDate do
  begin
    tm_sec := S;
    tm_min := Mt;
    tm_hour := Hr;
    tm_mday := Dy;
    tm_mon := Mn - 1;
    tm_year := Yr - 1900;
  end;
  isc_encode_date(@TmDate, @Result);
end;

procedure TDirIbSqlQuery.UpdateParams(Params: TParams);
var
  TmpDateTime: TDateTime;
  TmpTimestamp: TISC_TIMESTAMP;
  TmpSmallint: Smallint;
  TmpInteter: integer;
{$IFNDEF VER100}
  TmpInt64: Int64;
{$ENDIF}

  I, Len: Integer;
  SqlVar: PXSQLVAR;
  Parami: TParam;

  function GetParamName(FieldNum: integer): string;
  begin
    Result := MemPas(FInSqlDa.SqlVar[FieldNum].aliasname,
      FInSqlDa.SqlVar[FieldNum].aliasname_length);
  end;

begin
  for I := 0 to FInSqlDa.sqld - 1 do
  begin
    SqlVar := @FInSqlDa.SqlVar[I];
    try
      Parami := Params.ParamByName(GetParamName(I));
    except
      Parami := nil;
    end;

    if (Parami = nil) or (Parami.Value = Null) then
    begin
      SqlVar.sqldata := nil;
      SqlVar.sqltype := SqlVar.sqltype or 1;
      SqlVar.sqlind := @NULL_FLAG;
    end
    else
    begin
      SqlVar.sqlind := nil;

      case SqlVar.sqltype and (not 1) of
        SQL_VARYING:
          begin //?????????
            if SqlVar.sqllen > length(Parami.AsString) then
              Len := length(Parami.AsString)
            else Len := SqlVar.sqllen;
            ReallocMem(SqlVar.sqldata, SqlVar.sqllen + 2 + 1);
            PShort(SqlVar.sqldata)^ := SqlVar.sqllen;
            StrLCopy(SqlVar.sqldata + 2, Pchar(Parami.AsString), Len);
          end;
        SQL_TEXT: //?????????
          begin
            if SqlVar.sqllen > length(Parami.AsString) then
              Len := Length(Parami.AsString)
            else Len := SqlVar.sqllen;

            ReallocMem(SqlVar.sqldata, SqlVar.sqllen + 1);
            StrLCopy(SqlVar.sqldata, Pchar(Parami.AsString), Len);
          end;
        SQL_TYPE_DATE:
          begin
            ReallocMem(SqlVar.sqldata, Sizeof(ISC_DATE));
            TmpDateTime := Parami.AsDateTime;
            TmptimeStamp := DateTimeToIBTimeStamp(TmpDateTime);
            PISC_DATE(SqlVar.sqldata)^ := TmptimeStamp.timestamp_date;
          end;
        SQL_TYPE_TIME:
          begin
            ReallocMem(SqlVar.sqldata, Sizeof(ISC_TIME));
            TmpDateTime := Parami.AsDateTime;
            TmptimeStamp := DateTimeToIBTimeStamp(TmpDateTime);
            PISC_TIME(SqlVar.sqldata)^ := TmptimeStamp.timestamp_time;
          end;
        SQL_DATE:
          begin
            ReallocMem(SqlVar.sqldata, SizeOf(TISC_TIMESTAMP));
            TmpDateTime := Parami.AsDateTime;
            TmptimeStamp := DateTimeToIBTimeStamp(TmpDateTime);
            PISC_TIMESTAMP(SqlVar.sqldata)^ := TmptimeStamp;
          end;
        SQL_SHORT:
          begin
            ReallocMem(SqlVar.sqldata, Sizeof(Smallint));
            TmpSmallint := Trunc(Parami.AsFloat * IntPower(10, -SqlVar.sqlscale));
            PSmallInt(SqlVar.sqldata)^ := TmpSmallInt;
          end;
        SQL_LONG{$IFDEF VER100}, SQL_INT64{$ENDIF}:
          begin
            ReallocMem(SqlVar.sqldata, Sizeof(Longint));
            TmpInteter := Trunc(Parami.AsFloat * IntPower(10, -SqlVar.sqlscale));
            PLongInt(SqlVar.sqldata)^ := TmpInteter;
          end;
{$IFNDEF VER100}
        SQL_INT64:
          begin
            ReallocMem(SqlVar.sqldata, Sizeof(Int64));
            TmpInt64 := Trunc(Parami.AsFloat * IntPower(10, -SqlVar.sqlscale));
            PInt64(SqlVar.sqldata)^ := TmpInt64;
          end;
{$ENDIF}
        SQL_DOUBLE, SQL_D_FLOAT:
          begin
            ReallocMem(SqlVar.sqldata, Sizeof(double));
            PDouble(SqlVar.sqldata)^ := Parami.AsFloat;
          end;
        SQL_FLOAT:
          begin
            ReallocMem(SqlVar.sqldata, Sizeof(single));
            PSingle(SqlVar.sqldata)^ := Parami.AsFloat;
          end;
        SQL_QUAD, SQL_ARRAY, SQL_BLOB: //??????????
          begin
            SqlVar.sqllen := Length(Parami.AsString);
            ReallocMem(SqlVar.sqldata, SqlVar.sqllen + 1);
            StrLCopy(SqlVar.sqldata, Pchar(Parami.AsString), SqlVar.sqllen);
            SqlVar.sqltype := SQL_TEXT;
          end;
      end;
    end;
  end;
end;

function TDirIbSqlQuery.PrepareStatement{(Params: TParams)}: Boolean;
var
  I: Integer;
  IbConnect: TDirIbSqlConnect;
  IbTransact: TDirIbSqlTransact;
  SqlVar: PXSQLVAR;
begin
  FStatementType := stUnknown;
  FPrepared := False;
  Result := 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('');
    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, nil {FOutSqlDa});
    {$ELSE}
      PChar(Sql), IbConnect.Dialect, nil {FOutSqlDa});
    {$ENDIF}
    AbortOnError;


    FPrepared := True;
    { Statement information }
    SqlStatementType;
    {valid statement ????????????}
    if FStatementType in [stUnknown, stGetSegment, stPutSegment, stStartTrans] then
      DatabaseError('Statement Not Permitted'); //????


    (*
    { Initialise input param }
    if (Params <> nil) and (Params.Count > 0) then
    begin
      isc_dsql_describe_bind(@IbConnect.FStatusVector, @FHandle, IbConnect.Dialect,
        FInSqlDa);
      AbortOnError;


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

      { assign params values }
      if Params.Count > 0 then
        UpdateParams(Params);
    end;
    *)

    { Initialise ouput param or Fields }
    if FStatementType in [stSelect, stSelectForUpdate, stExecProc] then
    begin
      isc_dsql_describe(@IbConnect.FStatusVector, @FHandle, IbConnect.Dialect, FOutSqlDa);
      AbortOnError;

        { 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;

      { Inialise Fields }
      { 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 ibtable }
                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;
    end;
    Result := True;
  except
    FreeStatement;
  end;
end;

function TDirIbSqlQuery.ExecStatement: Boolean;
var
  IbConnect: TDirIbSqlConnect;
  IbTransact: TDirIbSqlTransact;
//  SqlVar: PXSQLVAR;
  D_res: ISC_STATUS;
begin
  Result := False;
  { Check connect and transaction status }
  SetStatus(qsFail);
  if not Assigned(Connect) or not Assigned(Transact)
    or not (Connect.Active and Transact.Active) then
    Exit;

  PrepareStatement{(Params)};