devart.sdac.oledbintf.pas

devent UniDAC 2.003 include sources

  [ComImport, GuidAttribute('0c733a67-2a1c-11ce-ade5-00aa0044773d'), InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)]
  IErrorRecords = interface
    [PreserveSig]
    function (* [local] *) AddErrorRecord(
            (* [in] *) const pErrorInfo: ERRORINFO;
            (* [in] *) dwLookupID: DWORD;
            (* [in] *) const pdispparams: DISPPARAMS;
            [In, MarshalAs(UnmanagedType.IUnknown)]
            (* [in] *) const punkCustomError: IUnknown;
            (* [in] *) dwDynamicErrorID: DWORD): HResult;

    [PreserveSig]
    function (* [local] *) GetBasicErrorInfo(
            (* [in] *) ulRecordNum: ULONG;
            (* [out] *) out pErrorInfo: ERRORINFO): HResult;

    [PreserveSig]
    function (* [local] *) GetCustomErrorObject(
            (* [in] *) ulRecordNum: ULONG;
            [In, MarshalAs(UnmanagedType.LPStruct)]
            (* [in] *) const riid: TGUID;
            [Out, MarshalAs(UnmanagedType.IUnknown)]
            (* [iid_is][out] *) out ppObject: IUnknown): HResult;

    [PreserveSig]
    function (* [local] *) GetErrorInfo(
            (* [in] *) ulRecordNum: ULONG;
            (* [in] *) lcid: LCID;
            (* [out] *)
            [Out, MarshalAs(UnmanagedType.IUnknown)]
            out ppErrorInfo: IErrorInfo): HResult;

    [PreserveSig]
    function (* [local] *) GetErrorParameters(
            (* [in] *) ulRecordNum: ULONG;
            (* [out] *) out pdispparams: DISPPARAMS): HResult;

    [PreserveSig]
    function (* [local] *) GetRecordCount(
            (* [out] *) out pcRecords: ULONG): HResult;
  end;
  {$EXTERNALSYM IErrorRecords}

// the structure returned by  ISQLServerErrorInfo::GetSQLServerInfo
  [StructLayout(LayoutKind.Sequential, Pack = 1, CharSet = CharSet.Auto)]
  SSERRORINFO = record
    [MarshalAs(UnmanagedType.LPWStr)]
    pwszMessage: PWideChar;
    [MarshalAs(UnmanagedType.LPWStr)]
    pwszServer: PWideChar;
    [MarshalAs(UnmanagedType.LPWStr)]
    pwszProcedure: PWideChar;
    lNative: integer;
    bState: BYTE;
    bClass: BYTE;
    wLineNumber: WORD;
  end;
  PSSERRORINFO = IntPtr;

  [ComImport, GuidAttribute('5CF4CA12-EF21-11d0-97E7-00C04FC2AD98'), InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)]
  ISQLServerErrorInfo = interface
    [PreserveSig]
    function GetErrorInfo(
            (* [out] *) out ppErrorInfo: PSSERRORINFO;
            (* [out] *) out ppStringsBuffer: IntPtr{PWideChar}): HResult;
  end;

  /// WARINING - in 64bit OSes DBBKMARK is int64
  DBBKMARK = integer;

  [ComImport, GuidAttribute('0c733a30-2a1c-11ce-ade5-00aa0044773d'), InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)]
  ISequentialStream = interface
    [PreserveSig]
    function Read(
      pv: IntPtr;
      cb: Longint;
      pcbRead: PLongint): HResult;
    [PreserveSig]
    function Write(
      pv: IntPtr;
      cb: Longint;
      pcbWritten: PLongint): HResult;
  end;

function GetErrorInfo(dwReserved: Longint; out errinfo: IErrorInfo): HResult;
function CoGetMalloc(dwMemContext: Longint; out malloc: IMalloc): HResult;

