[Delphi] Fce na zjisteni sitove masky k IP v pocitaci

[Helium]

Zna nekdo fci na zjisteni sitove masky k IP v pocitaci ?

[Rainbow]

Toto zoberie prvu adresu, ktoru najde (okrem 127.0.0.1).

uses IPHlpAPI;
procedure TfrmMain.DetectIP;
var IPAddrRow: TMibIPAddrRow;
    TableSize, ErrorCode, NumEntries: DWord;
    I: Integer;
    pBuf: PChar;
begin
  MyIP := 0;
  LoadIpHlp;
  TableSize := 0;
  // first call: get table length
  ErrorCode := GetIpAddrTable(Nil, @TableSize, true);
  if Errorcode <> ERROR_INSUFFICIENT_BUFFER then Exit;

  GetMem(pBuf, TableSize);
  // get table
  ErrorCode := GetIpAddrTable(PTMibIPAddrTable(pBuf), @TableSize, true);
  if ErrorCode = NO_ERROR then
  begin
    NumEntries := PTMibIPAddrTable(pBuf)^.dwNumEntries;
    if NumEntries > 0 then
    begin
      for i := 1 to NumEntries do
      begin
        IPAddrRow := PTMIBIPAddrRow(pBuf+SizeOf(DWord)+(I-1)*SizeOf(TMIBIPAddrRow))^;
        if (IPAddrRow.dwAddr<>0) then
         begin
           MyIP := IPAddrRow.dwAddr;
           MyMask := IPAddrRow.dwMask;
           Bcast := MyIP and MyMask or not MyMask;
           if MyIP<>$100007F then Break; // 127.0.0.1
         end;
      end;
    end;
  end;
  FreeMem(pBuf);
 if MyIP=0 then
   begin
     ShowMessage(MSG_ERROR, 'Unable to detect network settings');
     Exit;
   end;
  StatusBar.Panels[1].Text := 'IP: '+UDPSocket.IPtoDotDot(MyIP);
  StatusBar.Panels[2].Text := 'Mask: '+UDPSocket.IPtoDotDot(MyMask);
  StatusBar.Panels[3].Text := 'Broadcast: '+UDPSocket.IPtoDotDot(Bcast);
  ShowMessage(MSG_SYSTEM, 'Detected '+StatusBar.Panels[1].Text+', '+StatusBar.Panels[2].Text+', '+StatusBar.Panels[3].Text);
end;

[Helium]

Diky,
vyzkousim
// hodlam vylepsovat http://pinger.webz.cz/

[Smitka]

A co to přečíst rovnou z registru?
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Servic es\{id_adaptéru}\Parameters\Tcpip\DhcpSubnetMask

[Helium]

A co to přečíst rovnou z registru?
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Servic es\{id_adaptéru}\Parameters\Tcpip\DhcpSubnetMask

To mne sice take napadlo (resi to i tu vec kdyz sitovka neni online),
ale jak poznat ktere zaznamy jsou platne,
bezne tam tech ID adapteru je vice na jednu sitovku.

[Smitka]

Nemyslím, že každá síťovka má víc ID (nevím to na 100%). Síťový zařízení by mělo mít jednu konfiguraci.
Já bych asi zkusil se kouknout do klíče:
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Contro l\Class\{4D36E972-E325-11CE-BFC1-08002bE10318}\000x\
ten se bude dobře projíždět cyklem - x sou čísla od 0 do někam.
V každým tom klíči jsou informace o síťovejch zařízeních, sou tam takový věci jako spojení přes paralelní port , ale dá se určit co je LAN - ty by měli mít hodnotu Characteristics = 129
Pak je tam hodnota NetCfgInstanceId, což je ID k tý konfiguraci. Tak bych tam dal buď vývěr adaptéru, nebo bych ještě prohledal pár klíčů na IP.
Třeba ještě:
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Servic es\Tcpip\Parameters\Interfaces\{id_z_NetCfgInstanc eId}
a tam už jsou všechny potřebný hodnoty...
No a nebo by šlo získat podezřelý IDčka z nějaký hodnoty v HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Servic es\Tcpip\Linkage

[Rainbow]

Radsej by to chcelo pozriet dokumentaciu (ak existuje) ako naplacat nejaky kod, ktory bude nejako fungovat podla nejakych predpokladov, ktore nemusia byt vzdy pravdive.

[Helium]

