IpFromInfo v2 - Модуль

У кого что есть полезное скиньте пожалуйста...

unit IpInfo;
 
(********************************************************************)
(*                                                                  *)
(*        Определение информаций о компьютере по IP - адресу        *)
(*                                                                  *)
(*                                                                  *)
(*  100% работает под 98/XP остальные не проверяел...               *)
(*                                                                  *)
(* Автор: Arazel / Rouse_ /                                         *)
(*                                                                  *)
(********************************************************************)
 
interface
 
Uses Windows,Messages,SysUtils,Dialogs,WinSock;
 
Var
  Computer: array [1..2000] of string[25];
  ComputerCount: Integer;
  EventErrorMeesage :String;
 
 
  Procedure FindAllComputers(WorkGroup:String);
  Function GetLocalIP: String;
  Function GetNameFromIP(const IP: String): String;
  Function GetProvider: String;
  Function GetWorkgroup: String;
  Function GetComment(CompName, Provider: String): String;
  Function DetectWindowsFormIP (ServerName :String) :String;
  Function GetShares(const NameOrIP: String):String;
 
implementation
 
 
 
 
 
 
Procedure FindAllComputers(WorkGroup:String);
var
  EnumHandle: THandle;
  WorkgroupRS: TNetResource;
  Buf: array [1..500] of TNetResource;
  BufSize: Cardinal;
  Entries: Cardinal;
  Result: Cardinal;
  WG:String;
 
Var
 tmp:String;
 
 
begin
  ComputerCount := 0;
  Workgroup := Workgroup + #0;
  FillChar(WorkgroupRS, SizeOf(WorkgroupRS) , 0);
  with WorkgroupRS do
  begin
    dwScope := 2;
    dwType := 3;
    dwDisplayType := 1;
    dwUsage := 2;
    lpRemoteName := @Workgroup[1];
  end;
 
  WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @WorkgroupRS, EnumHandle);
 
  repeat
    Entries := 1;
    BufSize := SizeOf(Buf);
 
    Result := WNetEnumResource(EnumHandle, Entries, @Buf, BufSize);
    if (Result = NO_ERROR) and (Entries = 1) then
    begin
      Inc( ComputerCount );
      tmp:=StrPas(Buf[1].lpRemoteName);
      Computer[ ComputerCount ] := Copy(tmp,3,Length(tmp));
    end;
  until
    (Entries <> 1) or (Result <> NO_ERROR);
 
  WNetCloseEnum( EnumHandle );
end;
 
 
 
 
function GetLocalIP: String;
const WSVer = $101;
var
  wsaData: TWSAData;
  P: PHostEnt;
  Buf: array [0..127] of Char;
begin
  Result := '';
  if WSAStartup(WSVer, wsaData) = 0 then
  begin
    if GetHostName(@Buf, 128) = 0 then
    begin
      P := GetHostByName(@Buf);
      if P <> nil then Result := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
    end;
    WSACleanup;
  end;
end;
 
 
 
function GetNameFromIP(const IP: String): String;
var
  WSA: TWSAData;
  Host: PHostEnt;
  Addr: Integer;
  Err: Integer;
begin
  Result :='UNKNOWN';
  Err := WSAStartup($101, WSA);
  if Err <> 0 then
  begin
    EventErrorMeesage:=EventErrorMeesage+SysErrorMessage(GetLastError);
    Exit;
  end;
  try
    Addr := inet_addr(PChar(IP));
    if Addr = INADDR_NONE then
    begin
    EventErrorMeesage:=EventErrorMeesage+SysErrorMessage(GetLastError);
      WSACleanup;
      Exit;
    end;
    Host := gethostbyaddr(@Addr, SizeOf(Addr), PF_INET);
    if Assigned(Host) then
      Result := Host.h_name
    else
    EventErrorMeesage:=EventErrorMeesage+SysErrorMessage(GetLastError);
  finally
    WSACleanup;
  end;
 end;
 
 
 
 
