sdoledb.pas

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

          if hr = DB_S_NORESULT then
            Break;
        until Assigned(FIRowset);       // locate the first non-void result set of procedure
    end;
  end else
    Check( FICommandText.Execute(nil, IID_IRowset, p, @FRowsAffected, PIUnknown(@FIRowset)) );

  	// if field descriptions were not initialized before Execute (for InternalInitFieldDefs)
  if bFieldDescribe and (FieldDescs.Count = 0) and Assigned(FIRowset) then
    InitFieldDescs;
end;

function TIOleDbCommand.GetRowsAffected: Integer;
begin
  Result := FRowsAffected;
end;

function TIOleDbCommand.ResultSetExists: Boolean;
var
  pIColumnsInfo: IColumnsInfo;
  nColumns: UINT;
  ColInfoPtr: PDBColumnInfo;
  StringsBufferPtr: PWideChar;
begin
  Result := (CommandType = ctStoredProc) or (FieldDescs.Count > 0) or
            Assigned(FIRowset) or (Self is TIOleDbSchemaCommand);
  if Result or not Assigned(FICommandText) then
    Exit;

  Check( FICommandText.QueryInterface(IID_IColumnsInfo, pIColumnsInfo) );
  try
    if Assigned(pIColumnsInfo) then begin
      Check( pIColumnsInfo.GetColumnInfo(nColumns, ColInfoPtr, StringsBufferPtr) );
      Result := nColumns > 0;
    end;
  finally
    if Assigned(ColInfoPtr) then
      CoTaskMemFree(ColInfoPtr);
    if Assigned(StringsBufferPtr) then
      CoTaskMemFree(StringsBufferPtr);
    pIColumnsInfo := nil;
  end;
end;

procedure TIOleDbCommand.GetFieldDescs(Descs: TSDFieldDescList);
var
  pIColumnsInfo: IColumnsInfo;
  i, nColumns: UINT;
  ColInfoPtr: PDBColumnInfo;
  ColInfo: DBColumnInfo;
  StringsBufferPtr: PWideChar;
  FieldDesc: TSDFieldDesc;
  ft: TFieldType;
  sColName: string;
begin
  pIColumnsInfo := nil;
  ColInfoPtr := nil;
  StringsBufferPtr := nil;
  if Assigned(FIRowset) then
    Check( FIRowset.QueryInterface(IID_IColumnsInfo, pIColumnsInfo) )
  else if Assigned(FICommandText) and not ((CommandType = ctStoredProc) and FNextResults) then
    Check( FICommandText.QueryInterface(IID_IColumnsInfo, pIColumnsInfo) )
  else begin
    if not Assigned(FIRowset) then
      DoExecute;        // create IRowset, if TIOleDbSchemaCommand is used
    Check( FIRowset.QueryInterface(IID_IColumnsInfo, pIColumnsInfo) );
  end;
  ASSERT( pIColumnsInfo <> nil );
  try
    Check( pIColumnsInfo.GetColumnInfo(nColumns, ColInfoPtr, StringsBufferPtr) );

    if nColumns > 0 then        // to exclude 'Integer overflow', when UINT(nColumns)-1
    for i:=0 to nColumns-1 do begin
      ColInfo := DBColumnInfo( IncPtr(ColInfoPtr, i * SizeOf(ColInfo))^ );

      sColName := ColInfo.pwszName;
      ft := FieldDataType(ColInfo.wType);
      if ft = ftUnknown then
        DatabaseErrorFmt( SBadFieldType, [sColName] );
        // if the column contains very long data and the provider supports reading data through a storage interface
      if (ColInfo.dwFlags and DBCOLUMNFLAGS_ISLONG) <> 0 then
        if ft = ftString
        then ft := ftMemo
        else ft := ftBlob;

      if ft in [ftString] then
        Inc( ColInfo.ulColumnSize );     // increase buffer for null-terminator

      FieldDesc := Descs.AddFieldDesc;
      with FieldDesc do begin
        FieldName	:= sColName;
        FieldNo		:= ColInfo.iOrdinal;
        FieldType	:= ft;
        DataType	:= ColInfo.wType;
       	// it's necessary to save ColSize for varying string/byte and pseudo-blob fields
        if IsRequiredSizeTypes( ft ) //or IsPseudoBlob( FieldDesc )
        then DataSize	:= ColInfo.ulColumnSize
        else DataSize	:= NativeDataSize(FieldType);	// for SQL_INTEGER ColSize = 10 (instead of 4) (for MSSQL ODBC driver)
        Precision	:= ColInfo.bPrecision;
        Scale	        := ColInfo.bScale;
    	// if NullOk = 0 then null values are not permitted for the column (Required = True)
        Required	:= (ColInfo.dwFlags and DBCOLUMNFLAGS_ISNULLABLE) = 0;
      end;
    end;
    FFirstCalcFieldIdx := Descs.Count;
  finally
    if Assigned(ColInfoPtr) then
      CoTaskMemFree(ColInfoPtr);
    if Assigned(StringsBufferPtr) then
      CoTaskMemFree(StringsBufferPtr);
    pIColumnsInfo := nil;
  end;
