sdoledb.pas

SQLDirect Component Library is a light-weight Borland Database Engine replacement for Borland Delphi

    stProcedureParams:
    begin
      cmd := TIOleDbSchemaProcParams.Create(Self);
      cmd.ObjPattern := AObjectName;
    end;
  end;

  if Assigned(cmd) then
  try
    cmd.ExecDirect('');
  except
    cmd.Free;
    raise;
  end;

  Result := cmd;
end;

{ TIOleDbCommand }
constructor TIOleDbCommand.Create(ASqlDatabase: TISqlDatabase);
begin
  inherited Create(ASqlDatabase);

  FICommandText := nil;
  FIMultipleResults:=nil;
  FIRowset      := nil;
  FIRowAccessor := nil;
  FRowBindPtr   := nil;
  FHRowAccessor := 0;
  FHParamAccessor:=0;
  FHRows        := nil;
  FIParamAccessor:= nil;
  FCurrRow      := 0;
  FRowsAffected := DB_COUNTUNAVAILABLE;
        // for optimization: exclude additional calls
  FPrefetchRows := SqlDatabase.PrefetchRows;
  FIsSingleConn := SqlDatabase.IsSingleConn;
	// by default IsSrvCursor = False  
  FIsSrvCursor  := UpperCase( Trim( SqlDatabase.Params.Values[szSERVERCURSOR] ) ) = STrueString;

  FFirstCalcFieldIdx := 0;
  FNextResults  := False;
end;

procedure TIOleDbCommand.Check(Status: HResult);
begin
  SqlDatabase.Check( Status );
end;

function TIOleDbCommand.GetSqlDatabase: TIOleDbDatabase;
begin
  Result := (inherited SqlDatabase) as TIOleDbDatabase;
end;

{ Marks a database handle as used by the current dataset }
procedure TIOleDbCommand.AcquireDBHandle;
begin
  if FIsSingleConn then
    SqlDatabase.ReleaseDBHandle(Self, True);
end;

{ Releases a database handle, which was used by the current dataset }
procedure TIOleDbCommand.ReleaseDBHandle;
begin
  if SqlDatabase.CurSqlCmd = Self then
    SqlDatabase.ReleaseDBHandle(nil, False);
end;

function TIOleDbCommand.FieldDataType(ExtDataType: Integer): TFieldType;
begin
  case ExtDataType of
    DBTYPE_I2:          Result := ftSmallint;
    DBTYPE_I4:          Result := ftInteger;
    DBTYPE_R4,
    DBTYPE_R8:          Result := ftFloat;
    DBTYPE_CY:          Result := ftCurrency;
    DBTYPE_BOOL:        Result := ftBoolean;
    DBTYPE_DECIMAL,
    DBTYPE_NUMERIC:     Result := ftFloat;
    DBTYPE_UI1,
    DBTYPE_I1,
    DBTYPE_UI2:         Result := ftSmallint;
    DBTYPE_UI4:         Result := ftInteger;
    DBTYPE_UI8:         Result := {$IFDEF SD_VCL4} ftLargeInt {$ELSE} ftInteger {$ENDIF};    
    DBTYPE_GUID:        Result := ftGuid;
    DBTYPE_DATE:        Result := ftDatetime;
    DBTYPE_BYTES:       Result := ftBytes;
    DBTYPE_WSTR,
    DBTYPE_STR:         Result := ftString;
    DBTYPE_DBDATE:      Result := ftDate;
    DBTYPE_DBTIME:      Result := ftTime;
    DBTYPE_DBTIMESTAMP: Result := ftDatetime;
  else
    Result := ftUnknown;
  end;
end;

function TIOleDbCommand.NativeDataSize(FieldType: TFieldType): Word;
const
  { Converting from TFieldType to Program Data Type(OLEDB) }
  OleDbDataSizeMap: array[TFieldType] of Word = ( 0,	// ftUnknown
	// ftString, ftSmallint, ftInteger, 	ftWord, 	ftBoolean
	0, SizeOf(SHORT), SizeOf(UINT), SizeOf(SHORT), SizeOf(SHORT),
	// ftFloat, 	ftCurrency, 		ftBCD, ftDate,	ftTime
        SizeOf(Double), SizeOf(Double),	0, 	0, 	0,
        // ftDateTime, ftBytes, ftVarBytes, ftAutoInc, ftBlob
        0, 		0, 	0, 	SizeOf(UINT), 0,
        // ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle
        0,	0,	0,   	0,	0,
        // ftTypedBinary, ftCursor
        0, 	0
{$IFDEF SD_VCL4},
	// ftFixedChar, ftWideString, ftLargeint,
        0,	0,	SizeOf(TInt64),
        // ftADT, ftArray, ftReference, ftDataSet
        0,	0,	0,	0
{$ENDIF}
{$IFDEF SD_VCL5},
        // ftOraBlob, ftOraClob, ftVariant,
        0,	0,	0,
        // ftInterface, ftIDispatch, ftGuid
        0,	0,	SizeOfGuidBinary
{$ENDIF}
{$IFDEF SD_VCL6},
        // ftTimeStamp, ftFMTBcd
        0,      0
{$ENDIF}
        );
