zdirorasql.pas

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

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

{ Execute an SQL statement }
function TDirOraSqlQuery.Execute: LongInt;
label ErrorProc;
var
  OraConnect: TDirOraSqlConnect;
  OraTransact: TDirOraSqlTransact;
  Status: Integer;
{$IFDEF DELETE_QUERY_SPACES}
  Temp: string;
{$ENDIF}
  TempRows: ub4;
begin
  inherited Execute;

  SetStatus(qsFail);
  Result := 0;
  if Assigned(Connect) and Assigned(Transact) and Transact.Active then
  begin
    OraConnect := TDirOraSqlConnect(Connect);
    OraTransact := TDirOraSqlTransact(Transact);

    FErrorHandle := nil;
    OCIHandleAlloc(OraConnect.Handle, FErrorHandle, OCI_HTYPE_ERROR, 0, nil);
    FHandle := nil;
    OCIHandleAlloc(OraConnect.Handle, FHandle, OCI_HTYPE_STMT, 0, nil);

{$IFDEF DELETE_QUERY_SPACES}
    Temp := ClearSpaces(Sql);
    Status := OCIStmtPrepare(FHandle, FErrorHandle, PChar(Temp), Length(Temp),
      OCI_NTV_SYNTAX, OCI_DEFAULT);
{$ELSE}
    Status := OCIStmtPrepare(FHandle, FErrorHandle, PChar(Sql), Length(Sql),
      OCI_NTV_SYNTAX, OCI_DEFAULT);
{$ENDIF}
    if not OraTransact.CheckError(FErrorHandle, Status, FError) then
      goto ErrorProc;

    Status := OCIStmtExecute(OraTransact.Handle, FHandle, FErrorHandle, 1, 0,
      nil, nil, OCI_DEFAULT);
    if not OraTransact.CheckError(FErrorHandle, Status, FError) then
      goto ErrorProc;

    SetStatus(qsCommandOk);
    TempRows := 0;
    OCIAttrGet(FHandle, OCI_HTYPE_STMT, @TempRows, nil, OCI_ATTR_ROW_COUNT,
      FErrorHandle);
    SetAffectedRows(TempRows);

ErrorProc:
    MonitorList.InvokeEvent(Sql, Error, Error <> '');
    OCIHandleFree(FHandle, OCI_HTYPE_STMT);
    FHandle := nil;
    OCIHandleFree(FHandle, OCI_HTYPE_ERROR);
    FErrorHandle := nil;
  end;
end;

{ Execute an SQL statement with params }
function TDirOraSqlQuery.ExecuteParams(Params: TVarRecArray; ParamCount: Integer): LongInt;
label ErrorProc;
var
  I: Integer;
  SqlVar: PSqlVar;
  OraConnect: TDirOraSqlConnect;
  OraTransact: TDirOraSqlTransact;
  Status: Integer;
{$IFDEF DELETE_QUERY_SPACES}
  Temp: string;
{$ENDIF}
  BindHandle: POCIBind;
  TempRows: ub4;
begin
  inherited Execute;

  SetStatus(qsFail);
  Result := 0;
  if Assigned(Connect) and Assigned(Transact) and Transact.Active then
  begin
    OraConnect := TDirOraSqlConnect(Connect);
    OraTransact := TDirOraSqlTransact(Transact);

    FErrorHandle := nil;
    OCIHandleAlloc(OraConnect.Handle, FErrorHandle, OCI_HTYPE_ERROR, 0, nil);
    FHandle := nil;
    OCIHandleAlloc(OraConnect.Handle, FHandle, OCI_HTYPE_STMT, 0, nil);

{$IFDEF DELETE_QUERY_SPACES}
    Temp := ClearSpaces(Sql);
    Status := OCIStmtPrepare(FHandle, FErrorHandle, PChar(Temp), Length(Temp),
      OCI_NTV_SYNTAX, OCI_DEFAULT);
{$ELSE}
    Status := OCIStmtPrepare(FHandle, FErrorHandle, PChar(Sql), Length(Sql),
      OCI_NTV_SYNTAX, OCI_DEFAULT);
{$ENDIF}
    if not OraTransact.CheckError(FErrorHandle, Status, FError) then
      goto ErrorProc;

    { Resize SQLVERS structure if needed }
    if ParamCount > FInSqlVars.AllocNum then
    begin
      ReallocMem(FInSqlVars, SqlVarsLength(FInSqlVars.ActualNum));
      FInSqlVars.AllocNum := FInSqlVars.ActualNum;
    end;

    { Allocate memory for result set }
    for I := 0 to ParamCount-1 do
    begin