end;

function TIOleDbCommand.CnvtDateTime2DBDateTime(ADataType: TFieldType; Value: TDateTime; Buffer: TSDValueBuffer; BufSize: Integer): Integer;
var
  Year: Smallint;
  wYear, Month, Day, Hour, Min, Sec, MSec: Word;
  ptr: TSDPtr;
  t: TDBTime;
  d: TDBDate;
  ts:TDBTimeStamp;
begin
  Result := 0;

  if NativeDataSize(ADataType) > BufSize then
    DatabaseError(SInsufficientIDateTimeBufSize);
	// it's necessary for ftDate
  Hour	:= 0;
  Min	:= 0;
  Sec	:= 0;
  Year  := 0;

  if ADataType in [ftTime, ftDateTime] then
    DecodeTime(Value, Hour, Min, Sec, MSec);
  if ADataType in [ftDate, ftDateTime] then begin
    DecodeDate(Value, wYear, Month, Day);
    Year := wYear;
  end;

  ptr := Buffer;

  case ADataType of
    ftTime:
      begin
      	t.hour	:= Hour;
        t.minute:= Min;
        t.second:= Sec;
{$IFDEF SD_CLR}
        Marshal.StructureToPtr( t, ptr, False );
{$ELSE}
        TDBTime(ptr^)	:= t;
{$ENDIF}
        Result := SizeOf(TDBTime);
      end;
    ftDate:
      begin
        d.year	:= Year;
        d.month	:= Month;
        d.day	:= Day;
{$IFDEF SD_CLR}
        Marshal.StructureToPtr( d, ptr, False );
{$ELSE}
        TDBDate(ptr^)	:= d;
{$ENDIF}
        Result := SizeOf(TDBDate);
      end;
    ftDateTime:
      begin
        ts.hour		:= Hour;
        ts.minute	:= Min;
        ts.second	:= Sec;
        ts.fraction	:= MSec*1000*1000;
        ts.year		:= Year;
        ts.month	:= Month;
        ts.day		:= Day;
{$IFDEF SD_CLR}
        Marshal.StructureToPtr( ts, ptr, False );
{$ELSE}
        TDBTimeStamp(ptr^) := ts;
{$ENDIF}
        Result := SizeOf(TDBTimeStamp);
      end
  end;
end;

procedure TIOleDbCommand.AllocParamsBuffer;
var
  nParams: Integer;
begin
  inherited;

  if not Assigned(Params) then
    Exit;
  nParams := Params.Count;
  if nParams > 0 then begin
    FParamBindPtr := SafeReallocMem( nil, nParams * SizeOf(DBBINDING) );
    SafeInitMem( FParamBindPtr, nParams * SizeOf(DBBINDING), 0 );
  end;
