source: trunk/Packages/synapse/source/lib/synamisc.pas

Last change on this file was 2, checked in by chronos, 13 years ago
  • Přidáno: Základní kostra projektu.
  • Přidáno: Knihovna synapse.
File size: 12.8 KB
Line 
1{==============================================================================|
2| Project : Ararat Synapse | 001.003.001 |
3|==============================================================================|
4| Content: misc. procedures and functions |
5|==============================================================================|
6| Copyright (c)1999-2010, Lukas Gebauer |
7| All rights reserved. |
8| |
9| Redistribution and use in source and binary forms, with or without |
10| modification, are permitted provided that the following conditions are met: |
11| |
12| Redistributions of source code must retain the above copyright notice, this |
13| list of conditions and the following disclaimer. |
14| |
15| Redistributions in binary form must reproduce the above copyright notice, |
16| this list of conditions and the following disclaimer in the documentation |
17| and/or other materials provided with the distribution. |
18| |
19| Neither the name of Lukas Gebauer nor the names of its contributors may |
20| be used to endorse or promote products derived from this software without |
21| specific prior written permission. |
22| |
23| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
24| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
25| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
26| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
27| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
28| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
29| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
30| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
31| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
32| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
33| DAMAGE. |
34|==============================================================================|
35| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
36| Portions created by Lukas Gebauer are Copyright (c) 2002-2010. |
37| All Rights Reserved. |
38|==============================================================================|
39| Contributor(s): |
40|==============================================================================|
41| History: see HISTORY.HTM from distribution package |
42| (Found at URL: http://www.ararat.cz/synapse/) |
43|==============================================================================}
44
45{:@abstract(Misc. network based utilities)}
46
47{$IFDEF FPC}
48 {$MODE DELPHI}
49{$ENDIF}
50{$Q-}
51{$H+}
52
53//Kylix does not known UNIX define
54{$IFDEF LINUX}
55 {$IFNDEF UNIX}
56 {$DEFINE UNIX}
57 {$ENDIF}
58{$ENDIF}
59
60{$TYPEDADDRESS OFF}
61
62{$IFDEF UNICODE}
63 {$WARN IMPLICIT_STRING_CAST OFF}
64 {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
65{$ENDIF}
66
67unit synamisc;
68
69interface
70
71{$IFDEF VER125}
72 {$DEFINE BCB}
73{$ENDIF}
74{$IFDEF BCB}
75 {$ObjExportAll On}
76 {$HPPEMIT '#pragma comment( lib , "wininet.lib" )'}
77{$ENDIF}
78
79uses
80 synautil, blcksock, SysUtils, Classes
81{$IFDEF UNIX}
82 {$IFNDEF FPC}
83 , Libc
84 {$ENDIF}
85{$ELSE}
86 , Windows
87{$ENDIF}
88;
89
90Type
91 {:@abstract(This record contains information about proxy setting.)}
92 TProxySetting = record
93 Host: string;
94 Port: string;
95 Bypass: string;
96 end;
97
98{:By this function you can turn-on computer on network, if this computer
99 supporting Wake-on-lan feature. You need MAC number (network card indentifier)
100 of computer for turn-on. You can also assign target IP addres. If you not
101 specify it, then is used broadcast for delivery magic wake-on packet. However
102 broadcasts workinh only on your local network. When you need to wake-up
103 computer on another network, you must specify any existing IP addres on same
104 network segment as targeting computer.}
105procedure WakeOnLan(MAC, IP: string);
106
107{:Autodetect current DNS servers used by system. If is defined more then one DNS
108 server, then result is comma-delimited.}
109function GetDNS: string;
110
111{:Autodetect InternetExplorer proxy setting for given protocol. This function
112working only on windows!}
113function GetIEProxy(protocol: string): TProxySetting;
114
115{:Return all known IP addresses on local system. Addresses are divided by comma.}
116function GetLocalIPs: string;
117
118implementation
119
120{==============================================================================}
121procedure WakeOnLan(MAC, IP: string);
122var
123 sock: TUDPBlockSocket;
124 HexMac: Ansistring;
125 data: Ansistring;
126 n: integer;
127 b: Byte;
128begin
129 if MAC <> '' then
130 begin
131 MAC := ReplaceString(MAC, '-', '');
132 MAC := ReplaceString(MAC, ':', '');
133 if Length(MAC) < 12 then
134 Exit;
135 HexMac := '';
136 for n := 0 to 5 do
137 begin
138 b := StrToIntDef('$' + MAC[n * 2 + 1] + MAC[n * 2 + 2], 0);
139 HexMac := HexMac + char(b);
140 end;
141 if IP = '' then
142 IP := cBroadcast;
143 sock := TUDPBlockSocket.Create;
144 try
145 sock.CreateSocket;
146 sock.EnableBroadcast(true);
147 sock.Connect(IP, '9');
148 data := #$FF + #$FF + #$FF + #$FF + #$FF + #$FF;
149 for n := 1 to 16 do
150 data := data + HexMac;
151 sock.SendString(data);
152 finally
153 sock.Free;
154 end;
155 end;
156end;
157
158{==============================================================================}
159
160{$IFNDEF UNIX}
161function GetDNSbyIpHlp: string;
162type
163 PTIP_ADDRESS_STRING = ^TIP_ADDRESS_STRING;
164 TIP_ADDRESS_STRING = array[0..15] of Ansichar;
165 PTIP_ADDR_STRING = ^TIP_ADDR_STRING;
166 TIP_ADDR_STRING = packed record
167 Next: PTIP_ADDR_STRING;
168 IpAddress: TIP_ADDRESS_STRING;
169 IpMask: TIP_ADDRESS_STRING;
170 Context: DWORD;
171 end;
172 PTFixedInfo = ^TFixedInfo;
173 TFixedInfo = packed record
174 HostName: array[1..128 + 4] of Ansichar;
175 DomainName: array[1..128 + 4] of Ansichar;
176 CurrentDNSServer: PTIP_ADDR_STRING;
177 DNSServerList: TIP_ADDR_STRING;
178 NodeType: UINT;
179 ScopeID: array[1..256 + 4] of Ansichar;
180 EnableRouting: UINT;
181 EnableProxy: UINT;
182 EnableDNS: UINT;
183 end;
184const
185 IpHlpDLL = 'IPHLPAPI.DLL';
186var
187 IpHlpModule: THandle;
188 FixedInfo: PTFixedInfo;
189 InfoSize: Longint;
190 PDnsServer: PTIP_ADDR_STRING;
191 err: integer;
192 GetNetworkParams: function(FixedInfo: PTFixedInfo; pOutPutLen: PULONG): DWORD; stdcall;
193begin
194 InfoSize := 0;
195 Result := '...';
196 IpHlpModule := LoadLibrary(IpHlpDLL);
197 if IpHlpModule = 0 then
198 exit;
199 try
200 GetNetworkParams := GetProcAddress(IpHlpModule,PAnsiChar(AnsiString('GetNetworkParams')));
201 if @GetNetworkParams = nil then
202 Exit;
203 err := GetNetworkParams(Nil, @InfoSize);
204 if err <> ERROR_BUFFER_OVERFLOW then
205 Exit;
206 Result := '';
207 GetMem (FixedInfo, InfoSize);
208 try
209 err := GetNetworkParams(FixedInfo, @InfoSize);
210 if err <> ERROR_SUCCESS then
211 exit;
212 with FixedInfo^ do
213 begin
214 Result := DnsServerList.IpAddress;
215 PDnsServer := DnsServerList.Next;
216 while PDnsServer <> Nil do
217 begin
218 if Result <> '' then
219 Result := Result + ',';
220 Result := Result + PDnsServer^.IPAddress;
221 PDnsServer := PDnsServer.Next;
222 end;
223 end;
224 finally
225 FreeMem(FixedInfo);
226 end;
227 finally
228 FreeLibrary(IpHlpModule);
229 end;
230end;
231
232function ReadReg(SubKey, Vn: PChar): string;
233var
234 OpenKey: HKEY;
235 DataType, DataSize: integer;
236 Temp: array [0..2048] of char;
237begin
238 Result := '';
239 if RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey, REG_OPTION_NON_VOLATILE,
240 KEY_READ, OpenKey) = ERROR_SUCCESS then
241 begin
242 DataType := REG_SZ;
243 DataSize := SizeOf(Temp);
244 if RegQueryValueEx(OpenKey, Vn, nil, @DataType, @Temp, @DataSize) = ERROR_SUCCESS then
245 SetString(Result, Temp, DataSize div SizeOf(Char) - 1);
246 RegCloseKey(OpenKey);
247 end;
248end ;
249{$ENDIF}
250
251function GetDNS: string;
252{$IFDEF UNIX}
253var
254 l: TStringList;
255 n: integer;
256begin
257 Result := '';
258 l := TStringList.Create;
259 try
260 l.LoadFromFile('/etc/resolv.conf');
261 for n := 0 to l.Count - 1 do
262 if Pos('NAMESERVER', uppercase(l[n])) = 1 then
263 begin
264 if Result <> '' then
265 Result := Result + ',';
266 Result := Result + SeparateRight(l[n], ' ');
267 end;
268 finally
269 l.Free;
270 end;
271end;
272{$ELSE}
273const
274 NTdyn = 'System\CurrentControlSet\Services\Tcpip\Parameters\Temporary';
275 NTfix = 'System\CurrentControlSet\Services\Tcpip\Parameters';
276 W9xfix = 'System\CurrentControlSet\Services\MSTCP';
277begin
278 Result := GetDNSbyIpHlp;
279 if Result = '...' then
280 begin
281 if Win32Platform = VER_PLATFORM_WIN32_NT then
282 begin
283 Result := ReadReg(NTdyn, 'NameServer');
284 if result = '' then
285 Result := ReadReg(NTfix, 'NameServer');
286 if result = '' then
287 Result := ReadReg(NTfix, 'DhcpNameServer');
288 end
289 else
290 Result := ReadReg(W9xfix, 'NameServer');
291 Result := ReplaceString(trim(Result), ' ', ',');
292 end;
293end;
294{$ENDIF}
295
296{==============================================================================}
297
298function GetIEProxy(protocol: string): TProxySetting;
299{$IFDEF UNIX}
300begin
301 Result.Host := '';
302 Result.Port := '';
303 Result.Bypass := '';
304end;
305{$ELSE}
306type
307 PInternetProxyInfo = ^TInternetProxyInfo;
308 TInternetProxyInfo = packed record
309 dwAccessType: DWORD;
310 lpszProxy: LPCSTR;
311 lpszProxyBypass: LPCSTR;
312 end;
313const
314 INTERNET_OPTION_PROXY = 38;
315 INTERNET_OPEN_TYPE_PROXY = 3;
316 WininetDLL = 'WININET.DLL';
317var
318 WininetModule: THandle;
319 ProxyInfo: PInternetProxyInfo;
320 Err: Boolean;
321 Len: DWORD;
322 Proxy: string;
323 DefProxy: string;
324 ProxyList: TStringList;
325 n: integer;
326 InternetQueryOption: function (hInet: Pointer; dwOption: DWORD;
327 lpBuffer: Pointer; var lpdwBufferLength: DWORD): BOOL; stdcall;
328begin
329 Result.Host := '';
330 Result.Port := '';
331 Result.Bypass := '';
332 WininetModule := LoadLibrary(WininetDLL);
333 if WininetModule = 0 then
334 exit;
335 try
336 InternetQueryOption := GetProcAddress(WininetModule,PAnsiChar(AnsiString('InternetQueryOptionA')));
337 if @InternetQueryOption = nil then
338 Exit;
339
340 if protocol = '' then
341 protocol := 'http';
342 Len := 4096;
343 GetMem(ProxyInfo, Len);
344 ProxyList := TStringList.Create;
345 try
346 Err := InternetQueryOption(nil, INTERNET_OPTION_PROXY, ProxyInfo, Len);
347 if Err then
348 if ProxyInfo^.dwAccessType = INTERNET_OPEN_TYPE_PROXY then
349 begin
350 ProxyList.CommaText := ReplaceString(ProxyInfo^.lpszProxy, ' ', ',');
351 Proxy := '';
352 DefProxy := '';
353 for n := 0 to ProxyList.Count -1 do
354 begin
355 if Pos(lowercase(protocol) + '=', lowercase(ProxyList[n])) = 1 then
356 begin
357 Proxy := SeparateRight(ProxyList[n], '=');
358 break;
359 end;
360 if Pos('=', ProxyList[n]) < 1 then
361 DefProxy := ProxyList[n];
362 end;
363 if Proxy = '' then
364 Proxy := DefProxy;
365 if Proxy <> '' then
366 begin
367 Result.Host := Trim(SeparateLeft(Proxy, ':'));
368 Result.Port := Trim(SeparateRight(Proxy, ':'));
369 end;
370 Result.Bypass := ReplaceString(ProxyInfo^.lpszProxyBypass, ' ', ',');
371 end;
372 finally
373 ProxyList.Free;
374 FreeMem(ProxyInfo);
375 end;
376 finally
377 FreeLibrary(WininetModule);
378 end;
379end;
380{$ENDIF}
381
382{==============================================================================}
383
384function GetLocalIPs: string;
385var
386 TcpSock: TTCPBlockSocket;
387 ipList: TStringList;
388begin
389 Result := '';
390 ipList := TStringList.Create;
391 try
392 TcpSock := TTCPBlockSocket.create;
393 try
394 TcpSock.ResolveNameToIP(TcpSock.LocalName, ipList);
395 Result := ipList.CommaText;
396 finally
397 TcpSock.Free;
398 end;
399 finally
400 ipList.Free;
401 end;
402end;
403
404{==============================================================================}
405
406end.
Note: See TracBrowser for help on using the repository browser.