WebSVN – userdetect2 – Diff – /trunk/UserDetect2/Plugins/NetworkUtils.pas


unit NetworkUtils;
 
interface
 
uses
  Windows, SysUtils, Classes;
 
function GetLocalIPAddressList(outsl: TStrings): DWORD;
function GetLocalMACAddressList(outSL: TStrings): DWORD;
function GetDHCPIPAddressList(outsl: TStrings): DWORD;
function GetGatewayIPAddressList(outsl: TStrings): DWORD;
function GetMACAddress(const IPAddress: string; var outAddress: string): DWORD;
function FormatMAC(s: string): string;
function GetDomainName(var outDomainName: WideString): boolean;
 
implementation
 
uses
  {$IFDEF UNICODE}
  iphlpapi, IpTypes, Iprtrmib,
  {$ELSE}
  iphlp,
  {$ENDIF}
  WinSock, Registry;
 
// TODO: Replace GetAdaptersInfo()? A comment at MSDN states that there might be problems with IPv6
//           "GetAdaptersInfo returns ERROR_NO_DATA if there are only IPv6 interfaces
//            configured on system. In that case GetAdapterAddresses has to be used!"
 
function GetLocalIPAddressList(outsl: TStrings): DWORD;
var
  pAdapterInfo: PIP_ADAPTER_INFO;
  addr: AnsiString;
  addrStr: IP_ADDR_STRING;
  BufLen: ULONG;
begin
  BufLen := SizeOf(IP_ADAPTER_INFO);
  Result := GetAdaptersInfo(nil, BufLen);
  if Result <> ERROR_BUFFER_OVERFLOW then Exit;
  pAdapterInfo := AllocMem(BufLen);
  try
    ZeroMemory(pAdapterInfo, BufLen);
    Result := GetAdaptersInfo(pAdapterInfo, BufLen);
    if Result <> ERROR_SUCCESS then Exit;
    while pAdapterInfo <> nil do
    begin
      addrStr := pAdapterInfo^.IpAddressList;
      repeat
        addr := addrStr.IpAddress.S;
        if (addr <> '') and (outsl.IndexOf(addr) = -1) then
          outsl.Add(addr);
        if addrStr.Next = nil then break;
        AddrStr := addrStr.Next^;
      until false;
      pAdapterInfo := pAdapterInfo^.next;
    end;
  finally
    Freemem(pAdapterInfo);
  end;
end;
 
function GetDHCPIPAddressList(outsl: TStrings): DWORD;
var
  pAdapterInfo: PIP_ADAPTER_INFO;
  addr: AnsiString;
  addrStr: IP_ADDR_STRING;
  BufLen: ULONG;
begin
  BufLen := SizeOf(IP_ADAPTER_INFO);
  Result := GetAdaptersInfo(nil, BufLen);
  if Result <> ERROR_BUFFER_OVERFLOW then Exit;
  pAdapterInfo := AllocMem(BufLen);
  try
    ZeroMemory(pAdapterInfo, BufLen);
    Result := GetAdaptersInfo(pAdapterInfo, BufLen);
    if Result <> ERROR_SUCCESS then Exit;
    while pAdapterInfo <> nil do
    begin
      addrStr := pAdapterInfo^.DhcpServer;
      repeat
        addr := addrStr.IpAddress.S;
        if (addr <> '') and (outsl.IndexOf(addr) = -1) then
          outsl.Add(addr);
        if addrStr.Next = nil then break;
        AddrStr := addrStr.Next^;
      until false;
      pAdapterInfo := pAdapterInfo^.next;
    end;
  finally
    Freemem(pAdapterInfo);
  end;
end;
 
function GetGatewayIPAddressList(outsl: TStrings): DWORD;
var
  pAdapterInfo: PIP_ADAPTER_INFO;
  addr: AnsiString;
  addrStr: IP_ADDR_STRING;
  BufLen: ULONG;