end;

function TIOleDbCommand.GetParamsBufferSize: Integer;
var
  i, nBlobCount: Integer;
begin
  Result := inherited GetParamsBufferSize;
  FBlobParamsBufferOff := Result;

  if not Assigned(Params) then
    Exit;

  nBlobCount := 0;
  for i := 0 to Params.Count -1 do
    if IsBlobType(Params[i].DataType) then
      Inc(nBlobCount);
	// buffers to save pointer to data of Blobs parameters
  Result := FBlobParamsBufferOff + nBlobCount * SizeOf(TSDPtr);
end;

procedure TIOleDbCommand.FreeParamsBuffer;
var
  i, nBlobCount: Integer;
  BlobPtr: TSDPtr;
begin
  if FHParamAccessor <> 0 then
    Check( FIParamAccessor.ReleaseAccessor(FHParamAccessor, nil) );
  FHParamAccessor := 0;
  FIParamAccessor := nil;

  FParamBindPtr := SafeReallocMem( FParamBindPtr, 0 );
  if Assigned(ParamsBuffer) and Assigned(Params) then begin
    nBlobCount := 0;
          // release blob buffers, which was allocated using IMalloc
    for i:=0 to Params.Count-1 do begin
      if not IsBlobType(Params[i].DataType) then
        Continue;
      BlobPtr := HelperMemReadPtr( ParamsBuffer, FBlobParamsBufferOff + nBlobCount*SizeOf(BlobPtr) );
      CoTaskMemFree( BlobPtr );

      Inc(nBlobCount);
    end;
  end;

  inherited;
end;

procedure TIOleDbCommand.BindParamsBuffer;
var
  BindPtr: PDBBinding;
  BindDataType, nBlobCount: Integer;
  CurPtr, DataPtr: TSDValueBuffer;
  i, DataLen, nOffset, nStrLen: Integer;
  FieldInfo: TSDFieldInfo;
  BlobPtr: TSDPtr;