Radsej by to chcelo pozriet dokumentaciu (ak existuje) ako naplacat nejaky kod, ktory bude nejako fungovat podla nejakych predpokladov, ktore nemusia byt vzdy pravdive.

Ceho je soucasti knihovna IPHlpAPI

Ja pouzivam Delphi 6 PE + ICS (sitove komponenty)

[MEluZíNa]

Zdravim,

zkus se podivat sem http://msdn2.microsoft.com/en-us/library/aa365917.aspx

Je tam i skoro komplet priklad. Obaleni do object pascalu jako domaci cviceni

[Helium]

Nasel jsem toto:

unit USock;

interface

uses Windows, Winsock, Classes;

{

This function enumerates all TCP/IP interfaces and
returns a CRLF separated string containing:

IP, NetMask, BroadCast-Address, Up/Down status,
Broadcast support, Loopback

If you feed this string to a wide TMEMO (to its memo.lines.text
property) you will see cleary the results.

To use this you need Win98/ME/2K, 95 OSR 2 or NT service
pack #3 because WinSock 2 is used (WS2_32.DLL)

}


function IsIeUsingOnlineMode : boolean;
function IsUserOnline : boolean;
function IsIpPresent : boolean;
function IsOnlineRas : Boolean;


function EnumInterfaces(var sInt: string): Boolean;