function GetProvider: String;
var
  Buffer: array [0..255] of Char;
  Size: DWORD;
begin
  Size := SizeOf(Buffer);
  if WNetGetProviderName(WNNC_NET_LANMAN, @Buffer, Size) <> NO_ERROR then
    Result := '???'
  else
    Result := String(Buffer);
end;
 
 
function GetWorkgroup: String;
var
  CurrRes: TNetResource;
  ParentName: array [0..1] of TNetResource;
  Enum: DWORD;
  Err: Integer;
begin
  with CurrRes do
  begin
    dwScope := RESOURCE_GLOBALNET;
    dwType := RESOURCETYPE_DISK;
    dwDisplayType := RESOURCEDISPLAYTYPE_SERVER;
    dwUsage := RESOURCEUSAGE_CONTAINER;
    lpLocalName := '';
    lpRemoteName := PChar('\\' + GetNameFromIP(GetLocalIP));
    lpComment := '';
    lpProvider := PChar(GetProvider);
  end;
    Enum := SizeOf(ParentName);
    Err := WNetGetResourceParent(@CurrRes, @ParentName, Enum);
    if Err = NO_ERROR then
  begin
    Result := ParentName[0].lpRemoteName;
    if Result = '' then
    Result :='???';
  end
  else
    ShowMessage(SysErrorMessage(GetLastError));
end;
 
 
 
 
 
CONST
  NERR_BASE = 2100;
  NERR_BufTooSmall         = (NERR_BASE+23);
 
 
Function DetectWindows(PlatformID:Cardinal; DwMajorVersion,MinorVersion:Cardinal):String;
begin
  Result := 'Unknown';
  begin
    case DwMajorVersion of
      3: Result := 'Windows NT 3';
      4: case MinorVersion of
          0: if PlatformId = VER_PLATFORM_WIN32_NT then
              Result := 'Windows NT 4'
            else
              Result := 'Windows 95';
          10: Result := 'Windows 98';
          90: Result := 'Windows ME';
        end;
      5: case MinorVersion of
          0: Result := 'Windows 2000';
          1: Result := 'Windows XP';
        end;
    end;
  end;
end;
 
 
function ServerPlatform_NT (ServerName :String) :String;
TYPE
 TNetServerGetInfo = function (servername: LPWSTR; level: DWORD;
                             var bufptr: Pointer): DWORD; stdcall;
 TNetApiBufferFree = function (Buffer: Pointer): DWORD; stdcall;
 
Type
  PServerInfo101 = ^TServerInfo101;
  _SERVER_INFO_101 = record
    sv101_platform_id: DWORD;
    sv101_name: LPWSTR;
    sv101_version_major: DWORD;
    sv101_version_minor: DWORD;
    sv101_type: DWORD;
    sv101_comment: LPWSTR;
  end;
 
  TServerInfo101 = _SERVER_INFO_101;
  SERVER_INFO_101 = _SERVER_INFO_101;
 
 
Var
  Res :DWORD;
  ServerInfo :PServerInfo101;
  // -- >
  hLib:THandle;
  NetServerGetInfo  : TNetServerGetInfo;
  NetApiBufferFree  : TNetApiBufferFree;
begin
//*----------------- Загружаем NetServerGetInfo -------------------
    hLib := LoadLibrary('NetApi32.dll');
    if hLib = 0 then
      MessageDlg('Ошибка загрузки '+'NetApi32.dll', mtError,[mbOk], 0);
    try
      NetServerGetInfo := GetProcAddress(hLib,'NetServerGetInfo');
       if @NetServerGetInfo = Nil then
         MessageDlg('В NetApi32.dll нет NetServerGetInfo', mtError,[mbOk], 0);
    except
      FreeLibrary(hLib);
      raise;
    end;