begin
  BufLen := SizeOf(IP_ADAPTER_INFO);
  Result := GetAdaptersInfo(nil, BufLen);
  if Result <> ERROR_BUFFER_OVERFLOW then Exit;
  pAdapterInfo := AllocMem(BufLen);
  try
    ZeroMemory(pAdapterInfo, BufLen);
    Result := GetAdaptersInfo(pAdapterInfo, BufLen);
    if Result <> ERROR_SUCCESS then Exit;
    while pAdapterInfo <> nil do
    begin
      addrStr := pAdapterInfo^.GatewayList;
      repeat
        addr := addrStr.IpAddress.S;
        if (addr <> '') and (outsl.IndexOf(addr) = -1) then
          outsl.Add(addr);
        if addrStr.Next = nil then break;
        AddrStr := addrStr.Next^;
      until false;
      pAdapterInfo := pAdapterInfo^.next;
    end;
  finally
    Freemem(pAdapterInfo);
  end;
end;
 
function GetMACAddress(const IPAddress: string; var outAddress: string): DWORD;
// http://stackoverflow.com/questions/4550672/delphi-get-mac-of-router
var
  MacAddr    : Array[0..5] of Byte;
  DestIP     : ULONG;
  PhyAddrLen : ULONG;
  WSAData    : TWSAData;
  j: integer;
begin
  outAddress := '';
  WSAStartup($0101, WSAData);
  try
    ZeroMemory(@MacAddr, SizeOf(MacAddr));
    DestIP     := inet_addr(PAnsiChar(IPAddress));
    PhyAddrLen := SizeOf(MacAddr); // TODO: more ?
    Result     := SendArp(DestIP, 0, @MacAddr, PhyAddrLen);
    if Result = S_OK then
    begin
      outAddress := '';
      for j := 0 to PhyAddrLen-1 do
      begin
        outAddress := outAddress + format('%.2x', [MacAddr[j]]);
      end;
      outAddress := FormatMAC(outAddress);
    end;
  finally
    WSACleanup;
  end;
end;
 
function GetLocalMACAddressList(outSL: TStrings): DWORD;
var
  pIfTable: PMIB_IFTABLE;
  TableSize: ULONG;
  tmp: String;
  i, j: Integer;
begin
  pIfTable := nil;
  try
    // First: just get the buffer size.
    // TableSize returns the size needed.
    TableSize := 0; // Set to zero so the GetIfTable function won't try to fill the buffer yet,
                    // but only return the actual size it needs.
    GetIfTable(pIfTable, TableSize, true);
    if (TableSize < SizeOf(MIB_IFROW)+SizeOf(LongInt)) then
    begin
      Result := ERROR_NO_DATA;
      Exit; // less than 1 table entry?!
    end;
 
    // Second:
    // allocate memory for the buffer and retrieve the
    // entire table.
    GetMem(pIfTable, TableSize);
    Result := GetIfTable(pIfTable, TableSize, true);
    if Result <> NO_ERROR then Exit;
 
    // Read the ETHERNET addresses.
    for i := 1 to pIfTable^.dwNumEntries do
    begin
      //if pIfTable^.table[i].dwType = MIB_IF_TYPE_ETHERNET then
      begin
        tmp := '';
        for j := 0 to pIfTable^.table[i].dwPhysAddrLen-1 do
        begin
          tmp := tmp + format('%.2x', [pIfTable^.table[i].bPhysAddr[j]]);
        end;
        tmp := FormatMAC(tmp);
        if (tmp <> '') and (outSL.IndexOf(tmp) = -1) then
          outSL.Add(tmp);
      end;
    end;
  finally
    if Assigned(pIfTable) then FreeMem(pIfTable, TableSize);
  end;
end;
 
function FormatMAC(s: string): string;
var
  m: integer;
begin
  result := '';
  m := 1;
  s := UpperCase(s);
  repeat
    if m > 1 then result := result + '-';
    result := result + Copy(s, m, 2);
    inc(m, 2);
  until m > Length(s);
end;
 
