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. |