(*
      case VarType(Params[I]) of
        varInteger, varSmallInt:
          Status := OCIBindByPos(FHandle, BindHandle, FErrorHandle, I+1,
            @Params[I], 0, SQLT_INT, nil, nil, nil, 0, nil, OCI_DATA_AT_EXEC);
        varDouble:
          Status := OCIBindByPos(FHandle, BindHandle, FErrorHandle, I+1,
            @Params[I], 0, SQLT_FLT, nil, nil, nil, 0, nil, OCI_DATA_AT_EXEC);
        varOleStr, varString:
          Status := OCIBindByPos(FHandle, BindHandle, FErrorHandle, I+1,
            PChar(Params[I]), Length(Params[I]), SQLT_STR, nil, nil, nil,
            0, nil, OCI_DATA_AT_EXEC);
        else
          Status := OCIBindByPos(FHandle, BindHandle, FErrorHandle, I+1,
            @Params[I], 0, SQLT_BLOB, nil, nil, nil, 0, nil, OCI_DATA_AT_EXEC);
      end;
*)
      SqlVar := @FInSqlVars.Variables[I];
      GetMem(SqlVar.Data, SizeOf(POCILobLocator));

      Status := OCIDescriptorAlloc(OraConnect.Handle, PPOCIDescriptor(SqlVar.Data)^,
        OCI_DTYPE_LOB, 0, nil);
      if Status <> OCI_SUCCESS then
        goto ErrorProc;
      Inc(FInSqlVars.ActualNum);

      TempRows := 0;
      Status := OCIAttrSet(PPOCIDescriptor(SqlVar.Data)^, OCI_DTYPE_LOB, @TempRows,
        0, OCI_ATTR_LOBEMPTY, OraTransact.ErrorHandle);
      if not OraTransact.CheckError(FErrorHandle, Status, FError) then
        goto ErrorProc;

      Status := OCIBindByPos(FHandle, BindHandle, FErrorHandle, I+1,
        PPOCIDescriptor(SqlVar.Data)^, 0, SQLT_BLOB, nil, nil, nil, 0,
        nil, OCI_DATA_AT_EXEC);
      if not OraTransact.CheckError(FErrorHandle, Status, FError) then
        goto ErrorProc;

      TempRows := Length(string(Params[I].VAnsiString));
      Status := OCILobWrite(OraTransact.Handle, OraTransact.ErrorHandle,
        PPOCIDescriptor(SqlVar.Data)^, TempRows, 1,
        PChar(string(Params[I].VAnsiString)), TempRows, OCI_ONE_PIECE, nil,
        nil, 0, SQLCS_IMPLICIT);
      if not OraTransact.CheckError(OraTransact.ErrorHandle, Status, FError) then
        goto ErrorProc;
    end;

    Status := OCIStmtExecute(OraTransact.Handle, FHandle, FErrorHandle, 1, 0,
      nil, nil, OCI_DEFAULT);
    if not OraTransact.CheckError(FErrorHandle, Status, FError) then
      goto ErrorProc;

    SetStatus(qsCommandOk);
    TempRows := 0;
    OCIAttrGet(FHandle, OCI_HTYPE_STMT, @TempRows, nil, OCI_ATTR_ROW_COUNT,
      FErrorHandle);
    SetAffectedRows(TempRows);

ErrorProc:
    for I := 0 to FInSqlVars.ActualNum-1 do
    begin
      SqlVar := @FInSqlVars.Variables[I];
      OCIDescriptorFree(PPOCIDescriptor(SqlVar.Data)^, OCI_DTYPE_LOB);
      FreeMem(SqlVar.Data);
    end;
    MonitorList.InvokeEvent(Sql, Error, Error <> '');
    OCIHandleFree(FHandle, OCI_HTYPE_STMT);
    FHandle := nil;
    OCIHandleFree(FHandle, OCI_HTYPE_ERROR);
    FErrorHandle := nil;
  end;
end;