//------------------ Загружаем NetApiBufferFree -------------------
    hLib := LoadLibrary('NetApi32.dll');
    if hLib = 0 then
    MessageDlg('Ошибка загрузки '+'NetApi32.dll', mtError,[mbOk], 0);
    try
      NetApiBufferFree := GetProcAddress(hLib,'NetApiBufferFree');
       if @NetApiBufferFree = Nil then
         MessageDlg('В NetApi32.dll нет NetApiBufferFree', mtError,[mbOk], 0);
    except
      FreeLibrary(hLib);
      raise;
    end;
//**********************************************************
   Res := NetServerGetInfo(PWideChar(WideString(ServerName)),101,Pointer(ServerInfo));
    if  Res <> 0  then
    begin
      Result := 'Ошибка I/O';
      Exit;
    end;
  try
    Result :=DetectWindows(
                  ServerInfo^.sv101_platform_id,
                  ServerInfo^.sv101_version_major,
                  ServerInfo^.sv101_version_minor)+' v'+
                  IntToStr(ServerInfo^.sv101_version_major)+'.'+
                  IntToStr(ServerInfo^.sv101_version_minor);
  finally
    NetApiBufferFree(ServerInfo);
  end;
end;
 
 
 
function ServerPlatform_9x (ServerName :String) :String;
type
  pserver_info_1 = ^server_info_1;
  server_info_1 = packed record
      sv1_name          :array [0..15] of Char;
      sv1_version_major :Byte;
      sv1_version_minor :Byte;
      sv1_type          :Cardinal;
      sv1_comment       :PChar;
    end;
 
 
  tNetServerGetInfo9x =function (pszServer    :PChar;
                                sLevel        :Word;
                                pbBuffer      :Pointer;
                                cbBuffer      :Word;
                            var pcbTotalAvail :Word) :DWORD; stdcall;
const
  SV_TYPE_NT         = $00001000;
  SV_TYPE_WINDOWS    = $00400000;  //* Windows95 and above */
 
var
  NetServerGetInfo9x :tNetServerGetInfo9x;
 
var
  hLib       : tHandle;
  Res        : DWORD;
  ServerInfo : pserver_info_1;
  InfoSize   : Word;
  SV         : BYTE;
 
begin
    hLib := LoadLibrary('SvrApi.dll');
    if hLib=0 then
    MessageDlg('Ошибка загрузки '+'SvrApi.dll', mtError,[mbOk], 0);
    try
      NetServerGetInfo9x := GetProcAddress(hLib,'NetServerGetInfo');
       if @NetServerGetInfo9x = Nil then
      MessageDlg('В SRVAPI.DLL нет NetServerGetInfo', mtError,[mbOk], 0);
    except
      FreeLibrary(hLib);
      raise;
    end;
 
  ServerInfo := nil;
  InfoSize := 0;
  try
    Res := NetServerGetInfo9x(PChar(ServerName),1,ServerInfo,InfoSize,InfoSize);
    if  Res = NERR_BufTooSmall  then
    begin
//      MBox(IntToStr(InfoSize));
      GetMem(ServerInfo,InfoSize);
      Res := NetServerGetInfo9x(PChar(ServerName),1,ServerInfo,InfoSize,InfoSize);
    end;
 
    if  Res <> 0 then begin
      Result := 'Ошибка I/O';
      Exit;
    end;
     if (ServerInfo^.sv1_type and SV_TYPE_WINDOWS     ) <> 0  then
     SV:=1 else
     if (ServerInfo^.sv1_type and SV_TYPE_NT) <> 0  then
     SV:=2 else
     SV:=$FF;
         Result :=  DetectWindows(SV,
         ServerInfo^.sv1_version_major,
         ServerInfo^.sv1_version_minor)
         +' v'+IntToStr(ServerInfo^.sv1_version_major)+'.'+
               IntToStr(ServerInfo^.sv1_version_minor);
 
 
  finally
    FreeMem(ServerInfo);
  end;
end;
 
 
 
var ServerInfoStrProc :function (ServerName :String) :String = Nil;
 
