IsWrongIP : testing if IP address is valid
IPAddrToName: Get Machines name from IP address
MACAddress : MAC address;
IPAddress : IP address;
DefaultUser : User name;
ComputerName: Computer name;
DNSServers : avalables DNS servers;
NWComputers : avalables Machines on network;
DomainName : domain name;
InternetConnected: Internet connection type(None, Proxy, Dialup);
Source / Exemple :
unit NetWorkAccess;
interface
uses
SysUtils, Classes, windows, registry;
const
MAX_HOSTNAME_LEN = 128;
MAX_DOMAIN_NAME_LEN = 128;
MAX_SCOPE_ID_LEN = 256;
cERROR_BUFFER_TOO_SMALL = 603;
cRAS_MaxEntryName = 256;
cRAS_MaxDeviceName = 128;
cRAS_MaxDeviceType = 16;
INTERNET_CONNECTION_MODEM = 1;
INTERNET_CONNECTION_LAN = 2;
INTERNET_CONNECTION_PROXY = 4;
INTERNET_CONNECTION_MODEM_BUSY = 8;
type
ERasError = class(Exception);
HRASConn = DWORD;
PRASConn = ^TRASConn;
TRASConn = record
dwSize: DWORD;
rasConn: HRASConn;
szEntryName: array[0..cRAS_MaxEntryName] of Char;
szDeviceType: array[0..cRAS_MaxDeviceType] of Char;
szDeviceName: array [0..cRAS_MaxDeviceName] of Char;
end;
TRasEnumConnections = function(RASConn: PrasConn; { buffer to receive Connections data }
var BufSize: DWORD; { size in bytes of buffer }
var Connections: DWORD { number of Connections written to buffer }
): Longint;
stdcall;
TConnectionType = (Modem, Lan, Proxy, ModemBuzy, None);
SERVER_INFO_503 = record
sv503_sessopens : Integer;
sv503_sessvcs : Integer;
sv503_opensearch : Integer;
sv503_sizreqbuf : Integer;
sv503_initworkitems : Integer;
sv503_maxworkitems : Integer;
sv503_rawworkitems : Integer;
sv503_irpstacksize : Integer;
sv503_maxrawbuflen : Integer;
sv503_sessusers : Integer;
sv503_sessconns : Integer;
sv503_maxpagedmemoryusage : Integer;
sv503_maxnonpagedmemoryusage : Integer;
sv503_enablesoftcompat :BOOL;
sv503_enableforcedlogoff :BOOL;
sv503_timesource :BOOL;
sv503_acceptdownlevelapis :BOOL;
sv503_lmannounce :BOOL;
sv503_domain : PWideChar;
sv503_maxcopyreadlen : Integer;
sv503_maxcopywritelen : Integer;
sv503_minkeepsearch : Integer;
sv503_maxkeepsearch : Integer;
sv503_minkeepcomplsearch : Integer;
sv503_maxkeepcomplsearch : Integer;
sv503_threadcountadd : Integer;
sv503_numblockthreads : Integer;
sv503_scavtimeout : Integer;
sv503_minrcvqueue : Integer;
sv503_minfreeworkitems : Integer;
sv503_xactmemsize : Integer;
sv503_threadpriority : Integer;
sv503_maxmpxct : Integer;
sv503_oplockbreakwait : Integer;
sv503_oplockbreakresponsewait : Integer;
sv503_enableoplocks : BOOL;
sv503_enableoplockforceclose : BOOL;
sv503_enablefcbopens : BOOL;
sv503_enableraw : BOOL;
sv503_enablesharednetdrives : BOOL;
sv503_minfreeconnections : Integer;
sv503_maxfreeconnections : Integer;
end;
PSERVER_INFO_503 = ^SERVER_INFO_503;
PNetResourceArray = ^TNetResourceArray;
TNetResourceArray = array[0..100] of TNetResource;
// TIPAddressString - store an IP address or mask as dotted decimal string
PIPAddressString = ^TIPAddressString;
PIPMaskString = ^TIPAddressString;
TIPAddressString = record
_String: array[0..(4 * 4) - 1] of Char;
end;
TIPMaskString = TIPAddressString;
// TIPAddrString - store an IP address with its corresponding subnet mask,
// both as dotted decimal strings
PIPAddrString = ^TIPAddrString;
TIPAddrString = packed record
Next: PIPAddrString;
IpAddress: TIPAddressString;
IpMask: TIPMaskString;
Context: DWORD;
end;
// FIXED_INFO - the set of IP-related information which does not depend on DHCP
PFixedInfo = ^TFixedInfo;
TFixedInfo = packed record
HostName: array[0..MAX_HOSTNAME_LEN + 4 - 1] of Char;
DomainName: array[0..MAX_DOMAIN_NAME_LEN + 4 - 1] of Char;
CurrentDnsServer: PIPAddrString;
DnsServerList: TIPAddrString;
NodeType: UINT;
ScopeId: array[0..MAX_SCOPE_ID_LEN + 4 - 1] of Char;
EnableRouting,
EnableProxy,
EnableDns: UINT;
end;
TNetWorkInfo = class(TComponent)
private
function GetMAC: string;
function GetIP: string;
function GetUser: string;
function GetCompName: string;
function GetDNSServ: TStringList;
function GetNWComp: TStringList;
function GetDN: String;
function GetIntConnected: TConnectionType;
protected
function Get_MACAddress: string;
function GetIPAddress: String;
function GetDefaultNetWareUserName: string;
function GetDefaultComputerName: string;
procedure GetDNSServers(AList: TStringList);
function CreateNetResourceList(ResourceType: DWord; NetResource: PNetResource; out Entries: DWord; out List: PNetResourceArray): Boolean;
procedure ScanNetworkResources(ResourceType, DisplayType: DWord; List: TStrings);
function GetDomainName : string;
function InternetconnectionType: TConnectionType;
function RasConnectionCount : Integer;
public
function IsWrongIP(Ip: string): Boolean;
function IPAddrToName(IPAddr: string): string;
property MACAddress : string read GetMAC;
property IPAddress : string read GetIP;
property DefaultUser : string read GetUser;
property ComputerName: string read GetCompName;
property DNSServers : TStringList read GetDNSServ ;
property NWComputers : TStringList read GetNWComp ;
property DomainName : String read GetDN;
property InternetConnected: TConnectionType read GetIntConnected;
published
end;
function GetNetworkParams(pFixedInfo: PFixedInfo; pOutBufLen: PULONG): DWORD; stdcall;
function NetServerGetInfo(serverName : PWideChar; level : Integer;var bufptr : Pointer) : Cardinal; stdcall; external 'NETAPI32.DLL';
function NetApiBufferFree(buffer : Pointer) : Cardinal; stdcall; external 'NETAPI32.DLL';
function InternetGetConnectedState(lpdwFlags: LPDWORD;dwReserved: DWORD): BOOL; stdcall; external 'WININET.DLL';
procedure Register;
implementation
uses WinSock, ActiveX, NB30;
const
{$IFDEF MSWINDOWS}
iphlpapidll = 'iphlpapi.dll';
{$ENDIF}
function GetNetworkParams; external iphlpapidll Name 'GetNetworkParams';
procedure Register;
begin
RegisterComponents('NetWork', [TNetWorkInfo]);
end;
{ TNetWorkInfo }
function TNetWorkInfo.IPAddrToName(IPAddr: string): string;
var
SockAddrIn: TSockAddrIn;
HostEnt: PHostEnt;
WSAData: TWSAData;
begin
WSAStartup($101, WSAData);
SockAddrIn.sin_addr.s_addr := inet_addr(PChar(IPAddr));
HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
if HostEnt <> nil then
Result := StrPas(Hostent^.h_name)
else
Result := '';
end;
function TNetWorkInfo.RasConnectionCount: Integer;
var
RasDLL: HInst;
Conns: array[1..4] of TRasConn;
RasEnums: TRasEnumConnections;
BufSize: DWORD;
NumConns: DWORD;
RasResult: Longint;
begin
Result := 0;
//Load the RAS DLL
RasDLL := LoadLibrary('rasapi32.dll');
if RasDLL = 0 then Exit;
try
RasEnums := GetProcAddress(RasDLL, 'RasEnumConnectionsA');
if @RasEnums = nil then
raise ERasError.Create('RasEnumConnectionsA not found in rasapi32.dll');
Conns[1].dwSize := SizeOf(Conns[1]);
BufSize := SizeOf(Conns);
RasResult := RasEnums(@Conns, BufSize, NumConns);
if (RasResult = 0) or (Result = cERROR_BUFFER_TOO_SMALL) then Result := NumConns;
finally
FreeLibrary(RasDLL);
end;
end;
function TNetWorkInfo.GetDomainName : string;
var
err : Integer;
buf : pointer;
fDomainName: string;
wServerName : WideString;
begin
wServerName := GetDefaultComputerName;
err := NetServerGetInfo (PWideChar (wServerName), 503, buf);
if err = 0 then
try
fDomainName := PSERVER_INFO_503 (buf)^.sv503_domain;
finally
NetAPIBufferFree (buf)
end;
result := fDomainName;
end;
function TNetWorkInfo.IsWrongIP(Ip: string): Boolean;
const
Z = ['0'..'9', '.'];
var
I, J, P: Integer;
W: string;
begin
Result := False;
if (Length(Ip) > 15) or (Ip[1] = '.') then Exit;
I := 1;
J := 0;
P := 0;
W := '';
repeat
if (Ip[I] in Z) and (J < 4) then
begin
if Ip[I] = '.' then
begin
Inc(P);
J := 0;
try
StrToInt(Ip[I + 1]);
except
Exit;
end;
W := '';
end
else
begin
W := W + Ip[I];
if (StrToInt(W) > 255) or (Length(W) > 3) then Exit;
Inc(J);
end;
end
else
Exit;
Inc(I);
until I > Length(Ip);
if P < 3 then Exit;
Result := True;
end;
function TNetWorkInfo.CreateNetResourceList(ResourceType: DWord; NetResource: PNetResource;
out Entries: DWord; out List: PNetResourceArray): Boolean;
var
EnumHandle: THandle;
BufSize: DWord;
Res: DWord;
begin
Result := False;
List := Nil;
Entries := 0;
if WNetOpenEnum(RESOURCE_GLOBALNET,
ResourceType,
0,
NetResource,
EnumHandle) = NO_ERROR then begin
try
BufSize := $4000; // 16 kByte
GetMem(List, BufSize);
try
repeat
Entries := DWord(-1);
FillChar(List^, BufSize, 0);
Res := WNetEnumResource(EnumHandle, Entries, List, BufSize);
if Res = ERROR_MORE_DATA then
begin
ReAllocMem(List, BufSize);
end;
until Res <> ERROR_MORE_DATA;
Result := Res = NO_ERROR;
if not Result then
begin
FreeMem(List);
List := Nil;
Entries := 0;
end;
except
FreeMem(List);
raise;
end;
finally
WNetCloseEnum(EnumHandle);
end;
end;
end;
procedure TNetWorkInfo.ScanNetworkResources(ResourceType, DisplayType: DWord; List: TStrings);
procedure ScanLevel(NetResource: PNetResource);
var
Entries: DWord;
NetResourceList: PNetResourceArray;
i: Integer;
begin
if CreateNetResourceList(ResourceType, NetResource, Entries, NetResourceList) then try
for i := 0 to Integer(Entries) - 1 do
begin
if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or
(NetResourceList[i].dwDisplayType = DisplayType) then begin
List.AddObject(NetResourceList[i].lpRemoteName, Pointer(NetResourceList[i].dwDisplayType));
end;
if (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 then
ScanLevel(@NetResourceList[i]);
end;
finally
FreeMem(NetResourceList);
end;
end;
begin
ScanLevel(Nil);
end;
procedure TNetWorkInfo.GetDNSServers(AList: TStringList);
var
pFI: PFixedInfo;
pIPAddr: PIPAddrString;
OutLen: Cardinal;
begin
AList.Clear;
OutLen := SizeOf(TFixedInfo);
GetMem(pFI, SizeOf(TFixedInfo));
try
if GetNetworkParams(pFI, @OutLen) = ERROR_BUFFER_OVERFLOW then
begin
ReallocMem(pFI, OutLen);
if GetNetworkParams(pFI, @OutLen) <> NO_ERROR then Exit;
end;
// If there is no network available there may be no DNS servers defined
if pFI^.DnsServerList.IpAddress._String[0] = #0 then Exit;
// Add first server
AList.Add(pFI^.DnsServerList.IpAddress._String);
// Add rest of servers
pIPAddr := pFI^.DnsServerList.Next;
while Assigned(pIPAddr) do
begin
AList.Add(pIPAddr^.IpAddress._String);
pIPAddr := pIPAddr^.Next;
end;
finally
FreeMem(pFI);
end;
end;
function TNetWorkInfo.GetDefaultNetWareUserName: string;
var ipNam: PChar;
Size: DWord;
begin
ipNam := nil;
Size := 128;
try
Result := '';
GetMem(ipNam, Size);
if GetUserName(ipNam, Size)
then Result := UpperCase(TRIM(strPas(ipNam)))
else Result := '?';
finally
FreeMem(ipNam, 10);
end;
end;
function TNetWorkInfo.GetDefaultComputerName: string;
var ipNam: PChar;
Size: DWord;
begin
ipNam := nil;
Size := MAX_COMPUTERNAME_LENGTH + 1;
try
Result := '';
GetMem(ipNam, Size);
if GetComputerName(ipNam, Size)
then Result := UpperCase(TRIM(strPas(ipNam)))
else Result := '?';
finally
FreeMem(ipNam, 10);
end;
end;
function TNetWorkInfo.Get_MACAddress: string;
var
NCB: PNCB;
Adapter: PAdapterStatus;
URetCode: PChar;
RetCode: char;
I: integer;
Lenum: PlanaEnum;
_SystemID: string;
TMPSTR: string;
begin
Result := '';
_SystemID := '';
Getmem(NCB, SizeOf(TNCB));
Fillchar(NCB^, SizeOf(TNCB), 0);
Getmem(Lenum, SizeOf(TLanaEnum));
Fillchar(Lenum^, SizeOf(TLanaEnum), 0);
Getmem(Adapter, SizeOf(TAdapterStatus));
Fillchar(Adapter^, SizeOf(TAdapterStatus), 0);
Lenum.Length := chr(0);
NCB.ncb_command := chr(NCBENUM);
NCB.ncb_buffer := Pointer(Lenum);
NCB.ncb_length := SizeOf(Lenum);
RetCode := Netbios(NCB);
i := 0;
repeat
Fillchar(NCB^, SizeOf(TNCB), 0);
Ncb.ncb_command := chr(NCBRESET);
Ncb.ncb_lana_num := lenum.lana[I];
RetCode := Netbios(Ncb);
Fillchar(NCB^, SizeOf(TNCB), 0);
Ncb.ncb_command := chr(NCBASTAT);
Ncb.ncb_lana_num := lenum.lana[I];
// Must be 16
Ncb.ncb_callname := '* ';
Ncb.ncb_buffer := Pointer(Adapter);
Ncb.ncb_length := SizeOf(TAdapterStatus);
RetCode := Netbios(Ncb);
//---- calc _systemId from mac-address[2-5] XOR mac-address[1]...
if (RetCode = chr(0)) or (RetCode = chr(6)) then
begin
_SystemId := IntToHex(Ord(Adapter.adapter_address[0]), 2) + '-' +
IntToHex(Ord(Adapter.adapter_address[1]), 2) + '-' +
IntToHex(Ord(Adapter.adapter_address[2]), 2) + '-' +
IntToHex(Ord(Adapter.adapter_address[3]), 2) + '-' +
IntToHex(Ord(Adapter.adapter_address[4]), 2) + '-' +
IntToHex(Ord(Adapter.adapter_address[5]), 2);
end;
Inc(i);
until (I >= Ord(Lenum.Length)) or (_SystemID <> '00-00-00-00-00-00');
FreeMem(NCB);
FreeMem(Adapter);
FreeMem(Lenum);
Result := _SystemID;
end;
function TNetWorkInfo.GetIPAddress: String;
type
TaPInAddr = Array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: Array[0..63] of Char;
I: Integer;
GInitData: TWSAData;
begin
WSAStartup($101, GInitData);
Result := '';
GetHostName(Buffer, SizeOf(Buffer));
phe := GetHostByName(buffer);
if phe = nil then Exit;
pPtr := PaPInAddr(phe^.h_addr_list);
I := 0;
while pPtr^[I] <> nil do
begin
Result := inet_ntoa(pptr^[I]^);
Inc(I);
end;
WSACleanup;
end;
function TNetWorkInfo.GetMAC: string;
begin
Result := Get_MACAddress ;
end;
function TNetWorkInfo.GetIP: string;
begin
Result := GetIPAddress;
end;
function TNetWorkInfo.GetUser: string;
begin
Result := GetDefaultNetWareUserName;
end;
function TNetWorkInfo.GetCompName: string;
begin
Result := GetDefaultComputerName;
end;
function TNetWorkInfo.GetDNSServ: TStringList;
var
DNSList : TStringList;
begin
DNSList := TStringList.Create;
GetDNSServers(DNSList);
Result := DNSList;
end;
function TNetWorkInfo.GetNWComp: TStringList;
var
CompList : TStringList;
begin
CompList := TStringList.Create;
ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER,CompList);
Result := CompList;
end;
function TNetWorkInfo.GetDN: String;
begin
Result := GetDomainName;
end;
function TNetWorkInfo.GetIntConnected: TConnectionType;
begin
Result := InternetconnectionType;
end;
function TNetWorkInfo.InternetconnectionType: TConnectionType;
var
dwConnectionTypes: Integer;
Res : boolean;
begin
Res := InternetGetConnectedState(@dwConnectionTypes, 0);
if (dwConnectionTypes and INTERNET_CONNECTION_MODEM )= INTERNET_CONNECTION_MODEM then
begin
Result := Modem;
Exit;
end;
if (dwConnectionTypes and INTERNET_CONNECTION_LAN )= INTERNET_CONNECTION_LAN then
begin
Result := Lan;
Exit;
end;
if (dwConnectionTypes and INTERNET_CONNECTION_PROXY) = INTERNET_CONNECTION_PROXY then
begin
Result := Proxy;
Exit;
end;
Result := None;
end;
end.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.