zdirdb2sql.pas

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

  FillChar(FOutSqlVars^, SqlVarsLength(MAX_SQLVAR), 0);
  FOutSqlVars.AllocNum := MAX_SQLVAR;

  GetMem(FInSqlVars, SqlVarsLength(MAX_SQLVAR));
  FillChar(FInSqlVars^, SqlVarsLength(MAX_SQLVAR), 0);
  FInSqlVars.AllocNum := MAX_SQLVAR;
end;

{ Class destructor }
destructor TDirDb2SqlQuery.Destroy;
begin
  inherited Destroy;
  FreeMem(FInSqlVars);
  FreeMem(FOutSqlVars);
end;

{ Get an error message }
function TDirDb2SqlQuery.GetErrorMsg: ShortString;
begin
  if not (Status in [qsCommandOk, qsTuplesOk]) then
    Result := FError
  else
    Result := '';
end;

{ Execute an SQL statement }
function TDirDb2SqlQuery.Execute: LongInt;
label ErrorProc;
var
  Db2Connect: TDirDb2SqlConnect;
  Db2Transact: TDirDb2SqlTransact;
  Status: Integer;
{$IFDEF DELETE_QUERY_SPACES}
  Temp: string;
{$ENDIF}
  TempRows: Integer;
begin
  inherited Execute;

  SetStatus(qsFail);
  Result := 0;
  if Assigned(Connect) and Assigned(Transact) and Transact.Active then
  begin
    Db2Connect := TDirDb2SqlConnect(Connect);
    Db2Transact := TDirDb2SqlTransact(Transact);

    FHandle := 0;
    Status := SqlAllocHandle(SQL_HANDLE_STMT, Db2Connect.Handle, @FHandle);
    if not Db2Transact.CheckError(SQL_HANDLE_STMT, FHandle, Status, FError) then
      goto ErrorProc;

{$IFDEF DELETE_QUERY_SPACES}
    Temp := ClearSpaces(Sql);
    Status := SQLExecDirect(FHandle, PChar(Temp), Length(Temp));
{$ELSE}
    Status := SQLExecDirect(FHandle, PChar(Sql), Length(Sql));
{$ENDIF}
    if not Db2Transact.CheckError(SQL_HANDLE_STMT, FHandle, Status, FError) then
      goto ErrorProc;

    SetStatus(qsCommandOk);

    TempRows := 0;
    SQLRowCount(FHandle, @TempRows);
    SetAffectedRows(TempRows);

ErrorProc:
    MonitorList.InvokeEvent(Sql, Error, Error <> '');
    SqlFreeHandle(SQL_HANDLE_STMT, FHandle);
    FHandle := 0;
  end;
end;

{ Execute an SQL statement with params }
function TDirDb2SqlQuery.ExecuteParams(Params: TVarRecArray; ParamCount: Integer): LongInt;
label ErrorProc;
var
  I: Integer;
  Param: TVarRec;
  RecordBlob: PRecordBlob;
  BlobType: SQLSMALLINT;
  BlobInd: SQLINTEGER;
  Db2Connect: TDirDb2SqlConnect;
  Db2Transact: TDirDb2SqlTransact;
  Status: Integer;
{$IFDEF DELETE_QUERY_SPACES}
  Temp: string;
{$ENDIF}
  TempRows: Integer;
begin
  inherited Execute;

  SetStatus(qsFail);
  Result := 0;
  if not Assigned(Connect) or not Assigned(Transact) or not Transact.Active then
    Exit;

  Db2Connect := TDirDb2SqlConnect(Connect);
  Db2Transact := TDirDb2SqlTransact(Transact);

  FHandle := 0;
  Status := SqlAllocHandle(SQL_HANDLE_STMT, Db2Connect.Handle, @FHandle);
  if not Db2Transact.CheckError(SQL_HANDLE_STMT, FHandle, Status, FError) then
    goto ErrorProc;