{ Open a sql query with result set }
procedure TDirOraSqlQuery.Open;
label ErrorProc;
var
  I, Status: Integer;
  OraConnect: TDirOraSqlConnect;
  OraTransact: TDirOraSqlTransact;
  SqlVar: PSqlVar;
{$IFDEF DELETE_QUERY_SPACES}
  Temp: string;
{$ENDIF}
  Prec, Scale, 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;

  OraConnect := TDirOraSqlConnect(Connect);
  OraTransact := TDirOraSqlTransact(Transact);

  { Allocate an sql statement }
  FHandle := nil;
  OCIHandleAlloc(OraConnect.Handle, FHandle, OCI_HTYPE_STMT, 0, nil);
  FErrorHandle := nil;
  OCIHandleAlloc(OraConnect.Handle, FErrorHandle, OCI_HTYPE_ERROR, 0, nil);

  { Prepare an sql statement }
{$IFDEF DELETE_QUERY_SPACES}
  Temp := ClearSpaces(Sql);
  Status := OCIStmtPrepare(FHandle, FErrorHandle, PChar(Temp), Length(Temp),
    OCI_NTV_SYNTAX, OCI_DEFAULT);
{$ELSE}
  Status := OCIStmtPrepare(FHandle, FErrorHandle, PChar(Sql), Length(Sql),
    OCI_NTV_SYNTAX, OCI_DEFAULT);
{$ENDIF}
  if not OraTransact.CheckError(FErrorHandle, Status, FError) then
    goto ErrorProc;

  Status := OCIStmtExecute(OraTransact.Handle, FHandle, FErrorHandle, 1, 0,
    nil, nil, OCI_DESCRIBE_ONLY);
  if not OraTransact.CheckError(FErrorHandle, Status, FError) then
    goto ErrorProc;

  { Resize SQLVERS structure if needed }
  OCIAttrGet(FHandle, OCI_HTYPE_STMT, @FOutSqlVars.ActualNum, nil,
    OCI_ATTR_PARAM_COUNT, FErrorHandle);
  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.Handle := nil;

    OCIParamGet(FHandle, OCI_HTYPE_STMT, FErrorHandle, SqlVar.Handle, I+1);
    OCIAttrGet(SqlVar.Handle, OCI_DTYPE_PARAM, @SqlVar.DataSize, nil,
      OCI_ATTR_DATA_SIZE, FErrorHandle);
    OCIAttrGet(SqlVar.Handle, OCI_DTYPE_PARAM, @SqlVar.DataType, nil,
      OCI_ATTR_DATA_TYPE, FErrorHandle);

    case SqlVar.DataType of
      SQLT_CHR, SQLT_VCS, SQLT_AFC:
        begin
          if SqlVar.DataSize < 255 then
            SqlVar.ColType := ftString
          else
            SqlVar.ColType := ftMemo;
        end;
      SQLT_NUM:
        begin
          Prec := 0;
          OCIAttrGet(SqlVar.Handle, OCI_DTYPE_PARAM, @Prec, nil,
            OCI_ATTR_PRECISION, FErrorHandle);
          Scale := 0;
          OCIAttrGet(SqlVar.Handle, OCI_DTYPE_PARAM, @Scale, nil,
            OCI_ATTR_SCALE, FErrorHandle);

          if (Scale = 0) and (Prec <> 0) and (Prec <= 38) then
            SqlVar.ColType := ftInteger
          else
            SqlVar.ColType := ftFloat;
        end;
      SQLT_INT, _SQLT_PLI:
        SqlVar.ColType := ftInteger;
      SQLT_LNG:
        SqlVar.ColType := ftMemo;
      SQLT_RID, SQLT_RDD:
        begin
          SqlVar.ColType := ftString;
          SqlVar.DataSize := 20;
        end;
      SQLT_DAT:
        SqlVar.ColType := ftDateTime;
      SQLT_BIN, SQLT_LBI:
        SqlVar.ColType := ftBlob;
      SQLT_CLOB:
        SqlVar.ColType := ftMemo;
      SQLT_BLOB:
        SqlVar.ColType := ftBlob;
      else
        SqlVar.ColType := ftUnknown;
    end;

    SqlVar.TypeCode := SqlVar.DataType;
    Len := 0;
    case SqlVar.ColType of
      ftInteger:
        begin
          SqlVar.TypeCode := SQLT_INT;
          Len := SizeOf(LongInt);
        end;
      ftFloat:
        begin
          SqlVar.TypeCode := SQLT_FLT;
          Len := SizeOf(Double);
        end;
      ftDateTime:
        Len := 7;
      ftString:
        begin
          SqlVar.TypeCode := SQLT_STR;
          Len := SqlVar.DataSize + 1;
        end;
      ftBlob, ftMemo:
        if not (SqlVar.TypeCode in [SQLT_CLOB, SQLT_BLOB]) then
        begin
          if SqlVar.ColType = ftMemo then
            SqlVar.TypeCode := SQLT_LVC
          else SqlVar.TypeCode := SQLT_LVB;
          if SqlVar.DataSize = 0 then
            Len := 1024 * 128 + SizeOf(Integer)
          else Len := SqlVar.DataSize + SizeOf(Integer);
        end else
          Len := SizeOf(POCILobLocator);
      ftUnknown:
        Continue;
    end;

    GetMem(SqlVar.Data, Len);
    if SqlVar.TypeCode in [SQLT_BLOB, SQLT_CLOB] then
      OCIDescriptorAlloc(OraConnect.Handle, PPOCIDescriptor(SqlVar.Data)^, OCI_DTYPE_LOB, 0, nil);
    Status := OCIDefineByPos(FHandle, SqlVar.Define, FErrorHandle, I+1,
      SqlVar.Data, Len, SqlVar.TypeCode, @SqlVar.Indicator, nil, nil, OCI_DEFAULT);
    if not OraTransact.CheckError(FErrorHandle, Status, FError) then
      goto ErrorProc;
  end;

  { Execute a query }
  Status := OCIStmtExecute(OraTransact.Handle, FHandle, FErrorHandle, 1, 0,
    nil, nil, OCI_DEFAULT);
  if not (Status in [OCI_SUCCESS, OCI_NO_DATA]) then
  begin
    OraTransact.CheckError(FErrorHandle, Status, FError);
    goto ErrorProc;
  end;

  SetActive(True);
  SetStatus(qsTuplesOk);
  SetBOF(Status <> OCI_SUCCESS);
  SetEOF(Status <> OCI_SUCCESS);
  if Status = OCI_SUCCESS then
    SetRecNo(1);
  Exit;

