source: trunk/Packages/synapse/synamisc.pas

Last change on this file was 5, checked in by chronos, 13 years ago
  • Added: Required packages.
File size: 12.5 KB
Line 
1{==============================================================================|
2| Project : Ararat Synapse | 001.003.000 |
3|==============================================================================|
4| Content: misc. procedures and functions |
5|==============================================================================|
6| Copyright (c)1999-2008, 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-2008. |
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
53unit synamisc;
54
55interface
56
57{$IFDEF VER125}
58 {$DEFINE BCB}
59{$ENDIF}
60{$IFDEF BCB}
61 {$ObjExportAll On}
62 {$HPPEMIT '#pragma comment( lib , "wininet.lib" )'}
63{$ENDIF}
64
65uses
66 synautil, blcksock, SysUtils, Classes,
67{$IFDEF LINUX}
68 Libc;
69{$ELSE}
70 Windows;
71{$ENDIF}
72
73Type
74 {:@abstract(This record contains information about proxy setting.)}
75 TProxySetting = record
76 Host: string;
77 Port: string;
78 Bypass: string;
79 end;
80
81{:By this function you can turn-on computer on network, if this computer
82 supporting Wake-on-lan feature. You need MAC number (network card indentifier)
83 of computer for turn-on. You can also assign target IP addres. If you not
84 specify it, then is used broadcast for delivery magic wake-on packet. However
85 broadcasts workinh only on your local network. When you need to wake-up
86 computer on another network, you must specify any existing IP addres on same
87 network segment as targeting computer.}
88procedure WakeOnLan(MAC, IP: string);
89
90{:Autodetect current DNS servers used by system. If is defined more then one DNS
91 server, then result is comma-delimited.}
92function GetDNS: string;
93
94{:Autodetect InternetExplorer proxy setting for given protocol. This function
95working only on windows!}
96function GetIEProxy(protocol: string): TProxySetting;
97
98{:Return all known IP addresses on local system. Addresses are divided by comma.}
99function GetLocalIPs: string;
100
101implementation
102
103{==============================================================================}
104procedure WakeOnLan(MAC, IP: string);
105var
106 sock: TUDPBlockSocket;
107 HexMac: Ansistring;
108 data: Ansistring;
109 n: integer;
110 b: Byte;
111begin
112 if MAC <> '' then
113 begin
114 MAC := ReplaceString(MAC, '-', '');
115 MAC := ReplaceString(MAC, ':', '');
116 if Length(MAC) < 12 then
117 Exit;
118 HexMac := '';
119 for n := 0 to 5 do
120 begin
121 b := StrToIntDef('$' + MAC[n * 2 + 1] + MAC[n * 2 + 2], 0);
122 HexMac := HexMac + char(b);
123 end;
124 if IP = '' then
125 IP := cBroadcast;
126 sock := TUDPBlockSocket.Create;
127 try
128 sock.CreateSocket;
129 sock.EnableBroadcast(true);
130 sock.Connect(IP, '9');
131 data := #$FF + #$FF + #$FF + #$FF + #$FF + #$FF;
132 for n := 1 to 16 do
133 data := data + HexMac;
134 sock.SendString(data);
135 finally
136 sock.Free;
137 end;
138 end;
139end;
140
141{==============================================================================}
142
143{$IFNDEF LINUX}
144function GetDNSbyIpHlp: string;
145type
146 PTIP_ADDRESS_STRING = ^TIP_ADDRESS_STRING;
147 TIP_ADDRESS_STRING = array[0..15] of Ansichar;
148 PTIP_ADDR_STRING = ^TIP_ADDR_STRING;
149 TIP_ADDR_STRING = packed record
150 Next: PTIP_ADDR_STRING;
151 IpAddress: TIP_ADDRESS_STRING;
152 IpMask: TIP_ADDRESS_STRING;
153 Context: DWORD;
154 end;
155 PTFixedInfo = ^TFixedInfo;
156 TFixedInfo = packed record
157 HostName: array[1..128 + 4] of Ansichar;
158 DomainName: array[1..128 + 4] of Ansichar;
159 CurrentDNSServer: PTIP_ADDR_STRING;
160 DNSServerList: TIP_ADDR_STRING;
161 NodeType: UINT;
162 ScopeID: array[1..256 + 4] of Ansichar;
163 EnableRouting: UINT;
164 EnableProxy: UINT;
165 EnableDNS: UINT;
166 end;
167const
168 IpHlpDLL = 'IPHLPAPI.DLL';
169var
170 IpHlpModule: THandle;
171 FixedInfo: PTFixedInfo;
172 InfoSize: Longint;
173 PDnsServer: PTIP_ADDR_STRING;
174 err: integer;
175 GetNetworkParams: function(FixedInfo: PTFixedInfo; pOutPutLen: PULONG): DWORD; stdcall;
176begin
177 InfoSize := 0;
178 Result := '...';
179 IpHlpModule := LoadLibrary(IpHlpDLL);
180 if IpHlpModule = 0 then
181 exit;
182 try
183 GetNetworkParams := GetProcAddress(IpHlpModule,PAnsiChar(AnsiString('GetNetworkParams')));
184 if @GetNetworkParams = nil then
185 Exit;
186 err := GetNetworkParams(Nil, @InfoSize);
187 if err <> ERROR_BUFFER_OVERFLOW then
188 Exit;
189 Result := '';
190 GetMem (FixedInfo, InfoSize);
191 try
192 err := GetNetworkParams(FixedInfo, @InfoSize);
193 if err <> ERROR_SUCCESS then
194 exit;
195 with FixedInfo^ do
196 begin
197 Result := DnsServerList.IpAddress;
198 PDnsServer := DnsServerList.Next;
199 while PDnsServer <> Nil do
200 begin
201 if Result <> '' then
202 Result := Result + ',';
203 Result := Result + PDnsServer^.IPAddress;
204 PDnsServer := PDnsServer.Next;
205 end;
206 end;
207 finally
208 FreeMem(FixedInfo);
209 end;
210 finally
211 FreeLibrary(IpHlpModule);
212 end;
213end;
214
215function ReadReg(SubKey, Vn: PChar): string;
216var
217 OpenKey: HKEY;
218 DataType, DataSize: integer;
219 Temp: array [0..2048] of char;
220begin
221 Result := '';
222 if RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey, REG_OPTION_NON_VOLATILE,
223 KEY_READ, OpenKey) = ERROR_SUCCESS then
224 begin
225 DataType := REG_SZ;
226 DataSize := SizeOf(Temp);
227 if RegQueryValueEx(OpenKey, Vn, nil, @DataType, @Temp, @DataSize) = ERROR_SUCCESS then
228 SetString(Result, Temp, DataSize div SizeOf(Char) - 1);
229 RegCloseKey(OpenKey);
230 end;
231end ;
232{$ENDIF}
233
234function GetDNS: string;
235{$IFDEF LINUX}
236var
237 l: TStringList;
238 n: integer;
239begin
240 Result := '';
241 l := TStringList.Create;
242 try
243 l.LoadFromFile('/etc/resolv.conf');
244 for n := 0 to l.Count - 1 do
245 if Pos('NAMESERVER', uppercase(l[n])) = 1 then
246 begin
247 if Result <> '' then
248 Result := Result + ',';
249 Result := Result + SeparateRight(l[n], ' ');
250 end;
251 finally
252 l.Free;
253 end;
254end;
255{$ELSE}
256const
257 NTdyn = 'System\CurrentControlSet\Services\Tcpip\Parameters\Temporary';
258 NTfix = 'System\CurrentControlSet\Services\Tcpip\Parameters';
259 W9xfix = 'System\CurrentControlSet\Services\MSTCP';
260begin
261 Result := GetDNSbyIpHlp;
262 if Result = '...' then
263 begin
264 if Win32Platform = VER_PLATFORM_WIN32_NT then
265 begin
266 Result := ReadReg(NTdyn, 'NameServer');
267 if result = '' then
268 Result := ReadReg(NTfix, 'NameServer');
269 if result = '' then
270 Result := ReadReg(NTfix, 'DhcpNameServer');
271 end
272 else
273 Result := ReadReg(W9xfix, 'NameServer');
274 Result := ReplaceString(trim(Result), ' ', ',');
275 end;
276end;
277{$ENDIF}
278
279{==============================================================================}
280
281function GetIEProxy(protocol: string): TProxySetting;
282{$IFDEF LINUX}
283begin
284 Result.Host := '';
285 Result.Port := '';
286 Result.Bypass := '';
287end;
288{$ELSE}
289type
290 PInternetProxyInfo = ^TInternetProxyInfo;
291 TInternetProxyInfo = packed record
292 dwAccessType: DWORD;
293 lpszProxy: LPCSTR;
294 lpszProxyBypass: LPCSTR;
295 end;
296const
297 INTERNET_OPTION_PROXY = 38;
298 INTERNET_OPEN_TYPE_PROXY = 3;
299 WininetDLL = 'WININET.DLL';
300var
301 WininetModule: THandle;
302 ProxyInfo: PInternetProxyInfo;
303 Err: Boolean;
304 Len: DWORD;
305 Proxy: string;
306 DefProxy: string;
307 ProxyList: TStringList;
308 n: integer;
309 InternetQueryOption: function (hInet: Pointer; dwOption: DWORD;
310 lpBuffer: Pointer; var lpdwBufferLength: DWORD): BOOL; stdcall;
311begin
312 Result.Host := '';
313 Result.Port := '';
314 Result.Bypass := '';
315 WininetModule := LoadLibrary(WininetDLL);
316 if WininetModule = 0 then
317 exit;
318 try
319 InternetQueryOption := GetProcAddress(WininetModule,PAnsiChar(AnsiString('InternetQueryOptionA')));
320 if @InternetQueryOption = nil then
321 Exit;
322
323 if protocol = '' then
324 protocol := 'http';
325 Len := 4096;
326 GetMem(ProxyInfo, Len);
327 ProxyList := TStringList.Create;
328 try
329 Err := InternetQueryOption(nil, INTERNET_OPTION_PROXY, ProxyInfo, Len);
330 if Err then
331 if ProxyInfo^.dwAccessType = INTERNET_OPEN_TYPE_PROXY then
332 begin
333 ProxyList.CommaText := ReplaceString(ProxyInfo^.lpszProxy, ' ', ',');
334 Proxy := '';
335 DefProxy := '';
336 for n := 0 to ProxyList.Count -1 do
337 begin
338 if Pos(lowercase(protocol) + '=', lowercase(ProxyList[n])) = 1 then
339 begin
340 Proxy := SeparateRight(ProxyList[n], '=');
341 break;
342 end;
343 if Pos('=', ProxyList[n]) < 1 then
344 DefProxy := ProxyList[n];
345 end;
346 if Proxy = '' then
347 Proxy := DefProxy;
348 if Proxy <> '' then
349 begin
350 Result.Host := Trim(SeparateLeft(Proxy, ':'));
351 Result.Port := Trim(SeparateRight(Proxy, ':'));
352 end;
353 Result.Bypass := ReplaceString(ProxyInfo^.lpszProxyBypass, ' ', ',');
354 end;
355 finally
356 ProxyList.Free;
357 FreeMem(ProxyInfo);
358 end;
359 finally
360 FreeLibrary(WininetModule);
361 end;
362end;
363{$ENDIF}
364
365{==============================================================================}
366
367function GetLocalIPs: string;
368var
369 TcpSock: TTCPBlockSocket;
370 ipList: TStringList;
371begin
372 Result := '';
373 ipList := TStringList.Create;
374 try
375 TcpSock := TTCPBlockSocket.create;
376 try
377 TcpSock.ResolveNameToIP(TcpSock.LocalName, ipList);
378 Result := ipList.CommaText;
379 finally
380 TcpSock.Free;
381 end;
382 finally
383 ipList.Free;
384 end;
385end;
386
387{==============================================================================}
388
389end.
Note: See TracBrowser for help on using the repository browser.