(*
type
  WKSTA_INFO_100   = Record
      wki100_platform_id  : DWORD;
      wki100_computername : LPWSTR;
      wki100_langroup     : LPWSTR;
      wki100_ver_major    : DWORD;
      wki100_ver_minor    : DWORD;
  End;
 
   LPWKSTA_INFO_100 = ^WKSTA_INFO_100;
 
function GetNetParam(AParam: integer): string;
Var
  PBuf  : LPWKSTA_INFO_100;
  Res   : LongInt;
begin
  result := '';
  Res := NetWkstaGetInfo(nil, 100, @PBuf);
  If Res = NERR_Success Then
    begin
      case AParam of
       0:   Result := string(PBuf^.wki100_computername);
       1:   Result := string(PBuf^.wki100_langroup);
      end;
    end;
end;
 
function GetTheComputerName: string;
begin
  Result := GetNetParam(0);
end;
 
function GetTheDomainName: string;
begin
  Result := GetNetParam(1);
end;
 
*)
 
function GetDomainName(var outDomainName: WideString): boolean;
var
  reg: TRegistry;
begin
  outDomainName := '';
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    result := reg.OpenKeyReadOnly('\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters');
    if result then
    begin
      outDomainName := reg.ReadString('Domain');
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
end.
 

Rev 92	Rev 93
1	unit NetworkUtils;	1	unit NetworkUtils;
2		2
3	interface	3	interface
4		4
5	uses	5	uses
6	Windows, SysUtils, Classes;	6	Windows, SysUtils, Classes;
7		7
8	function GetLocalIPAddressList(outsl: TStrings): DWORD;	8	function GetLocalIPAddressList(outsl: TStrings): DWORD;
9	function GetLocalMACAddressList(outSL: TStrings): DWORD;	9	function GetLocalMACAddressList(outSL: TStrings): DWORD;
10	function GetDHCPIPAddressList(outsl: TStrings): DWORD;	10	function GetDHCPIPAddressList(outsl: TStrings): DWORD;
11	function GetGatewayIPAddressList(outsl: TStrings): DWORD;	11	function GetGatewayIPAddressList(outsl: TStrings): DWORD;
12	function GetMACAddress(const IPAddress: string; var outAddress: string): DWORD;	12	function GetMACAddress(const IPAddress: string; var outAddress: string): DWORD;
13	function FormatMAC(s: string): string;	13	function FormatMAC(s: string): string;
14	function GetDomainName(var outDomainName: WideString): boolean;	14	function GetDomainName(var outDomainName: WideString): boolean;
15		15
16	implementation	16	implementation
17		17
18	uses	18	uses
-		19	{$IFDEF UNICODE}
19	iphlpapi, IpTypes, Iprtrmib, WinSock, Registry;	20	iphlpapi, IpTypes, Iprtrmib,
-		21	{$ELSE}
-		22	iphlp,
-		23	{$ENDIF}
-		24	WinSock, Registry;
20		25
21	// TODO: Replace GetAdaptersInfo()? A comment at MSDN states that there might be problems with IPv6	26	// TODO: Replace GetAdaptersInfo()? A comment at MSDN states that there might be problems with IPv6
22	// "GetAdaptersInfo returns ERROR_NO_DATA if there are only IPv6 interfaces	27	// "GetAdaptersInfo returns ERROR_NO_DATA if there are only IPv6 interfaces
23	// configured on system. In that case GetAdapterAddresses has to be used!"	28	// configured on system. In that case GetAdapterAddresses has to be used!"
24		29
25	function GetLocalIPAddressList(outsl: TStrings): DWORD;	30	function GetLocalIPAddressList(outsl: TStrings): DWORD;
26	var	31	var
27	pAdapterInfo: PIP_ADAPTER_INFO;	32	pAdapterInfo: PIP_ADAPTER_INFO;
28	addr: AnsiString;	33	addr: AnsiString;
29	addrStr: IP_ADDR_STRING;	34	addrStr: IP_ADDR_STRING;
30	BufLen: Cardinal;	35	BufLen: ULONG;
31	begin	36	begin
32	BufLen := SizeOf(IP_ADAPTER_INFO);	37	BufLen := SizeOf(IP_ADAPTER_INFO);
33	Result := GetAdaptersInfo(nil, BufLen);	38	Result := GetAdaptersInfo(nil, BufLen);
34	if Result <> ERROR_BUFFER_OVERFLOW then Exit;	39	if Result <> ERROR_BUFFER_OVERFLOW then Exit;
35	pAdapterInfo := AllocMem(BufLen);	40	pAdapterInfo := AllocMem(BufLen);
36	try	41	try
37	ZeroMemory(pAdapterInfo, BufLen);	42	ZeroMemory(pAdapterInfo, BufLen);
38	Result := GetAdaptersInfo(pAdapterInfo, BufLen);	43	Result := GetAdaptersInfo(pAdapterInfo, BufLen);
39	if Result <> ERROR_SUCCESS then Exit;	44	if Result <> ERROR_SUCCESS then Exit;
40	while pAdapterInfo <> nil do	45	while pAdapterInfo <> nil do
41	begin	46	begin
42	addrStr := pAdapterInfo^.IpAddressList;	47	addrStr := pAdapterInfo^.IpAddressList;
43	repeat	48	repeat
44	addr := addrStr.IpAddress.S;	49	addr := addrStr.IpAddress.S;
45	if (addr <> '') and (outsl.IndexOf(addr) = -1) then	50	if (addr <> '') and (outsl.IndexOf(addr) = -1) then
46	outsl.Add(addr);	51	outsl.Add(addr);
47	if addrStr.Next = nil then break;	52	if addrStr.Next = nil then break;
48	AddrStr := addrStr.Next^;	53	AddrStr := addrStr.Next^;
49	until false;	54	until false;
50	pAdapterInfo := pAdapterInfo^.next;	55	pAdapterInfo := pAdapterInfo^.next;
51	end;	56	end;
52	finally	57	finally
53	Freemem(pAdapterInfo);	58	Freemem(pAdapterInfo);
54	end;	59	end;
55	end;	60	end;
56		61
57	function GetDHCPIPAddressList(outsl: TStrings): DWORD;	62	function GetDHCPIPAddressList(outsl: TStrings): DWORD;
58	var	63	var
59	pAdapterInfo: PIP_ADAPTER_INFO;	64	pAdapterInfo: PIP_ADAPTER_INFO;
60	addr: AnsiString;	65	addr: AnsiString;
61	addrStr: IP_ADDR_STRING;	66	addrStr: IP_ADDR_STRING;
62	BufLen: Cardinal;	67	BufLen: ULONG;
63	begin	68	begin
64	BufLen := SizeOf(IP_ADAPTER_INFO);	69	BufLen := SizeOf(IP_ADAPTER_INFO);
65	Result := GetAdaptersInfo(nil, BufLen);	70	Result := GetAdaptersInfo(nil, BufLen);
66	if Result <> ERROR_BUFFER_OVERFLOW then Exit;	71	if Result <> ERROR_BUFFER_OVERFLOW then Exit;
67	pAdapterInfo := AllocMem(BufLen);	72	pAdapterInfo := AllocMem(BufLen);
68	try	73	try
69	ZeroMemory(pAdapterInfo, BufLen);	74	ZeroMemory(pAdapterInfo, BufLen);
70	Result := GetAdaptersInfo(pAdapterInfo, BufLen);	75	Result := GetAdaptersInfo(pAdapterInfo, BufLen);
71	if Result <> ERROR_SUCCESS then Exit;	76	if Result <> ERROR_SUCCESS then Exit;
72	while pAdapterInfo <> nil do	77	while pAdapterInfo <> nil do
73	begin	78	begin
74	addrStr := pAdapterInfo^.DhcpServer;	79	addrStr := pAdapterInfo^.DhcpServer;
75	repeat	80	repeat
76	addr := addrStr.IpAddress.S;	81	addr := addrStr.IpAddress.S;
77	if (addr <> '') and (outsl.IndexOf(addr) = -1) then	82	if (addr <> '') and (outsl.IndexOf(addr) = -1) then
78	outsl.Add(addr);	83	outsl.Add(addr);
79	if addrStr.Next = nil then break;	84	if addrStr.Next = nil then break;
80	AddrStr := addrStr.Next^;	85	AddrStr := addrStr.Next^;
81	until false;	86	until false;
82	pAdapterInfo := pAdapterInfo^.next;	87	pAdapterInfo := pAdapterInfo^.next;
83	end;	88	end;
84	finally	89	finally
85	Freemem(pAdapterInfo);	90	Freemem(pAdapterInfo);
86	end;	91	end;
87	end;	92	end;
88		93
89	function GetGatewayIPAddressList(outsl: TStrings): DWORD;	94	function GetGatewayIPAddressList(outsl: TStrings): DWORD;
90	var	95	var
91	pAdapterInfo: PIP_ADAPTER_INFO;	96	pAdapterInfo: PIP_ADAPTER_INFO;
92	addr: AnsiString;	97	addr: AnsiString;
93	addrStr: IP_ADDR_STRING;	98	addrStr: IP_ADDR_STRING;
94	BufLen: Cardinal;	99	BufLen: ULONG;
95	begin	100	begin
96	BufLen := SizeOf(IP_ADAPTER_INFO);	101	BufLen := SizeOf(IP_ADAPTER_INFO);
97	Result := GetAdaptersInfo(nil, BufLen);	102	Result := GetAdaptersInfo(nil, BufLen);
98	if Result <> ERROR_BUFFER_OVERFLOW then Exit;	103	if Result <> ERROR_BUFFER_OVERFLOW then Exit;
99	pAdapterInfo := AllocMem(BufLen);	104	pAdapterInfo := AllocMem(BufLen);
100	try	105	try
101	ZeroMemory(pAdapterInfo, BufLen);	106	ZeroMemory(pAdapterInfo, BufLen);
102	Result := GetAdaptersInfo(pAdapterInfo, BufLen);	107	Result := GetAdaptersInfo(pAdapterInfo, BufLen);
103	if Result <> ERROR_SUCCESS then Exit;	108	if Result <> ERROR_SUCCESS then Exit;
104	while pAdapterInfo <> nil do	109	while pAdapterInfo <> nil do
105	begin	110	begin
106	addrStr := pAdapterInfo^.GatewayList;	111	addrStr := pAdapterInfo^.GatewayList;
107	repeat	112	repeat
108	addr := addrStr.IpAddress.S;	113	addr := addrStr.IpAddress.S;
109	if (addr <> '') and (outsl.IndexOf(addr) = -1) then	114	if (addr <> '') and (outsl.IndexOf(addr) = -1) then
110	outsl.Add(addr);	115	outsl.Add(addr);
111	if addrStr.Next = nil then break;	116	if addrStr.Next = nil then break;
112	AddrStr := addrStr.Next^;	117	AddrStr := addrStr.Next^;
113	until false;	118	until false;
114	pAdapterInfo := pAdapterInfo^.next;	119	pAdapterInfo := pAdapterInfo^.next;
115	end;	120	end;
116	finally	121	finally
117	Freemem(pAdapterInfo);	122	Freemem(pAdapterInfo);
118	end;	123	end;
119	end;	124	end;
120		125
121	function GetMACAddress(const IPAddress: string; var outAddress: string): DWORD;	126	function GetMACAddress(const IPAddress: string; var outAddress: string): DWORD;
122	// http://stackoverflow.com/questions/4550672/delphi-get-mac-of-router	127	// http://stackoverflow.com/questions/4550672/delphi-get-mac-of-router
123	var	128	var
124	MacAddr : Array[0..5] of Byte;	129	MacAddr : Array[0..5] of Byte;
125	DestIP : ULONG;	130	DestIP : ULONG;
126	PhyAddrLen : ULONG;	131	PhyAddrLen : ULONG;
127	WSAData : TWSAData;	132	WSAData : TWSAData;
128	j: integer;	133	j: integer;
129	begin	134	begin
130	outAddress := '';	135	outAddress := '';
131	WSAStartup($0101, WSAData);	136	WSAStartup($0101, WSAData);
132	try	137	try
133	ZeroMemory(@MacAddr, SizeOf(MacAddr));	138	ZeroMemory(@MacAddr, SizeOf(MacAddr));
134	DestIP := inet_addr(PAnsiChar(IPAddress));	139	DestIP := inet_addr(PAnsiChar(IPAddress));
135	PhyAddrLen := SizeOf(MacAddr); // TODO: more ?	140	PhyAddrLen := SizeOf(MacAddr); // TODO: more ?
136	Result := SendArp(DestIP, 0, @MacAddr, PhyAddrLen);	141	Result := SendArp(DestIP, 0, @MacAddr, PhyAddrLen);
137	if Result = S_OK then	142	if Result = S_OK then
138	begin	143	begin
139	outAddress := '';	144	outAddress := '';
140	for j := 0 to PhyAddrLen-1 do	145	for j := 0 to PhyAddrLen-1 do
141	begin	146	begin
142	outAddress := outAddress + format('%.2x', [MacAddr[j]]);	147	outAddress := outAddress + format('%.2x', [MacAddr[j]]);
143	end;	148	end;
144	outAddress := FormatMAC(outAddress);	149	outAddress := FormatMAC(outAddress);
145	end;	150	end;
146	finally	151	finally
147	WSACleanup;	152	WSACleanup;
148	end;	153	end;
149	end;	154	end;
150		155
151	function GetLocalMACAddressList(outSL: TStrings): DWORD;	156	function GetLocalMACAddressList(outSL: TStrings): DWORD;
152	var	157	var
153	pIfTable: PMIB_IFTABLE;	158	pIfTable: PMIB_IFTABLE;
154	TableSize: Cardinal;	159	TableSize: ULONG;
155	tmp: String;	160	tmp: String;
156	i, j: Integer;	161	i, j: Integer;
157	begin	162	begin
158	pIfTable := nil;	163	pIfTable := nil;
159	try	164	try
160	// First: just get the buffer size.	165	// First: just get the buffer size.
161	// TableSize returns the size needed.	166	// TableSize returns the size needed.
162	TableSize := 0; // Set to zero so the GetIfTable function won't try to fill the buffer yet,	167	TableSize := 0; // Set to zero so the GetIfTable function won't try to fill the buffer yet,
163	// but only return the actual size it needs.	168	// but only return the actual size it needs.
164	GetIfTable(pIfTable, TableSize, true);	169	GetIfTable(pIfTable, TableSize, true);
165	if (TableSize < SizeOf(MIB_IFROW)+SizeOf(LongInt)) then	170	if (TableSize < SizeOf(MIB_IFROW)+SizeOf(LongInt)) then
166	begin	171	begin
167	Result := ERROR_NO_DATA;	172	Result := ERROR_NO_DATA;
168	Exit; // less than 1 table entry?!	173	Exit; // less than 1 table entry?!
169	end;	174	end;
170		175
171	// Second:	176	// Second:
172	// allocate memory for the buffer and retrieve the	177	// allocate memory for the buffer and retrieve the
173	// entire table.	178	// entire table.
174	GetMem(pIfTable, TableSize);	179	GetMem(pIfTable, TableSize);
175	Result := GetIfTable(pIfTable, TableSize, true);	180	Result := GetIfTable(pIfTable, TableSize, true);
176	if Result <> NO_ERROR then Exit;	181	if Result <> NO_ERROR then Exit;
177		182
178	// Read the ETHERNET addresses.	183	// Read the ETHERNET addresses.
179	for i := 1 to pIfTable^.dwNumEntries do	184	for i := 1 to pIfTable^.dwNumEntries do
180	begin	185	begin
181	//if pIfTable^.table[i].dwType = MIB_IF_TYPE_ETHERNET then	186	//if pIfTable^.table[i].dwType = MIB_IF_TYPE_ETHERNET then
182	begin	187	begin
183	tmp := '';	188	tmp := '';
184	for j := 0 to pIfTable^.table[i].dwPhysAddrLen-1 do	189	for j := 0 to pIfTable^.table[i].dwPhysAddrLen-1 do
185	begin	190	begin
186	tmp := tmp + format('%.2x', [pIfTable^.table[i].bPhysAddr[j]]);	191	tmp := tmp + format('%.2x', [pIfTable^.table[i].bPhysAddr[j]]);
187	end;	192	end;
188	tmp := FormatMAC(tmp);	193	tmp := FormatMAC(tmp);
189	if (tmp <> '') and (outSL.IndexOf(tmp) = -1) then	194	if (tmp <> '') and (outSL.IndexOf(tmp) = -1) then
190	outSL.Add(tmp);	195	outSL.Add(tmp);
191	end;	196	end;
192	end;	197	end;
193	finally	198	finally
194	if Assigned(pIfTable) then FreeMem(pIfTable, TableSize);	199	if Assigned(pIfTable) then FreeMem(pIfTable, TableSize);
195	end;	200	end;
196	end;	201	end;
197		202
198	function FormatMAC(s: string): string;	203	function FormatMAC(s: string): string;
199	var	204	var
200	m: integer;	205	m: integer;
201	begin	206	begin
202	result := '';	207	result := '';
203	m := 1;	208	m := 1;
204	s := UpperCase(s);	209	s := UpperCase(s);
205	repeat	210	repeat
206	if m > 1 then result := result + '-';	211	if m > 1 then result := result + '-';
207	result := result + Copy(s, m, 2);	212	result := result + Copy(s, m, 2);
208	inc(m, 2);	213	inc(m, 2);
209	until m > Length(s);	214	until m > Length(s);
210	end;	215	end;
211		216
212	(*	217	(*
213	type	218	type
214	WKSTA_INFO_100 = Record	219	WKSTA_INFO_100 = Record
215	wki100_platform_id : DWORD;	220	wki100_platform_id : DWORD;
216	wki100_computername : LPWSTR;	221	wki100_computername : LPWSTR;
217	wki100_langroup : LPWSTR;	222	wki100_langroup : LPWSTR;
218	wki100_ver_major : DWORD;	223	wki100_ver_major : DWORD;
219	wki100_ver_minor : DWORD;	224	wki100_ver_minor : DWORD;
220	End;	225	End;
221		226
222	LPWKSTA_INFO_100 = ^WKSTA_INFO_100;	227	LPWKSTA_INFO_100 = ^WKSTA_INFO_100;
223		228
224	function GetNetParam(AParam: integer): string;	229	function GetNetParam(AParam: integer): string;
225	Var	230	Var
226	PBuf : LPWKSTA_INFO_100;	231	PBuf : LPWKSTA_INFO_100;
227	Res : LongInt;	232	Res : LongInt;
228	begin	233	begin
229	result := '';	234	result := '';
230	Res := NetWkstaGetInfo(nil, 100, @PBuf);	235	Res := NetWkstaGetInfo(nil, 100, @PBuf);
231	If Res = NERR_Success Then	236	If Res = NERR_Success Then
232	begin	237	begin
233	case AParam of	238	case AParam of
234	0: Result := string(PBuf^.wki100_computername);	239	0: Result := string(PBuf^.wki100_computername);
235	1: Result := string(PBuf^.wki100_langroup);	240	1: Result := string(PBuf^.wki100_langroup);
236	end;	241	end;
237	end;	242	end;
238	end;	243	end;
239		244
240	function GetTheComputerName: string;	245	function GetTheComputerName: string;
241	begin	246	begin
242	Result := GetNetParam(0);	247	Result := GetNetParam(0);
243	end;	248	end;
244		249
245	function GetTheDomainName: string;	250	function GetTheDomainName: string;
246	begin	251	begin
247	Result := GetNetParam(1);	252	Result := GetNetParam(1);
248	end;	253	end;
249		254
250	*)	255	*)
251		256
252	function GetDomainName(var outDomainName: WideString): boolean;	257	function GetDomainName(var outDomainName: WideString): boolean;
253	var	258	var
254	reg: TRegistry;	259	reg: TRegistry;
255	begin	260	begin
256	outDomainName := '';	261	outDomainName := '';
257	reg := TRegistry.Create;	262	reg := TRegistry.Create;
258	try	263	try
259	reg.RootKey := HKEY_LOCAL_MACHINE;	264	reg.RootKey := HKEY_LOCAL_MACHINE;
260	result := reg.OpenKeyReadOnly('\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters');	265	result := reg.OpenKeyReadOnly('\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters');
261	if result then	266	if result then
262	begin	267	begin
263	outDomainName := reg.ReadString('Domain');	268	outDomainName := reg.ReadString('Domain');
264	reg.CloseKey;	269	reg.CloseKey;
265	end;	270	end;
266	finally	271	finally
267	reg.Free;	272	reg.Free;
268	end;	273	end;
269	end;	274	end;
270		275
271	end.	276	end.
272		277

Subversion Repositories userdetect2

userdetect2/trunk/UserDetect2/Plugins/NetworkUtils.pas – Rev 92 → 93