高分求救！如何获取局域网内一个工作组所有的IP和主机名，并。。。

Question

并且从所获取的主机中检测其是否有SQL SERVER服务或其他服务。
如果有则列出数据库服务器中所有的数据库名称并测试其连接....
类似于数据库连接精灵。

Answer 1

自己写的，见笑了。// 获取活动的 SQL Server 服务器列表
type
  NET_API_STATUS = DWORD;  PServerInfo100 = ^TServerInfo100;
  _SERVER_INFO_100 = record
    sv100_platform_id: DWORD;
    sv100_name: LPWSTR;
  end;
  {$EXTERNALSYM _SERVER_INFO_100}
  TServerInfo100 = _SERVER_INFO_100;
  SERVER_INFO_100 = _SERVER_INFO_100;
  {$EXTERNALSYM SERVER_INFO_100}const
  NERR_Success = 0;
  MAX_PREFERRED_LENGTH = DWORD(-1);
  SV_TYPE_SQLSERVER    = $00000004;function NetApiBufferAllocate(ByteCount: DWORD; var Buffer: Pointer):
  NET_API_STATUS; stdcall; external 'netapi32.dll' name 'NetApiBufferAllocate';function NetServerEnum(ServerName: LPCWSTR; Level: DWORD; var BufPtr: Pointer;
  PrefMaxLen: DWORD; var EntriesRead: DWORD; var TotalEntries: DWORD;
  ServerType: DWORD; Domain: LPCWSTR; ResumeHandle: PDWORD): NET_API_STATUS;
  stdcall; external 'netapi32.dll' name 'NetServerEnum';function NetApiBufferFree(Buffer: Pointer): NET_API_STATUS; stdcall; external
'netapi32.dll' name 'NetApiBufferFree';function GetSQLServerList(out AList: TStrings; pwcServerName: PWChar = nil;
  pwcDomain: PWChar = nil): Boolean;
var
  NetAPIStatus: DWORD;
  dwLevel: DWORD;
  pReturnSvrInfo: Pointer;
  dwPrefMaxLen: DWORD;
  dwEntriesRead: DWORD;
  dwTotalEntries: DWORD;
  dwServerType: DWORD;
  dwResumeHandle: PDWORD;
  pCurSvrInfo: PServerInfo100;
  i, j: Integer;
begin
  Result := True;
  try
    if  Trim(pwcServerName) = '' then
      pwcServerName := nil;    if Trim(pwcDomain) = '' then
      pwcDomain := nil;    dwLevel := 100;
    pReturnSvrInfo := nil;
    dwPrefMaxLen := MAX_PREFERRED_LENGTH;
    dwEntriesRead := 0;
    dwTotalEntries := 0;
    dwServerType := SV_TYPE_SQLSERVER;    
    dwResumeHandle := nil;               NetApiBufferAllocate(SizeOf(pReturnSvrInfo), pReturnSvrInfo);
    try
      NetAPIStatus := NetServerEnum(pwcServerName, dwLevel, pReturnSvrInfo,
        dwPrefMaxLen, dwEntriesRead, dwTotalEntries, dwServerType, pwcDomain,
        dwResumeHandle);      if (NetAPIStatus = NERR_Success) and (pReturnSvrInfo <> nil) then
      begin
        pCurSvrInfo := pReturnSvrInfo;        // 循环取得所有服务
        i := 0;
        j := dwEntriesRead;
        while i < j do
        begin
          if pCurSvrInfo = nil then
            Break;          with AList do
            Add(pCurSvrInfo^.sv100_name);          Inc(i);
          Inc(pCurSvrInfo);
        end;
      end;
    finally
      if Assigned(pReturnSvrInfo) then
        NetApiBufferFree(pReturnSvrInfo);
    end;
  except
    Result := False;
  end;
end;

Answer 2

组件edit用来显示IP和主机名
呵呵

Answer 3

看书和自己加工了一下，先找到工作组，在找工作组中的计算机和ip地址。
procedure TForm1.N2Click(Sender: TObject);     //扫描工作组
var
s1:tstringlist;
i:integer;
begin
groupbox1.Caption :='工作组或域';
  memresult.lines.clear;
  s1:=tstringlist.create;
  if getserverlist(s1) then
  begin
    memresult.lines.add('总共找到'+inttostr(s1.count)+'个网络组或域');
    for i:=0 to s1.count-1 do
    begin
    work[i]:=s1.strings[i];
    memresult.Lines.add(s1.Strings[i]);
    end;
end
    else
    memresult.lines.add('???????');
   end;function getusers(groupname:string;var list:tstringlist):boolean;  //取计算机组中的计算机名