{ Prepare an sql statement }
{$IFDEF DELETE_QUERY_SPACES}
  Temp := ClearSpaces(Sql);
  Status := SQLPrepare(FHandle, PChar(Temp), SQL_NTS);
{$ELSE}
  Status := SQLPrepare(FHandle, PChar(Sql), SQL_NTS);
{$ENDIF}
  if not DB2Transact.CheckError(SQL_HANDLE_STMT, FHandle, Status, FError) then
    goto ErrorProc;

  for I := 0 to ParamCount-1 do
  begin
    Param := Params[I];
    RecordBlob := PRecordBlob(Param.VPointer);

    BlobType := RecordBlob.Handle.PtrEx - 1000;
    case BlobType of
      SQL_BLOB_LOCATOR: BlobType := SQL_BLOB;
      SQL_CLOB_LOCATOR: BlobType := SQL_CLOB;
      SQL_DBCLOB_LOCATOR: BlobType := SQL_DBCLOB;
    end;

    BlobInd := SQL_DATA_AT_EXEC;
    Status := SQLBindParameter(FHandle, I+1, SQL_PARAM_INPUT, SQL_BINARY,
      BlobType, RecordBlob.Size, 0, RecordBlob, RecordBlob.Size, @BlobInd);
    if not Db2Transact.CheckError(SQL_HANDLE_STMT, FHandle, Status, FError) then
      goto ErrorProc;
  end;

  Status := SQLExecute(FHandle);

  if Status = SQL_NEED_DATA then
  begin
    Status := SQLParamData(FHandle, @RecordBlob);
    while Status = SQL_NEED_DATA do
    begin
      Status := SQLPutData(FHandle, RecordBlob.Data, RecordBlob.Size);
      if not Db2Transact.CheckError(SQL_HANDLE_STMT, FHandle, Status, FError) then
        goto ErrorProc;
      Status := SQLParamData(FHandle, @RecordBlob);
    end;
  end;

  if not Db2Transact.CheckError(SQL_HANDLE_STMT, FHandle, Status, FError) then
    goto ErrorProc;

  SetStatus(qsCommandOk);

  TempRows := 0;
  SQLRowCount(FHandle, @TempRows);
  SetAffectedRows(TempRows);

ErrorProc:
  MonitorList.InvokeEvent(Sql, Error, Error <> '');
  SqlFreeHandle(SQL_HANDLE_STMT, FHandle);
  FHandle := 0;
end;

{ Open a sql query with result set }
procedure TDirDb2SqlQuery.Open;
label ErrorProc;
var
  I, Status: Integer;
  Db2Connect: TDirDb2SqlConnect;
  Db2Transact: TDirDb2SqlTransact;
  SqlVar: PSqlVar;
  TempBuffer: array[0..255] of Char;
  TempBufferLen: SmallInt;
{$IFDEF DELETE_QUERY_SPACES}
  Temp: string;
{$ENDIF}
  Len: Integer;
begin
  inherited Open;

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

  Db2Connect := TDirDb2SqlConnect(Connect);
  Db2Transact := TDirDb2SqlTransact(Transact);

  { Allocate an sql statement }
  FHandle := 0;
  Status := SqlAllocHandle(SQL_HANDLE_STMT, Db2Connect.Handle, @FHandle);
  if not DB2Transact.CheckError(SQL_HANDLE_STMT, FHandle, Status, FError) then
    goto ErrorProc;

  { Prepare an sql statement }
{$IFDEF DELETE_QUERY_SPACES}
  Temp := ClearSpaces(Sql);
  Status := SQLPrepare(FHandle, PChar(Temp), SQL_NTS);
{$ELSE}
  Status := SQLPrepare(FHandle, PChar(Sql), SQL_NTS);
{$ENDIF}
  if not DB2Transact.CheckError(SQL_HANDLE_STMT, FHandle, Status, FError) then
    goto ErrorProc;

  { Resize SQLVERS structure if needed }
  SQLNumResultCols(FHandle, @FOutSqlVars.ActualNum);
  if FOutSqlVars.ActualNum > FOutSqlVars.AllocNum then
  begin
    ReallocMem(FOutSqlVars, SqlVarsLength(FOutSqlVars.ActualNum));
    FOutSqlVars.AllocNum := FOutSqlVars.ActualNum;
  end;

  { Allocate memory for result set }
  for I := 0 to FOutSqlVars.ActualNum-1 do
  begin
    SqlVar := @FOutSqlVars.Variables[I];
    SqlVar.Data := nil;
    SqlVar.DataSize := 0;

    Status := SQLDescribeCol(FHandle, I+1, TempBuffer, 255, @TempBufferLen,
      @SqlVar.DataType, @SqlVar.DataSize, @SqlVar.Scale, nil);
    SqlVar.Name := MemPas(TempBuffer, TempBufferLen);

    case SqlVar.DataType of
      SQL_CHAR, SQL_VARCHAR, SQL_WCHAR, SQL_WVARCHAR, SQL_WLONGVARCHAR:
        begin
          if SqlVar.DataSize < 255 then
            SqlVar.ColType := ftString
          else
            SqlVar.ColType := ftMemo;
        end;
      {$IFNDEF VER100}
      SQL_BIGINT:
        SqlVar.ColType := ftLargeInt;
      {$ENDIF}
      SQL_NUMERIC, SQL_DECIMAL:
        begin
          if (SqlVar.Scale = 0) then
            SqlVar.ColType := ftInteger
          else
            SqlVar.ColType := ftFloat;
        end;
      SQL_INTEGER, SQL_SMALLINT {$IFDEF VER100}, SQL_BIGINT{$ENDIF}:
        SqlVar.ColType := ftInteger;
      SQL_FLOAT, SQL_REAL, SQL_DOUBLE:
        SqlVar.ColType := ftFloat;
      SQL_DATETIME, SQL_TYPE_TIMESTAMP:
        SqlVar.ColType := ftDateTime;
      SQL_TYPE_DATE:
        SqlVar.ColType := ftDate;
      SQL_TYPE_TIME:
        SqlVar.ColType := ftTime;
      SQL_CLOB, SQL_DBCLOB:
        SqlVar.ColType := ftMemo;
      SQL_BLOB:
        SqlVar.ColType := ftBlob;
      else
        SqlVar.ColType := ftUnknown;
    end;

    SqlVar.TypeCode := SqlVar.DataType;
    Len := 0;
    case SqlVar.ColType of
      ftInteger:
        begin
          SqlVar.TypeCode := SQL_INTEGER;
          Len := SizeOf(SQLINTEGER);
        end;
      ftFloat:
        begin
          SqlVar.TypeCode := SQL_DOUBLE;
          Len := SizeOf(SQLDOUBLE);
        end;