// Multi Language support
type
  [ComImport, GuidAttribute('275c23e3-3747-11d0-9fea-00aa003f8646'), InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)]
  IEnumCodePage = interface
    [PreserveSig]
    function Clone(
      [Out, MarshalAs(UnmanagedType.IUnknown)]
      out ppEnum: IEnumCodePage): HResult;
    [PreserveSig]
    function Next(
      celt: ULONG;
      [Out, MarshalAs(UnmanagedType.LPStruct)]
      var rgelt: MIMECPINFO;
      var pceltFetched: ULONG): HResult;
    [PreserveSig]
    function Reset: HResult;
    [PreserveSig]
    function Skip(celt: ULONG): HResult;
  end;

  [ComImport, GuidAttribute('3dc39d1d-c030-11d0-b81b-00c04fc9b31f'), InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)]
  IEnumRfc1766 = interface
    [PreserveSig]
    function Clone(
      [Out, MarshalAs(UnmanagedType.IUnknown)]
      out ppEnum: IEnumRfc1766): HResult;
    [PreserveSig]
    function Next(
      celt: ULONG;
      [Out, MarshalAs(UnmanagedType.LPStruct)]
      var rgelt: RFC1766INFO;
      var pceltFetched: ULONG): HResult;
    [PreserveSig]
    function Reset: HResult;
    [PreserveSig]
    function Skip(celt: ULONG): HResult;
  end;
  
  [ComImport, GuidAttribute('D66D6F98-CDAA-11D0-B822-00C04FC9B31F'), InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)]
  IMLangConvertCharset = interface
    [PreserveSig]
    function Initialize(
      uiSrcCodePage: UINT;
      uiDstCodePage: UINT;
      dwProperty: DWORD): HResult;
    [PreserveSig]
    function GetSourceCodePage(
      var puiSrcCodePage: UINT): HResult;
    [PreserveSig]
    function GetDestinationCodePage(
      var puiDstCodePage: UINT): HResult;
    [PreserveSig]
    function GetProperty(
      var pdwProperty: DWORD): HResult;
    [PreserveSig]
    function DoConversion(
      pSrcStr: IntPtr;
      var pcSrcSize: UINT;
      pDstStr: IntPtr;
      var pcDstSize: UINT): HResult;
    [PreserveSig]
    function DoConversionToUnicode(
      pSrcStr: PChar;
      var pcSrcSize: UINT;
      [MarshalAs(UnmanagedType.LPWStr)]
      pDstStr: PWideChar;
      var pcDstSize: UINT): HResult;
    [PreserveSig]
    function DoConversionFromUnicode(
      [MarshalAs(UnmanagedType.LPWStr)]
      pSrcStr: PWideChar;
      var pcSrcSize: UINT;
      [MarshalAs(UnmanagedType.LPStr)]
      pDstStr: PChar;
      var pcDstSize: UINT): HResult;
  end;

  [ComImport, GuidAttribute('275C23E1-3747-11D0-9FEA-00AA003F8646'), InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)]
  IMultiLanguage = interface
    [PreserveSig]
    function GetNumberOfCodePageInfo(
      var pcCodePage: UINT): HResult;
    [PreserveSig]
    function GetCodePageInfo(
      uiCodePage: UINT;
      [Out, MarshalAs(UnmanagedType.Struct)]
      var pCodePageInfo: MIMECPINFO): HResult;
    [PreserveSig]
    function GetFamilyCodePage(
      uiCodePage: UINT;
      var puiFamilyCodePage: UINT): HResult;
    [PreserveSig]
    function EnumCodePages(
      grfFlags: DWORD;
      [Out, MarshalAs(UnmanagedType.IUnknown)]
      out ppEnumCodePage: IEnumCodePage): HResult;
    [PreserveSig]
    function GetCharsetInfo(
      [MarshalAs(UnmanagedType.LPWStr)]
      Charset: PWideChar;
      [Out, MarshalAs(UnmanagedType.Struct)]
      var pCharsetInfo: MIMECSETINFO): HResult;
    [PreserveSig]
    function IsConvertible(
      dwSrcEncoding: DWORD;
      dwDstEncoding: DWORD): HResult;
    [PreserveSig]
    function ConvertString(
      var pdwMode: DWORD;
      dwSrcEncoding: DWORD;
      dwDstEncoding: DWORD;
      pSrcStr: IntPtr;
      var pcSrcSize: UINT;
      pDstStr: IntPtr;
      var pcDstSize: UINT): HResult;
    [PreserveSig]
    function ConvertStringToUnicode(
      var pdwMode: DWORD;
      dwEncoding: DWORD;
      pSrcStr: PChar;
      var pcSrcSize: UINT;
      pDstStr: PWideChar;
      var pcDstSize: UINT): HResult;
    [PreserveSig]
    function ConvertStringFromUnicode(
      var pdwMode: DWORD;
      dwEncoding: DWORD;
      [MarshalAs(UnmanagedType.LPWStr)]
      pSrcStr: PWideChar;
      var pcSrcSize: UINT;
      pDstStr: PChar;
      var pcDstSize: UINT): HResult;
    [PreserveSig]
    function ConvertStringReset: HResult;
    [PreserveSig]
    function GetRfc1766FromLcid(
      Locale: LCID;
      [Out, MarshalAs(UnmanagedType.LPWStr)]
      var pbstrRfc1766: WideChar): HResult;
    [PreserveSig]
    function EnumRfc1766(
      [Out, MarshalAs(UnmanagedType.IUnknown)]
      out ppEnumRfc1766: IEnumRfc1766): HResult;
    [PreserveSig]
    function GetRfc1766Info(
      Locale: LCID;
      [Out, MarshalAs(UnmanagedType.Struct)]
      var pRfc1766Info: RFC1766INFO): HResult;
    [PreserveSig]
    function CreateConvertCharset(
      uiSrcCodePage: UINT;
      uiDstCodePage: UINT;
      dwProperty: DWORD;
      [Out, MarshalAs(UnmanagedType.IUnknown)]
      out ppMLangConvertCharset: IMLangConvertCharset): HResult;
  end;
  