begin
  if not Assigned( Params ) or ( Params.Count = 0 ) then
    Exit;

  if not Assigned( ParamsBuffer ) then
    AllocParamsBuffer;

  ASSERT( FParamBindPtr <> nil );

  nOffset := 0;
  nBlobCount := 0;

  for i:=0 to Params.Count-1 do begin
    CurPtr := IncPtr( ParamsBuffer, nOffset );
    FieldInfo := GetFieldInfoStruct(CurPtr, 0);
    FieldInfo.DataSize := 0;
    BindDataType := NativeDataType(Params[i].DataType);
    DataLen := NativeParamSize( Params[i] );
    DataPtr := IncPtr( CurPtr, SizeOf(TSDFieldInfo) );

    if Params[i].IsNull then
      FieldInfo.FetchStatus := DBSTATUS_S_ISNULL
    else
      FieldInfo.FetchStatus := DBSTATUS_S_OK;
    FieldInfo.DataSize := DataLen;

    case Params[i].DataType of
      ftString:
        begin
          if DataLen > 0 then begin
                // in case of procedure DataLen can be more than actual length of string
            nStrLen := MinIntValue(DataLen-1, Length(Params[i].AsString));
            HelperMemWriteString( DataPtr, 0, Params[i].AsString, nStrLen );
            HelperMemWriteByte( DataPtr, nStrLen, 0 );
                // set actual length without a null-termination character (DataLen is max parameter buffer in case of procedure)
            FieldInfo.DataSize := nStrLen;
          end;
        end;
{$IFDEF SD_VCL5}
      ftGuid:
        if DataLen > 0 then begin
          if Params[i].AsString <> '' then
            PGUID( DataPtr )^ := StringToGuid( Params[i].AsString )
          else begin
            FieldInfo.FetchStatus := DBSTATUS_S_ISNULL;
            FieldInfo.DataSize := 0;
          end;
        end;
{$ENDIF}
      ftBytes,
      ftVarBytes:
        if DataLen > 0 then begin
          SafeInitMem( DataPtr, DataLen, 0 );
          Params[i].GetData( DataPtr );
        end;
      ftBoolean:
        if DataLen > 0 then HelperMemWriteInt16( DataPtr, 0, Ord( Params[i].AsBoolean ) );
      ftInteger,
      ftAutoInc:
        if DataLen > 0 then HelperMemWriteInt32( DataPtr, 0, Params[i].AsInteger );
      ftSmallInt:
        if DataLen > 0 then HelperMemWriteInt16( DataPtr, 0, Params[i].AsInteger );
{$IFDEF SD_VCL4}
      ftLargeInt:
        if DataLen > 0 then HelperMemWriteInt64( DataPtr, 0, Params[i].AsInteger );
{$ENDIF}
      ftDate, ftTime, ftDateTime:
        if DataLen > 0 then CnvtDateTime2DBDateTime(Params[i].DataType, Params[i].AsDateTime, DataPtr, NativeDataSize(Params[i].DataType));
      ftCurrency,
      ftFloat:
        if DataLen > 0 then HelperMemWriteDouble( DataPtr, 0, Params[i].AsFloat );
      else
        if not IsSupportedBlobTypes(Params[i].DataType) then
          raise EDatabaseError.CreateFmt(SNoParameterDataType, [Params[i].Name]);
    end;

    BindPtr := IncPtr( FParamBindPtr, i * SizeOf(TDBBinding) );
    if IsBlobType(Params[i].DataType) then begin
      BindDataType   := BindDataType or DBTYPE_BYREF;
      FieldInfo.DataSize := Length( Params[i].AsString );
        // allocate blob buffer using IMalloc
      BlobPtr := CoTaskMemAlloc( FieldInfo.DataSize );
      HelperMemWriteString( BlobPtr, 0, Params[i].AsString, FieldInfo.DataSize );
      HelperMemWritePtr( ParamsBuffer, FBlobParamsBufferOff+nBlobCount*SizeOf(BlobPtr), BlobPtr );
      BindPtr^.obValue := FBlobParamsBufferOff+nBlobCount*SizeOf(BlobPtr);

      Inc(nBlobCount);
    end;
    SetFieldInfoStruct( CurPtr, 0, FieldInfo );

    BindPtr^.iOrdinal   := i+1;
    if not IsBlobType( Params[i].DataType ) then begin
      BindPtr^.obValue  := nOffset + SizeOf(TSDFieldInfo);
    end;
    BindPtr^.obLength   := nOffset + GetFieldInfoDataSizeOff;
    BindPtr^.obStatus   := nOffset + GetFieldInfoFetchStatusOff;
    BindPtr^.pTypeInfo  := nil;
    BindPtr^.pObject    := nil;
    BindPtr^.pBindExt   := nil;
    BindPtr^.dwPart     := DBPART_STATUS or DBPART_LENGTH or DBPART_VALUE;
    BindPtr^.dwMemOwner := DBMEMOWNER_CLIENTOWNED;
    BindPtr^.eParamIO   := DBPARAMIO_NOTPARAM;  // = 0
    if Params[i].ParamType in [ptInput, ptInputOutput] then
      BindPtr^.eParamIO   := DBPARAMIO_INPUT;
    if Params[i].ParamType in [ptResult, ptInputOutput, ptOutput] then
      BindPtr^.eParamIO   := BindPtr^.eParamIO or DBPARAMIO_OUTPUT;
    BindPtr^.cbMaxLen   := DataLen;     // max length of allocated parameter buffer
    BindPtr^.dwFlags    := 0;
    BindPtr^.wType      := BindDataType;
    BindPtr^.bPrecision := 0;
    BindPtr^.bScale     := 0;

    nOffset := nOffset + SizeOf(TSDFieldInfo) + DataLen;
  end;

  if not Assigned( FIParamAccessor ) then begin
    ASSERT( As