begin
  case FieldType of
    ftDate: 	Result := SizeOf(TDBDate);
    ftTime: 	Result := SizeOf(TDBTime);
    ftDateTime:	Result := SizeOf(TDBTimeStamp);
  else
    Result := OleDbDataSizeMap[FieldType];
  end;
end;

function TIOleDbCommand.NativeDataType(FieldType: TFieldType): Integer;
const
  { Converting from TFieldType to C(Program) Data Type(ODBC) }
  OleDbDataTypeMap: array[TFieldType] of Integer = ( 0,	// ftUnknown
	// ftString, ftSmallint, ftInteger, ftWord, ftBoolean (TBooleanField.GetDataSize = 2)
	DBTYPE_STR, DBTYPE_I2, DBTYPE_I4, DBTYPE_UI2, DBTYPE_I2,
	// ftFloat, ftCurrency,   ftBCD, 	ftDate, 	ftTime
        DBTYPE_R8, DBTYPE_R8,   0, DBTYPE_DBDATE, DBTYPE_DBTIME,
        // ftDateTime, 		ftBytes, ftVarBytes, ftAutoInc, ftBlob
        DBTYPE_DBTIMESTAMP, DBTYPE_BYTES,DBTYPE_BYTES, DBTYPE_I4, DBTYPE_BYTES,
        // ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle
        DBTYPE_STR, 0, 0,	0,	0,
        // ftTypedBinary, ftCursor
        0,	0
{$IFDEF SD_VCL4},
	// ftFixedChar, ftWideString, ftLargeint,
        0,	0,	DBTYPE_I8,
        // ftADT, ftArray, ftReference, ftDataSet
        0,	0,	0,	0
{$ENDIF}
{$IFDEF SD_VCL5},
        // ftOraBlob, ftOraClob, ftVariant,
        0,	0,	0,
        // ftInterface, ftIDispatch, ftGuid
        0,	0,	DBTYPE_GUID
{$ENDIF}
{$IFDEF SD_VCL6},
        // ftTimeStamp, ftFMTBcd
        0,      0
{$ENDIF}
        );
begin
  Result := OleDbDataTypeMap[FieldType];
end;

function TIOleDbCommand.OleDbDataSourceType(FieldType: TFieldType): string;
const
  { Converting from TFieldType to Program Data Type(OLEDB) }
  OleDbDataSourceTypeMap: array[TFieldType] of string = ( '',	// ftUnknown
	// ftString, ftSmallint, ftInteger, ftWord, ftBoolean (TBooleanField.GetDataSize = 2)
	'DBTYPE_CHAR', 'DBTYPE_I2', 'DBTYPE_I4', 'DBTYPE_UI2', 'DBTYPE_I2',
	// ftFloat, ftCurrency,   ftBCD, 	ftDate, 	ftTime
        'DBTYPE_R8', 'DBTYPE_R8',   '', 'DBTYPE_DBDATE', 'DBTYPE_DBTIME',
        // ftDateTime, 		ftBytes, ftVarBytes, ftAutoInc, ftBlob
        'DBTYPE_DBTIMESTAMP', 'DBTYPE_BINARY','DBTYPE_VARBINARY', 'DBTYPE_I4', 'DBTYPE_LONGVARBINARY',
        // ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle
        'DBTYPE_LONGVARCHAR', '', '',	'',	'',
        // ftTypedBinary, ftCursor
        '',	''
{$IFDEF SD_VCL4},
	// ftFixedChar, ftWideString, ftLargeint,
        '',	'',	'DBTYPE_I8',
        // ftADT, ftArray, ftReference, ftDataSet
        '',	'',	'',	''
{$ENDIF}
{$IFDEF SD_VCL5},
        // ftOraBlob, ftOraClob, ftVariant,
        '',	'',	'',
        // ftInterface, ftIDispatch, ftGuid
        '',	'',	'DBTYPE_GUID'
{$ENDIF}
{$IFDEF SD_VCL6},
        // ftTimeStamp, ftFMTBcd
        '',      ''
{$ENDIF}
        );
begin
  Result := OleDbDataSourceTypeMap[FieldType];
end;

function TIOleDbCommand.RequiredCnvtFieldType(FieldType: TFieldType): Boolean;
begin
  Result := IsDateTimeType(FieldType) or (FieldType = ftGuid);
end;

procedure TIOleDbCommand.Connect;
begin
  Check( SqlDatabase.DBCreateCommand.CreateCommand(nil, IID_ICommandText, IUnknown(FICommandText)) );
end;

procedure TIOleDbCommand.Disconnect(Force: Boolean);
begin
        // release IParamAccessor before FICommandText
  FreeParamsBuffer;
  ReleaseDBHandle;
    
  FICommandText := nil;
  ReleaseRowset;
  FIMultipleResults:=nil;