implementation

uses
  SysUtils;

(*
procedure SetOleVariant(pValue: POleVariant; const Value: OleVariant);
var
  Temp: TBytes;
begin
  SetLength(Temp, 16);
  Marshal.Copy(pValue, Temp, 0, 16);
  Temp[0] := 1;
  Marshal.GetNativeVariantForObject(TObject(Value), pValue);
  Marshal.Copy(pValue, Temp, 0, 16);
  Temp[0] := 2;
end;
*)

{ PDBProp }

function PDBProp.GetdwPropertyID: DBPROPID;
begin
  Result := DBPROPID(Marshal.ReadInt32(Ptr, 0));
end;

procedure PDBProp.SetdwPropertyID(Value: DBPROPID);
begin
  Marshal.WriteInt32(Ptr, 0, Integer(Value));
end;

function PDBProp.GetdwOptions: DBPROPOPTIONS;
begin
  Result := DBPROPID(Marshal.ReadInt32(Ptr, 4));
end;

procedure PDBProp.SetdwOptions(Value: DBPROPOPTIONS);
begin
  Marshal.WriteInt32(Ptr, 4, Integer(Value));
end;

function PDBProp.GetdwStatus: DBPROPSTATUS;
begin
  Result := DBPROPID(Marshal.ReadInt32(Ptr, 8));
end;

procedure PDBProp.SetdwStatus(Value: DBPROPSTATUS);
begin
  Marshal.WriteInt32(Ptr, 8, Integer(Value));
end;

function PDBProp.Getcolid: _DBID;
var
  Temp: array of byte;
begin
{$IFDEF VER8}
  SetLength(Temp, 0); //To avoid compiler warning. Delphi8 bug.
{$ENDIF}
  Marshal.Copy(IntPtr(Integer(Ptr) + 12), Temp, 0, Length(DB_NULLID));
  Result := Temp;
end;

procedure PDBProp.Setcolid(Value: _DBID);
var
  Temp: array of byte;
begin
  Temp := Value;
  Marshal.Copy(Temp, 0, IntPtr(Integer(Ptr) + 12), Length(DB_NULLID));
end;

function PDBProp.GetvValue: OleVariant;
var
  pValue: POleVariant;
begin
  pValue := IntPtr(Integer(Ptr) + 12 + 24);
  Result := GetOleVariant(pValue);
end;

procedure PDBProp.SetvValue(Value: OleVariant);
var
  pValue: POleVariant;
begin
  pValue := IntPtr(Integer(Ptr) + 12 + 24);
  SetOleVariant(pValue, Value);
end;

class operator PDBProp.Implicit(AValue: IntPtr): PDBProp;
begin
  Result.Ptr := AValue;
end;

class operator PDBProp.Implicit(AValue: PDBProp): IntPtr;
begin
  Result := AValue.Ptr;
end;

{ PDBPropSet }

class operator PDBPropSet.Implicit(AValue: IntPtr): PDBPropSet;
begin
  Result.Ptr := AValue;
end;

class operator PDBPropSet.Implicit(AValue: PDBPropSet): IntPtr;
begin
  Result := AValue.Ptr;
end;

function PDBPropSet.GetrgProperties: PDBPropArray;
begin
  Result := Marshal.ReadIntPtr(Ptr);
end;

procedure PDBPropSet.SetrgProperties(Value: PDBPropArray);
begin
  Marshal.WriteIntPtr(Ptr, Value);
end;

function PDBPropSet.GetcProperties: UINT;
begin
  Result := UINT(Marshal.ReadInt32(Ptr, 4));
end;

procedure PDBPropSet.SetcProperties(Value: UINT);
begin
  Marshal.WriteInt32(Ptr, 4, Integer(Value));
end;

function PDBPropSet.GetguidPropertySet: TGUID;
begin
  Result := TGUID(Marshal.PtrToStructure(IntPtr(Integer(Ptr) + 8), TypeOf(TGUID)));
end;

procedure PDBPropSet.SetguidPropertySet(Value: TGUID);
begin
  Marshal.StructureToPtr(TObject(Value), IntPtr(Integer(Ptr) + 8), False);
end;

const
  ole32    = 'ole32.dll';
  oleaut32 = 'oleaut32.dll';

[DllImport(oleaut32, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'GetErrorInfo')]
function GetErrorInfo(dwReserved: Longint; out errinfo: IErrorInfo): HResult; external;

[DllImport(ole32, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'CoGetMalloc')]
function CoGetMalloc(dwMemContext: Longint; out malloc: IMalloc): HResult; external;

initialization

end.