Subversion Repositories userdetect2

Rev

Rev 68 | Rev 71 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
68 daniel-mar 1
unit NetworkUtils;
2
 
3
interface
4
 
5
uses
6
  Windows, SysUtils, Classes;
7
 
8
function GetLocalIPAddressList(outsl: TStrings): DWORD;
9
function GetLocalMACAddressList(outSL: TStrings): DWORD;
10
function GetDHCPIPAddressList(outsl: TStrings): DWORD;
11
function GetGatewayIPAddressList(outsl: TStrings): DWORD;
12
function GetMACAddress(const IPAddress: string; var outAddress: string): DWORD;
13
function FormatMAC(s: string): string;
14
 
15
implementation
16
 
17
uses
18
  iphlp, WinSock;
19
 
20
// TODO: Replace GetAdaptersInfo()? A comment at MSDN states that there might be problems with IPv6
21
//           "GetAdaptersInfo returns ERROR_NO_DATA if there are only IPv6 interfaces
22
//            configured on system. In that case GetAdapterAddresses has to be used!"
23
 
24
function GetLocalIPAddressList(outsl: TStrings): DWORD;
25
var
26
  pAdapterInfo: PIP_ADAPTER_INFO;
27
  addr: string;
28
  addrStr: IP_ADDR_STRING;
29
  BufLen: Cardinal;
30
begin
31
  BufLen := SizeOf(IP_ADAPTER_INFO);
70 daniel-mar 32
  Result := GetAdaptersInfo(nil, @BufLen);
33
  if Result <> ERROR_SUCCESS then Exit;
68 daniel-mar 34
  pAdapterInfo := AllocMem(BufLen);
35
  try
36
    Result := GetAdaptersInfo(pAdapterInfo, @BufLen);
70 daniel-mar 37
    if Result <> ERROR_SUCCESS then Exit;
68 daniel-mar 38
    while pAdapterInfo <> nil do
39
    begin
40
      addrStr := pAdapterInfo^.IpAddressList;
41
      repeat
42
        addr := addrStr.IpAddress.S;
43
        if (addr <> '') and (outsl.IndexOf(addr) = -1) then
44
          outsl.Add(addr);
45
        if addrStr.Next = nil then break;
46
        AddrStr := addrStr.Next^;
47
      until false;
48
      pAdapterInfo := pAdapterInfo^.next;
49
    end;
50
  finally
51
    Freemem(pAdapterInfo);
52
  end;
53
end;
54
 
55
function GetDHCPIPAddressList(outsl: TStrings): DWORD;
56
var
57
  pAdapterInfo: PIP_ADAPTER_INFO;
58
  addr: string;
59
  addrStr: IP_ADDR_STRING;
60
  BufLen: Cardinal;
61
begin
62
  BufLen := SizeOf(IP_ADAPTER_INFO);
70 daniel-mar 63
  Result := GetAdaptersInfo(nil, @BufLen);
64
  if Result <> ERROR_SUCCESS then Exit;
68 daniel-mar 65
  pAdapterInfo := AllocMem(BufLen);
66
  try
67
    Result := GetAdaptersInfo(pAdapterInfo, @BufLen);
70 daniel-mar 68
    if Result <> ERROR_SUCCESS then Exit;
68 daniel-mar 69
    while pAdapterInfo <> nil do
70
    begin
71
      addrStr := pAdapterInfo^.DhcpServer;
72
      repeat
73
        addr := addrStr.IpAddress.S;
74
        if (addr <> '') and (outsl.IndexOf(addr) = -1) then
75
          outsl.Add(addr);
76
        if addrStr.Next = nil then break;
77
        AddrStr := addrStr.Next^;
78
      until false;
79
      pAdapterInfo := pAdapterInfo^.next;
80
    end;
81
  finally
82
    Freemem(pAdapterInfo);
83
  end;
84
end;
85
 
86
function GetGatewayIPAddressList(outsl: TStrings): DWORD;
87
var
88
  pAdapterInfo: PIP_ADAPTER_INFO;
89
  addr: string;
90
  addrStr: IP_ADDR_STRING;
91
  BufLen: Cardinal;
92
begin
93
  BufLen := SizeOf(IP_ADAPTER_INFO);
70 daniel-mar 94
  Result := GetAdaptersInfo(nil, @BufLen);
95
  if Result <> ERROR_SUCCESS then Exit;
68 daniel-mar 96
  pAdapterInfo := AllocMem(BufLen);
97
  try