{ Imported function WSAIOCtl from Winsock 2.0 - Winsock 2 is }
{ available only in Win98/ME/2K and 95 OSR2, NT srv pack #3 }

function WSAIoctl(s: TSocket; cmd: DWORD; lpInBuffer: PCHAR; dwInBufferLen:
DWORD;
lpOutBuffer: PCHAR; dwOutBufferLen: DWORD;
lpdwOutBytesReturned: LPDWORD;
lpOverLapped: POINTER;
lpOverLappedRoutine: POINTER): Integer; stdcall; external 'WS2_32.DLL';

{ Constants taken from C header files }

const SIO_GET_INTERFACE_LIST = $4004747F;
IFF_UP = $00000001;
IFF_BROADCAST = $00000002;
IFF_LOOPBACK = $00000004;
IFF_POINTTOPOINT = $00000008;
IFF_MULTICAST = $00000010;

type sockaddr_gen = packed record
AddressIn: sockaddr_in;
filler: packed array[0..7] of char;
end;

type INTERFACE_INFO = packed record
iiFlags: u_long; // Interface flags
iiAddress: sockaddr_gen; // Interface address
iiBroadcastAddress: sockaddr_gen; // Broadcast address
iiNetmask: sockaddr_gen; // Network mask
end;


implementation


{-------------------------------------------------------------------

1. Open WINSOCK
2. Create a socket
3. Call WSAIOCtl to obtain network interfaces
4. For every interface, get IP, MASK, BROADCAST, status
5. Fill a CRLF separated string with this info
6. Finito

--------------------------------------------------------------------}

function EnumInterfaces(var sInt: string): Boolean;
var s: TSocket;
wsaD: WSADATA;
NumInterfaces: Integer;
BytesReturned, SetFlags: u_long;
pAddrInet: SOCKADDR_IN;
pAddrString: PCHAR;
PtrA: pointer;
Buffer: array[0..20] of INTERFACE_INFO;
i: Integer;
begin
result := true; // Initialize
sInt := '';

WSAStartup($0101, wsaD); // Start WinSock
// You should normally check
// for errors here

s := Socket(AF_INET, SOCK_STREAM, 0); // Open a socket
if (s = INVALID_SOCKET) then exit;

try // Call WSAIoCtl
PtrA := @bytesReturned;
if (WSAIoCtl(s, SIO_GET_INTERFACE_LIST, nil, 0, @Buffer, 1024, PtrA, nil,
nil)
<> SOCKET_ERROR)
then
begin // If ok, find out how
// many interfaces exist

NumInterfaces := BytesReturned div SizeOf(INTERFACE_INFO);

for i := 0 to NumInterfaces - 1 do // For every interface
begin
pAddrInet := Buffer[i].iiAddress.addressIn; // IP ADDRESS
pAddrString := inet_ntoa(pAddrInet.sin_addr);
sInt := sInt + ' IP=' + pAddrString + ',';


pAddrInet := Buffer[i].iiNetMask.addressIn; // SUBNET MASK
pAddrString := inet_ntoa(pAddrInet.sin_addr);
sInt := sInt + ' Mask=' + pAddrString + ',';
pAddrInet := Buffer[i].iiBroadCastAddress.addressIn; // Broadcast addr
pAddrString := inet_ntoa(pAddrInet.sin_addr);
sInt := sInt + ' Broadcast=' + pAddrString + ',';

SetFlags := Buffer[i].iiFlags;
if (SetFlags and IFF_UP) = IFF_UP then
sInt := sInt + ' Interface UP,' // Interface up/down
else
sInt := sInt + ' Interface DOWN,';

if (SetFlags and IFF_BROADCAST) = IFF_BROADCAST then // Broadcasts
sInt := sInt + ' Broadcasts supported,' // supported or
else // not supported
sInt := sInt + ' Broadcasts NOT supported,';

if (SetFlags and IFF_LOOPBACK) = IFF_LOOPBACK then // Loopback or
sInt := sInt + ' Loopback interface'
else
sInt := sInt + ' Network interface'; // normal

sInt := sInt + #13#10; // CRLF between
// each interface
end;
end;
except
end;
//
// Close sockets
//
CloseSocket(s);
WSACleanUp;
result := false;
end;

function IsIpPresent : boolean;
type
TApInAddr = array [0..10] of PInAddr;
PApInAddr = ^TApInAddr;
var
Phe : PHostEnt;
Pptr : PApInAddr;
Buf : array [0..63] of char;
i : Integer;
GInitData : TWsaData;
Ip : string;
begin
Result := FALSE;
WsaStartup ($101, GInitData);
GetHostName (Buf, SizeOf(Buf));
Phe := GetHostByName (Buf);
if Phe = nil then
Exit;
Pptr := PApInAddr(Phe^.h_addr_list);
i := 0;
while Pptr^[i] <> nil do
begin
Ip := inet_ntoa(Pptr^[i]^);
Inc(i);
end;
WsaCleanup;
Result := (Ip <> '') and (Ip <> '127.0.0.1');
end;

//--------------------------------------------------------------------------


function IsOnlineRas : boolean;
const
REG_RAS_BASE = 'System\CurrentControlSet\Services\RemoteAccess';
REG_RAS_RC = 'Remote Connection';
var
OpenKey : HKEY;
DataType,
DataSize,
Buf : DWORD;
begin
Result := FALSE;
if RegOpenKeyEx (HKEY_LOCAL_MACHINE, REG_RAS_BASE,
REG_OPTION_NON_VOLATILE,
KEY_READ, OpenKey) = ERROR_SUCCESS then
begin
DataType := REG_BINARY;
DataSize := SizeOf(Buf);
if RegQueryValueEx (OpenKey, REG_RAS_RC, nil, @DataType, @Buf,
@DataSize) =
ERROR_SUCCESS then
Result := (Buf = 1);
RegCloseKey (OpenKey);
end;
end;

//--------------------------------------------------------------------------


function IsIeUsingOnlineMode : boolean;
var
InetIsOffline : function (dwFlags : DWORD) : bool; stdcall;
HLib : THandle;

function GetBasicOsVer : integer;
var
VerInfo : TOsVersionInfo;
begin
VerInfo.dwOSVersionInfoSize := SizeOf(TOsVersionInfo);
if GetVersionEx (VerInfo) then
begin
case VerInfo.dwPlatformId of
VER_PLATFORM_WIN32_WINDOWS : Result := 1;
VER_PLATFORM_WIN32_NT : Result := 2;
else
Result := 0;
end;
end
else
Result := 0;
end;

//
// Win9x stores the InetIsOffline API in SHELL32.DLL while NT stores it in
// URL.DLL
//
function GetProperLibHandle : THandle;
begin
case GetBasicOsVer of
1 : Result := LoadLibrary ('SHELL32.DLL');
2 : Result := LoadLibrary ('URL.DLL');
else
Result := INVALID_HANDLE_VALUE;
end;
end;

begin
Result := FALSE;
HLib := GetProperLibHandle;
if HLib <> INVALID_HANDLE_VALUE then
try
@InetIsOffline := GetProcAddress (HLib, 'InetIsOffline');
if @InetIsOffline <> nil then
Result := not (InetIsOffline (0));
finally
FreeLibrary (HLib);
end;
end;

//--------------------------------------------------------------------------


function IsUserOnline : boolean;
begin
Result := IsIpPresent or IsOnlineRas or IsIeUsingOnlineMode;
end;


end.

ma jednu vadu, otevira to WinSock, ktery mam jiz otevreny jinymi VCL knihovnami.