Delphi取局域网上所有的SQL服务器名称

unit GetSQLServerUnt;

interface

uses ADODB, OleDB, ActiveX,  ComObj, ADOInt, ADOConst, Classes, Windows, SysUtils,
DB;

const CLSID_SQLOLEDB_ENUMERATOR: TGUID = '{DFA22B8E-E68D-11d0-97E4-00C04FC2AD98}';
function CreateADOObject(const ClassID: TGUID): IUnknown;
//取得局域上所有的SQL服务器名
procedure getSQLServerNames(Names: TStrings);

implementation

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;
if (Status = REGDB_E_CLASSNOTREG) then
raise Exception.CreateRes(@SADOCreateError) else
OleCheck(Status);
end;

procedure getSQLServerNames(Names: TStrings);
var
RSCon: ADORecordsetConstruction;
Rowset: IRowset;
SourcesRowset: ISourcesRowset;
SourcesRecordset: _Recordset;
SourcesName, SourcesType: TField;
begin
SourcesRecordset := CreateADOObject(CLASS_Recordset) as _Recordset;
RSCon := SourcesRecordset as ADORecordsetConstruction;
SourcesRowset := CreateComObject(CLSID_SQLOLEDB_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 }
SourcesType := FieldByName('SOURCES_TYPE'); { do not localize }
Names.BeginUpdate;
try
while not EOF do
begin
if SourcesType.AsInteger = DBSOURCETYPE_DATASOURCE then
Names.Add(SourcesName.AsString);
Next;
end;
finally
Names.EndUpdate;
end;
finally
Free;
end;
end;

end.