var
i:Integer;
begin
ListAvailableSQLServers(Memo1.lines);
for I := 0
to Memo1.lines.Count - 1
do
begin
TcpClient1.Close;
TcpClient1.RemoteHost := Memo1.lines[i];
try
TcpClient1.Open;
if TcpClient1.Connected
then Memo1.lines[i] := Memo1.lines[i] + '
Active'
else Memo1.lines[i] := Memo1.lines[i] + '
Not Active';
except
Memo1.lines[i] := Memo1.lines[i] + '
ERROR';
end;
end;
TcpClient1.Close;
end;
procedure ListAvailableSQLServers(Names : TStrings);
var
RSCon: ADORecordsetConstruction;
Rowset: IRowset;
SourcesRowset: ISourcesRowset;
SourcesRecordset: _Recordset;
SourcesName, SourcesType: TField;
function PtCreateADOObject
(
const ClassID: TGUID): IUnknown;
var
Status: HResult;
FPUControlWord: Word;
begin
asm
FNSTCW FPUControlWord
end;
Status := CoCreateInstance(
CLASS_Recordset,
nil,
CLSCTX_INPROC_SERVER
or
CLSCTX_LOCAL_SERVER,
IUnknown,
Result);
asm
FNCLEX
FLDCW FPUControlWord
end;
OleCheck(Status);
end;
begin
SourcesRecordset :=
PtCreateADOObject(CLASS_Recordset)
as _Recordset;
RSCon :=
SourcesRecordset
as ADORecordsetConstruction;
SourcesRowset :=
CreateComObject(ProgIDToClassID('
SQLOLEDB Enumerator'))
as ISourcesRowset;
OleCheck(SourcesRowset.GetSourcesRowset(
nil,
IRowset, 0,
nil,
IUnknown(Rowset)));
RSCon.Rowset := RowSet;
with TADODataSet.Create(
nil)
do
try
Recordset := SourcesRecordset;
SourcesName := FieldByName('
SOURCES_NAME');
SourcesType := FieldByName('
SOURCES_TYPE');
Names.BeginUpdate;
try
while not EOF
do
begin
if
(SourcesType.AsInteger = DBSOURCETYPE_DATASOURCE)
and (SourcesName.AsString <> '
')
then
Names.Add(SourcesName.AsString);
Next;
end;
finally
Names.EndUpdate;
end;
finally
Free;
end;
end;