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

[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.