end;

function TIOleDbCommand.GetHandle: PSDCursor;
begin
  Result := nil;
        // FICommandText is required in DoPrepare, but TIOleDbSchemaCommand do not use ICommandText interface at all
  if Assigned( FICommandText ) or ((Self is TIOleDbSchemaCommand) and (NativeCommand <> '')) then
    Result := Self;
end;

procedure TIOleDbCommand.CloseResultSet;
begin
  if FNextResults then begin
    ClearFieldDescs;
    Exit;
  end;

  ReleaseDBHandle;
  ReleaseRowset;
  FIMultipleResults:=nil;
end;

procedure TIOleDbCommand.DoPrepare(Value: string);
var
  pICommandPrepare: ICommandPrepare;
  hr: HResult;
begin
  AcquireDBHandle;

  SetICommandText(Value);
  SetICommandProps;

  pICommandPrepare := nil;
  try
    Check( FICommandText.QueryInterface(IID_ICommandPrepare, pICommandPrepare) );
    hr := pICommandPrepare.Prepare(0);
        // Prepare can return "Parameter Information cannot be derived from SQL statement with sub-select"
        // or "Syntax error or AV" depending on version of MSSQL provider, in case of SQL with with sub-select and a parameter placeholder
        // For example: "select F from T where F in (select F from T where F = :p)"
        // MSSQL provider returns the following "Unspecified error" (E_FAIL) in this case.
        // The same error code E_FAIL is returned, when "Connection is busy ..." or "Syntax error or AV" errors happen
    if (hr = E_FAIL) and SqlDatabase.IsMSSQLProv then begin
      SetICmdParameterInfo;
      hr := pICommandPrepare.Prepare(0);
    end;
    Check( hr );
  finally
    pICommandPrepare := nil;
  end;
end;

procedure TIOleDbCommand.SetICommandText(Value: string);
var
  guidDialect: TGUID;
  pwszCmd: PWideChar;
  sCmd: string;
begin
  if not Assigned( FICommandText ) then
    Connect;

  if CommandType = ctStoredProc then begin
    if Assigned(Params) and (Params.Count = 0) then
      InitParamList;

    sCmd := CreateProcedureCallCommand( Value, Params,
                Pos('Microsoft SQL Server', SqlDatabase.GetVersionString) = 0 );
  end else	// ctQuery
    sCmd := ReplaceParamMarkers( Value, Params );

  guidDialect := DBGUID_DEFAULT;
  pwszCmd := nil;
  try
    pwszCmd := AllocWideChar( sCmd );
    Check( FICommandText.SetCommandText({$IFNDEF SD_VCL6}@{$ENDIF}guidDialect, pwszCmd) );
  finally
    FreeWideChar( pwszCmd );
  end;

  SetNativeCommand(sCmd);
end;

procedure TIOleDbCommand.DoExecDirect(ACommandValue: string);
begin
  AcquireDBHandle;

  SetICommandText(ACommandValue);
  SetICommandProps;
//  SetICmdParameterInfo;

  AllocParamsBuffer;
  BindParamsBuffer;

  InternalExecute(True);
end;

procedure TIOleDbCommand.Execute;
begin
        // FIRowSet can be created in GetFieldFescs, when a statement could be not prepared by some reason (query with sub-select or schema rowset)
  if not Assigned(FIRowSet) then begin
    FreeParamsBuffer;
    AllocParamsBuffer;
    BindParamsBuffer;

    DoExecute;
  end;

  if Assigned(FIRowSet) and (FieldDescs.Count = 0) then
    InitFieldDescs;
  if FieldDescs.Count > 0 then begin
    if FieldsBuffer = nil then
      AllocFieldsBuffer;
	// it's required to set a select buffer after executing of the statement
    SetFieldsBuffer;
  end;
end;

procedure TIOleDbCommand.DoExecute;
begin
  InternalExecute(True);
end;

procedure TIOleDbCommand.InternalExecute(bFieldDescribe: Boolean);
var
  p: DBPARAMS;
  hr: HResult;
begin
  FRowsAffected := DB_COUNTUNAVAILABLE;
  if Params.Count > 0 then begin
    p.pData := ParamsBuffer;
    p.cParamSets := 1;
    p.HACCESSOR := FHParamAccessor;
  end else begin
    p.pData := nil;
    p.cParamSets := 0;
    p.HACCESSOR := 0;
  end;
        // server cursor supports only one rowset
  if (CommandType = ctStoredProc) and not IsSrvCursor then begin
        // do not execute, when the next(second or other) result set is processed
    if not FNextResults then begin
      Check( FICommandText.Execute(nil, IID_IMultipleResults, p, @FRowsAffected, PIUnknown(@FIMultipleResults)) );
      if Assigned( FIMultipleResults ) then
        repeat
          hr := FIMultipleResults.GetResult(nil, 0, IID_IRowset, @FRowsAffected, PIUnknown(@FIRowset));