98
    Result := GetAdaptersInfo(pAdapterInfo, @BufLen);
70 daniel-mar 99
    if Result <> ERROR_SUCCESS then Exit;
68 daniel-mar 100
    while pAdapterInfo <> nil do
101
    begin
102
      addrStr := pAdapterInfo^.GatewayList;
103
      repeat
104
        addr := addrStr.IpAddress.S;
105
        if (addr <> '') and (outsl.IndexOf(addr) = -1) then
106
          outsl.Add(addr);
107
        if addrStr.Next = nil then break;
108
        AddrStr := addrStr.Next^;
109
      until false;
110
      pAdapterInfo := pAdapterInfo^.next;
111
    end;
112
  finally
113
    Freemem(pAdapterInfo);
114
  end;
115
end;
116
 
117
function GetMACAddress(const IPAddress: string; var outAddress: string): DWORD;
118
// http://stackoverflow.com/questions/4550672/delphi-get-mac-of-router
119
var
120
  MacAddr    : Array[0..5] of Byte;
121
  DestIP     : ULONG;
122
  PhyAddrLen : ULONG;
123
  WSAData    : TWSAData;
124
  j: integer;
125
begin
126
  outAddress := '';
127
  WSAStartup($0101, WSAData);
128
  try
129
    ZeroMemory(@MacAddr, SizeOf(MacAddr));
130
    DestIP     := inet_addr(PAnsiChar(IPAddress));
131
    PhyAddrLen := SizeOf(MacAddr); // TODO: more ?
132
    Result     := SendArp(DestIP, 0, @MacAddr, @PhyAddrLen);
133
    if Result = S_OK then
134
    begin
135
      outAddress := '';
136
      for j := 0 to PhyAddrLen-1 do
137
      begin
138
        outAddress := outAddress + format('%.2x', [MacAddr[j]]);
139
      end;
140
      outAddress := FormatMAC(outAddress);
141
    end;
142
  finally
143
    WSACleanup;
144
  end;
145
end;
146
 
147
function GetLocalMACAddressList(outSL: TStrings): DWORD;
148
const
149
  _MAX_ROWS_ = 100;
150
type
151
  _IfTable = Record
152
    nRows: LongInt;
153
    ifRow: Array[1.._MAX_ROWS_] of MIB_IFROW;
154
  end;
155
var
156
  pIfTable: ^_IfTable;
157
  TableSize: LongInt;
158
  tmp: String;
159
  i, j: Integer;
160
begin
161
  pIfTable := nil;
162
  try
163
    // First: just get the buffer size.
164
    // TableSize returns the size needed.
165
    TableSize := 0; // Set to zero so the GetIfTabel function
166
    // won't try to fill the buffer yet,
167
    // but only return the actual size it needs.
168
    GetIfTable(pIfTable, TableSize, 1);
169
    if (TableSize < SizeOf(MIB_IFROW)+SizeOf(LongInt)) then
170
    begin
171
      Result := ERROR_NO_DATA;
172
      Exit; // less than 1 table entry?!
173
    end;
174
 
175
    // Second:
176
    // allocate memory for the buffer and retrieve the
177
    // entire table.
178
    GetMem(pIfTable, TableSize);
179
    Result := GetIfTable(pIfTable, TableSize, 1);
180
    if Result <> NO_ERROR then Exit;
181
 
182
    // Read the ETHERNET addresses.
183
    for i := 1 to pIfTable^.nRows do
184
    begin
185
      //if pIfTable^.ifRow[i].dwType=MIB_IF_TYPE_ETHERNET then
186
      begin
187
        tmp := '';
188
        for j := 0 to pIfTable^.ifRow[i].dwPhysAddrLen-1 do
189
        begin
190
          tmp := tmp + format('%.2x', [pIfTable^.ifRow[i].bPhysAddr[j]]);
191
        end;
192
        tmp := FormatMAC(tmp);
193
        if (tmp <> '') and (outSL.IndexOf(tmp) = -1) then
194
          outSL.Add(tmp);
195
      end;
196
    end;
197
  finally
198
    if Assigned(pIfTable) then FreeMem(pIfTable, TableSize);
199
  end;
200
end;
201
 
202
function FormatMAC(s: string): string;
203
var
204
  m: integer;
205
begin
206
  result := '';
207
  m := 1;
208
  s := UpperCase(s);
209
  repeat
210
    if m > 1 then result := result + '-';
211
    result := result + Copy(s, m, 2);
212
    inc(m, 2);
213
  until m > Length(s);
214
end;
215
 
216
end.