var
netresource:tnetresource;
buf:pointer;
count,bufsize,res:dword;
ind:integer;
iphenum:thandle;
temp:tnetresourcearray;
begin
result:=false;
list.clear;
fillchar(netresource,sizeof(netresource),0);
netresource.lpremotename:=@groupname[1];
netresource.dwdisplaytype:=resourcedisplaytype_server;
netresource.dwusage:=resourceusage_container;
netresource.dwscope:=resourcetype_disk;
res:=wnetopenenum(resource_globalnet,resourcetype_disk,
resourceusage_container,@netresource,iphenum);
if res<>no_error then exit;
while true do
  begin
   count:=$FFFFFFFF;
   bufsize:=8192;
   getmem(buf,bufsize);
   res:=wnetenumresource(iphenum,count,pointer(buf),bufsize);
   if res=error_no_more_items then break;
   if (res<>no_error)then exit;
   temp:=tnetresourcearray(buf);
  for ind:=0 to count-1 do
   begin
    list.Add(temp^.lpremotename);
    inc(temp);
   end;
  end;
  res:=wnetcloseenum(iphenum);
if res<>no_error then exit;
  result:=true;
  freemem(buf);
  end;
procedure TForm1.N3Click(Sender: TObject);            //扫描工作组中的计算机主程序；
var
  list:tstringlist;
  i,j:integer;
begin
groupbox1.Caption :='计算机数';
  memresult.Lines.Clear ;
  for j:=0 to 2 do
    try
   list:=Tstringlist.Create ;
   if getusers(work[j],list) then
    if list.count=0 then
     begin
      memresult.Lines.add(work[j]+'工作组下没有计算机');
     end
    else
     memresult.Lines.Add(work[j]+'下的所有计算机如下：');
     for i:=0 to list.count-1 do
       begin
       computer[i]:=list.Strings[i]; //用computer数组来记录计算机名
         memresult.Lines.Add(computer[i]+'   '+getip(list.strings[i]));
       end;
       memresult.lines.add('共有'+inttostr(list.Count)+'台计算机');
      finally
      list:=tstringlist.create;
      end;
  end;
function tform1.getip(s1:string):string;          //取计算机组中计算机ip地址的子程序；
var
  WSAData: TWSAData;
  HostEnt: PHostEnt;
  sComputerName, sIP: string;
begin
  sComputername:=copy(s1,3,10);
  WSAStartup(2, WSAData);
  HostEnt := gethostbyname(PChar(sComputerName));
  if HostEnt <> nil then
  begin
    with HostEnt^ do
      sIP := Format('%d.%d.%d.%d', [Byte(h_addr^[0]), Byte(h_addr^[1]), Byte(h_addr^[2]), Byte(h_addr^[3])]);
    end;
  WSACleanup;
  result:=sIP;
end;
function getserverlist(var list:tstringlist):boolean;      //取工作组子程序。
var
  netresource:tnetresource;
  buf:pointer;
  count,bufsize,res:dword;
  lphenum:thandle;
  p:tnetresourcearray;
  i,j:smallint;
  networktypelist:tlist;
begin
  result:=false;
  networktypelist:=tlist.Create ;
  list.Clear;
  res:=wnetopenenum(resource_globalnet,resourcetype_disk
  ,resourceusage_container,nil,lphenum);
  if res<>no_error then exit;
  count:=$FFFFFFFF;
  bufsize:=8129;
  getmem(buf,bufsize);
  res:=wnetenumresource(lphenum,count,pointer(buf),bufsize);
  if (res=error_no_more_items) or (res<>no_error) then exit;
  p:=tnetresourcearray(buf);
  for i:=0 to count-1 do
  begin
    networktypelist.add(p);
    inc(p);
  end;
res:=wnetcloseenum(lphenum);
if res<> no_error then exit;
for j:=0 to networktypelist.count-1 do
begin
  netresource:=tnetresource(networktypelist.Items[j]^);
  res:=wnetopenenum(resource_globalnet,resourcetype_disk,
  resourceusage_container,@netresource,lphenum);
  if res<> no_error then break;
  while true do
  begin
    count:=$FFFFFFFF;
    bufsize:=8192;
    getmem(buf,bufsize);
    res:=wnetenumresource(lphenum,count,pointer(buf),bufsize);
    if (res=error_no_more_items) or (res<>no_error) then break;
    p:=tnetresourcearray(buf);
    for i:=0 to count-1 do
begin
  list.Add(strpas(p^.lpRemoteName));
  inc(p);
  end;
  end;
  res:=wnetcloseenum(lphenum);
  if res<> no_error then break;
  end;
  result:=true;
  freemem(buf);
  networktypelist.Destroy;
  end;

Answer 4

取sql server服务的没试过。

Answer 5

就是几个网络函数而已，用法如下：
var
  List: TStringList;
  lstBox: TListBox;
begin
  List := TStringList.Create;
  try
    GetSQLServerList(List);
    lstBox.Items := List;
  finally
    List.Free;
  end;
end;

Answer 6

用法如下：
var
  List: TStringList;
  lstBox: TListBox;
begin
  List := TStringList.Create;
  try
    GetSQLServerList(List);
    lstBox.Items := List;
  finally
    List.Free;
  end;
end;