function DetectWindowsFormIP (ServerName :String) :String;
  procedure SetServerInfoStrProc;
  var  Ver: TOsVersionInfo;
  begin
    Ver.dwOSVersionInfoSize := SizeOf(Ver);
    GetVersionEx(Ver);
    if  Ver.dwPlatformId = VER_PLATFORM_WIN32_NT  then
      ServerInfoStrProc := ServerPlatform_NT
    else
      ServerInfoStrProc := ServerPlatform_9x;
  end;
 
begin
  if  @ServerInfoStrProc = nil  then  SetServerInfoStrProc;
  Result := ServerInfoStrProc('\\'+ServerName);
end;
 
 
 
 
function GetComment(CompName, Provider: String): String;
var
  StopScan: Boolean;
  TmpRes: TNetResource;
  procedure Scan(Res: TNetResource; Root: boolean);
  var
    Enum, I: Cardinal;
    ScanRes: array [0..512] of TNetResource;
    Size, Entries, Err: DWORD;
  begin
    if StopScan then Exit;
    if Root = True then
      Err := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
        0, nil, Enum)
    else
      Err := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
        0, @Res, Enum);
 
    if Err = NO_ERROR then
    begin
      Size := SizeOf(ScanRes);
      Entries := DWORD(-1);
      Err := WNetEnumResource(Enum, Entries, @ScanRes, Size);
      if Err = NO_ERROR then
      try
        for I := 0 to Entries - 1 do
        begin
          if StopScan then Exit;
          with ScanRes[i] do
          begin
            if dwDisplayType = RESOURCEDISPLAYTYPE_SERVER then
              if lpRemoteName = CompName then
              begin
                Result :=  lpComment;
                StopScan := True;
                Exit;
              end;
            if dwDisplayType <> RESOURCEDISPLAYTYPE_SERVER then
              Scan(ScanRes[i], False);
          end;
        end;
      finally
        WNetCloseEnum(Enum);
      end
      else
        if Err <> ERROR_NO_MORE_ITEMS then
      EventErrorMeesage:=EventErrorMeesage+SysErrorMessage(GetLastError);
    end
    else
    EventErrorMeesage:=EventErrorMeesage+SysErrorMessage(GetLastError);
  end;
 
 
begin
  Result := 'Неопределенно';
  if CompName = 'Неопределенно' then Exit;
  CompName := '\\' + CompName;
  StopScan := False;
  Scan(TmpRes, True);
  if Result = '' then Result := '';
end;
 
 
Function GetShares(const NameOrIP: String):String;
var
 hNetEnum: THandle;
 NetContainerToOpen: NETRESOURCE;
 ResourceBuffer: array[1..2000] of TNetResource;
 i,ResourceBuf,EntriesToGet: DWORD;
 Share:String;
 ShareCount:DWORD;
begin
Share:='';
 NetContainerToOpen.dwScope:=RESOURCE_GLOBALNET;
 NetContainerToOpen.dwType:=RESOURCETYPE_ANY;
 NetContainerToOpen.lpLocalName:=nil;
 NetContainerToOpen.lpRemoteName:= PChar('\\'+NameOrIP);
 NetContainerToOpen.lpProvider:= nil;
 WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_CONNECTABLE or RESOURCEUSAGE_CONTAINER,
                   @NetContainerToOpen, hNetEnum);
 while TRUE do
  begin
   ResourceBuf := sizeof(ResourceBuffer);
   EntriesToGet := 2000;
 
   if (NO_ERROR <> WNetEnumResource(hNetEnum,EntriesToGet,@ResourceBuffer,ResourceBuf)) then
    exit;
   ShareCount:=EntriesToGet;
   for i := 1 to ShareCount do
   Begin
     Share:=(string(ResourceBuffer[i].lpRemoteName))+'$';
     Result:=Result+
     Copy(Share,Length(NameOrIP)+4,Length(Share))+#13#10;
   end;
  Result:=Copy(Result,1,Length(Result)-2);  
  end;
end;
 
 
 
 
 
end.

Про что топик ?
Arazel Хватит уже флудить