(*
      {$IFNDEF VER100}
      ftLargeInt:
        begin
          SqlVar.TypeCode := SQL_BIGINT;
          Len := SizeOf(Int64);
        end;
      {$ENDIF}
*)
      ftDate:
        begin
          SqlVar.TypeCode := SQL_TYPE_DATE;
          Len := SQL_DATE_LEN;
        end;
      ftTime:
        begin
          SqlVar.TypeCode := SQL_TYPE_TIME;
          Len := SQL_TIME_LEN;
        end;
      ftDateTime:
        begin
          SqlVar.TypeCode := SQL_TYPE_TIMESTAMP;
          Len := SQL_TIMESTAMP_LEN;
        end;
      ftString:
        begin
          SqlVar.TypeCode := SQL_CHAR;
          Len := SqlVar.DataSize + 1;
        end;
      ftBlob, ftMemo:
        begin
          case SqlVar.DataType of
            SQL_BLOB: SqlVar.TypeCode := SQL_BLOB_LOCATOR;
            SQL_CLOB: SqlVar.TypeCode := SQL_CLOB_LOCATOR;
            SQL_DBCLOB: SqlVar.TypeCode := SQL_DBCLOB_LOCATOR;
          end;
          Len := SizeOf(SQLINTEGER);
        end;
      ftUnknown:
        Continue;
    end;

    GetMem(SqlVar.Data, Len);

    if Len > 0 then
      Status := SQLBindCol(FHandle, I+1, SqlVar.TypeCode, SqlVar.Data, Len,
        @SqlVar.DataLen);
    if not Db2Transact.CheckError(SQL_HANDLE_STMT, FHandle, Status, FError) then
      goto ErrorProc;
  end;

  Status := SQLExecute(FHandle);
  if not Db2Transact.CheckError(SQL_HANDLE_STMT, FHandle, Status, FError) then
    goto ErrorProc;

  SetActive(True);
  SetStatus(qsTuplesOk);

  SetBOF(Status <> SQL_SUCCESS);
  SetEOF(Status <> SQL_SUCCESS);
  Next;
  Exit;

ErrorProc:

  for I := 0 to FOutSqlVars.ActualNum-1 do
  begin
    SqlVar := @FOutSqlVars.Variables[I];

    FreeMem(SqlVar.Data);
    SqlVar.Data := nil;
  end;

  SqlFreeHandle(SQL_HANDLE_STMT, FHandle);
  FHandle := 0;
end;

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

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

  { Free sql statement }
  SqlFreeHandle(SQL_HANDLE_STMT, FHandle);
  FHandle := 0;

  { Free allocated memory }
  for I := 0 to FOutSqlVars.ActualNum-1 do
  begin
    SqlVar := @FOutSqlVars.Variables[I];

    FreeMem(SqlVar.Data);
    SqlVar.Data := nil;
  end;
  FOutSqlVars.ActualNum := 0;
end;

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

function TDirDb2SqlQuery.Field(FieldNum: Integer): string;
var
  SqlVar: PSqlVar;
  OldSep: Char;
  TempDate: PSQL_DATE_STRUCT;
  TempTime: PSQL_TIME_STRUCT;
  TempDateTime: PSQL_TIMESTAMP_STRUCT;
  TempDate1: TDateTime;
  TempHandle: TBlobHandle;
begin
  Result := '';

  if not Active or (FieldNum >= FOutSqlVars.ActualNum) then Exit;
  SqlVar := @FOutSqlVars.Variables[FieldNum];

  if (SqlVar.DataLen < 0) or (SqlVar.Data = nil) then Exit;

  OldSep := DecimalSeparator;
  DecimalSeparator := '.';
  case SqlVar.ColType of
    ftInteger:
      Result := IntToStr(PLongInt(SqlVar.Data)^);
    ftFloat:
      Result := FloatToStr(PDouble(SqlVar.Data)^);
    ftString:
      Result := MemPas(SqlVar.Data, SqlVar.DataLen);
    ftDate:
      begin