ErrorProc:
  for I := 0 to FOutSqlVars.ActualNum-1 do
  begin
    SqlVar := @FOutSqlVars.Variables[I];
    if SqlVar.TypeCode in [SQLT_BLOB, SQLT_CLOB] then
      OCIDescriptorFree(PPOCIDescriptor(SqlVar.Data)^, OCI_DTYPE_LOB);
    FreeMem(SqlVar.Data);
    SqlVar.Data := nil;
  end;

  OCIHandleFree(FHandle, OCI_HTYPE_STMT);
  FHandle := nil;
  OCIHandleFree(FErrorHandle, OCI_HTYPE_ERROR);
  FErrorHandle := nil;
end;

{ Close a sql query with result set }
procedure TDirOraSqlQuery.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 }
  OCIHandleFree(FHandle, OCI_HTYPE_STMT);
  FHandle := nil;
  OCIHandleFree(FErrorHandle, OCI_HTYPE_ERROR);
  FErrorHandle := nil;

  { Free allocated memory }
  for I := 0 to FOutSqlVars.ActualNum-1 do
  begin
    SqlVar := @FOutSqlVars.Variables[I];
    if SqlVar.TypeCode in [SQLT_BLOB, SQLT_CLOB] then
      OCIDescriptorFree(PPOCIDescriptor(SqlVar.Data)^, OCI_DTYPE_LOB);
    FreeMem(SqlVar.Data);
    SqlVar.Data := nil;
  end;
  FOutSqlVars.ActualNum := 0;
end;

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

function TDirOraSqlQuery.Field(FieldNum: Integer): string;
var
  SqlVar: PSqlVar;
  OldSep: Char;
begin
  Result := '';
  if not Active or (FieldNum >= FOutSqlVars.ActualNum) then Exit;
  SqlVar := @FOutSqlVars.Variables[FieldNum];

  if (SqlVar.Indicator < 0) or (SqlVar.Data = nil) then Exit;
  OldSep := DecimalSeparator;
  DecimalSeparator := '.';
  case SqlVar.TypeCode of
    SQLT_INT:
      Result := IntToStr(PLongInt(SqlVar.Data)^);
    SQLT_FLT: