1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
|
{$APPTYPE CONSOLE}
uses
Windows,
Classes,
DB, ADODB, AdoInt, ActiveX, ComObj, OleDB,
SysUtils;
type TCGUID = class
GUID: TGUID;
constructor Create( Input: String);
end;
constructor TCGUID.Create(Input: String);
begin
GUID := StringToGUID( Input);
end;
function CreateADOObject(const ClassID: TGUID): IUnknown;
var Status: HResult;
FPUControlWord: Word;
begin
asm
FNSTCW FPUControlWord
end;
Status := CoCreateInstance( ClassID, nil, CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, IUnknown, Result);
asm
FNCLEX
FLDCW FPUControlWord
end;
OleCheck(Status);
end;
procedure GetProviderNames(Names: TStrings);
var
RSCon: ADORecordsetConstruction;
Rowset: IRowset;
SourcesRowset: ISourcesRowset;
SourcesRecordset: _Recordset;
SourcesName, SourcesType, SourcesGUID: TField;
begin
SourcesRecordset := CreateADOObject(CLASS_Recordset) as _Recordset;
RSCon := SourcesRecordset as ADORecordsetConstruction;
SourcesRowset := CreateComObject(CLSID_OLEDB_ENUMERATOR) as ISourcesRowset;
OleCheck(SourcesRowset.GetSourcesRowset(nil, IRowset, 0, nil, IUnknown(Rowset)));
RSCon.Rowset := RowSet;
with TADODataSet.Create(nil) do
try
Recordset := SourcesRecordset;
First;
SourcesName := FieldByName('SOURCES_NAME'); { do not localize }
SourcesGUID := FieldByName('SOURCES_PARSENAME'); { do not localize }
SourcesType := FieldByName('SOURCES_TYPE'); { do not localize }
Names.BeginUpdate;
try
while not EOF do
begin
if SourcesType.AsInteger = DBSOURCETYPE_DATASOURCE then
Names.AddObject( SourcesName.AsString, TCGUID.Create( SourcesGUID.AsString));
Next;
end;
finally
Names.EndUpdate;
end;
finally
Free;
end;
end;
const FranckSorianoExampleGUID : TGUID = '{0C7FF16C-38E3-11d0-97AB-00C04FC2AD98}';
var SL: TStringList;
Id: Integer;
begin
CoInitializeEx( nil, COINIT_MULTITHREADED);
try
SL := TStringList.Create;
try
try
GetProviderNames( SL);
for Id := 0 to SL.Count - 1 do
if IsEqualGUID( TCGUID( SL.Objects[ Id]).GUID, FranckSorianoExampleGUID) then
begin
MessageBox( 0, 'Trouvé', 'OLEDBProvidersEnum', MB_OK);
Break;
end;
finally
while SL.Count > 0 do
begin
SL.Objects[ 0].Destroy();
SL.Objects[ 0] := nil;
SL.Delete( 0);
end;
end;
finally
SL.Destroy;
end;
finally
CoUninitialize;
end;
end. |
Partager