1 | unit UMainForm;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
---|
7 | Dialogs, StdCtrls, ComCtrls, ShellApi, DosCommand, Registry, Menus,
|
---|
8 | CoolTrayIcon, ExtCtrls, XPMan, SHFolder,
|
---|
9 | ShlObj, Winsock, UTextFileStream;
|
---|
10 |
|
---|
11 | const
|
---|
12 | ApplicationName = 'Konfigurátor ZdìchovNET';
|
---|
13 | Author = 'Jiøí Hajda';
|
---|
14 | HomePage = 'http://www.zdechov.net/';
|
---|
15 | Email = 'robie@centrum.cz';
|
---|
16 | Version = '1.3';
|
---|
17 | ReleaseDate = '4.9.2006';
|
---|
18 | Creator = 'Chronosoft';
|
---|
19 | RegistryRootKey = HKEY_LOCAL_MACHINE;
|
---|
20 | RegistryPath = '\Software\'+Creator+'\Configurator ZdechovNET';
|
---|
21 | ChangeLogFile = 'Novinky.txt';
|
---|
22 | Licence = 'Copyleft';
|
---|
23 |
|
---|
24 | DefaultLogFileName = 'DialLog.txt';
|
---|
25 | DiallingServiceName = 'VpnDiallingService';
|
---|
26 | DiallingServiceDisplayName = 'VPN Dialling service';
|
---|
27 |
|
---|
28 | BrowserHomepage = 'http://centrala.zdechov.net/';
|
---|
29 | WorkGroup = 'ZDECHOV';
|
---|
30 | DefaultConnectionName = 'ZdìchovNET';
|
---|
31 | ConnectionHost = 'centrala.zdechov.net';
|
---|
32 | MainSharedFolderPath = 'C:\Net';
|
---|
33 | MainSharedFolderName = 'Net';
|
---|
34 | LocalNetAddr = '192.168.0.0';
|
---|
35 | LocalNetMask = '255.255.0.0';
|
---|
36 |
|
---|
37 | type
|
---|
38 | TMainForm = class(TForm)
|
---|
39 | Button1: TButton;
|
---|
40 | Button2: TButton;
|
---|
41 | Bevel1: TBevel;
|
---|
42 | CheckBox4: TCheckBox;
|
---|
43 | CoolTrayIcon1: TCoolTrayIcon;
|
---|
44 | Button3: TButton;
|
---|
45 | PopupMenu1: TPopupMenu;
|
---|
46 | Ukonit1: TMenuItem;
|
---|
47 | estst1: TMenuItem;
|
---|
48 | Nastaven1: TMenuItem;
|
---|
49 | CheckBox5: TCheckBox;
|
---|
50 | XPManifest1: TXPManifest;
|
---|
51 | CheckBox6: TCheckBox;
|
---|
52 | Oprogramu1: TMenuItem;
|
---|
53 | CheckBox9: TCheckBox;
|
---|
54 | Zznamvyten1: TMenuItem;
|
---|
55 | OpenDialog1: TOpenDialog;
|
---|
56 | VPNpipojen1: TMenuItem;
|
---|
57 | Spustit1: TMenuItem;
|
---|
58 | Zasavit1: TMenuItem;
|
---|
59 | procedure FormShow(Sender: TObject);
|
---|
60 | procedure Button2Click(Sender: TObject);
|
---|
61 | procedure Button1Click(Sender: TObject);
|
---|
62 | procedure estst1Click(Sender: TObject);
|
---|
63 | procedure Ukonit1Click(Sender: TObject);
|
---|
64 | procedure FormCreate(Sender: TObject);
|
---|
65 | procedure Nastaven1Click(Sender: TObject);
|
---|
66 | procedure FormDestroy(Sender: TObject);
|
---|
67 | procedure Button3Click(Sender: TObject);
|
---|
68 | procedure Oprogramu1Click(Sender: TObject);
|
---|
69 | private
|
---|
70 | procedure LoadOptions;
|
---|
71 | procedure SaveOptions;
|
---|
72 | function GetCentralaHomepage: Boolean;
|
---|
73 | procedure SetCentralaHomepage(const Value: Boolean);
|
---|
74 | function GetWorkgroupZdechov: Boolean;
|
---|
75 | procedure SetWorkgroupZdechov(const Value: Boolean);
|
---|
76 | function GetRunOnSystemStart: Boolean;
|
---|
77 | procedure SetRunOnSystemStart(const Value: Boolean);
|
---|
78 | function GetShareUnblockFirewall: Boolean;
|
---|
79 | procedure SetShareUnblockFirewall(const Value: Boolean);
|
---|
80 | function GetNetSharedFolder: Boolean;
|
---|
81 | procedure SetNetSharedFolder(const Value: Boolean);
|
---|
82 | function GetNetworkDomain: string;
|
---|
83 | public
|
---|
84 | FirstStart: Boolean;
|
---|
85 | HostFilterIndex: Integer;
|
---|
86 | PingTimeout: Integer;
|
---|
87 | NetworkTestLastUpdate: TDateTime;
|
---|
88 | property CentralaHomepage: Boolean read GetCentralaHomepage
|
---|
89 | write SetCentralaHomepage;
|
---|
90 | property WorkgroupZdechov: Boolean read GetWorkgroupZdechov
|
---|
91 | write SetWorkgroupZdechov;
|
---|
92 | property RunOnSystemStart: Boolean read GetRunOnSystemStart
|
---|
93 | write SetRunOnSystemStart;
|
---|
94 | property ShareUnblockFirewall: Boolean read GetShareUnblockFirewall
|
---|
95 | write SetShareUnblockFirewall;
|
---|
96 | property NetSharedFolder: Boolean read GetNetSharedFolder
|
---|
97 | write SetNetSharedFolder;
|
---|
98 | property NetworkDomain: string read GetNetworkDomain;
|
---|
99 |
|
---|
100 | procedure Init;
|
---|
101 | end;
|
---|
102 |
|
---|
103 | var
|
---|
104 | MainForm: TMainForm;
|
---|
105 |
|
---|
106 | function ApplicationDataFolder: string;
|
---|
107 | function GetIPFromHost(var HostName, IPaddr, WSAErr: string): Boolean;
|
---|
108 | function GetComputerNetName: string;
|
---|
109 | function CommonAppDataPath: string;
|
---|
110 | procedure ShellLaunch(const S: String);
|
---|
111 |
|
---|
112 | implementation
|
---|
113 |
|
---|
114 | uses UNetworkTest, UAboutWindow, ULogExceptions, DateUtils, Math,
|
---|
115 | StrUtils, UServiceControl;
|
---|
116 |
|
---|
117 | {$R *.dfm}
|
---|
118 |
|
---|
119 | const
|
---|
120 |
|
---|
121 | // Share types
|
---|
122 | STYPE_ALL = -1; //note: my const
|
---|
123 | STYPE_DISKTREE = 0;
|
---|
124 | STYPE_PRINTQ = 1;
|
---|
125 | STYPE_DEVICE = 2;
|
---|
126 | STYPE_IPC = 3;
|
---|
127 | STYPE_SPECIAL = $80000000;
|
---|
128 |
|
---|
129 | // Share permission
|
---|
130 | ACCESS_READ = 1;
|
---|
131 | ACCESS_WRITE = 2;
|
---|
132 | ACCESS_CREATE = 4;
|
---|
133 | ACCESS_EXEC = 8;
|
---|
134 | ACCESS_DELETE = 16;
|
---|
135 | ACCESS_ATRIB = 32;
|
---|
136 | ACCESS_PERM = 64;
|
---|
137 | ACCESS_ALL = ACCESS_READ or ACCESS_WRITE or ACCESS_CREATE or ACCESS_EXEC or
|
---|
138 | ACCESS_DELETE or ACCESS_ATRIB or ACCESS_PERM;
|
---|
139 |
|
---|
140 | type
|
---|
141 | TShareInfo2 = record
|
---|
142 | shi2_netname : PWideChar;
|
---|
143 | shi2_type : DWORD;
|
---|
144 | shi2_remark : PWideChar;
|
---|
145 | shi2_permissions : DWORD;
|
---|
146 | shi2_max_uses : DWORD;
|
---|
147 | shi2_current_uses : DWORD;
|
---|
148 | shi2_path : PWideChar;
|
---|
149 | shi2_passwd : PWideChar;
|
---|
150 | end;
|
---|
151 | PShareInfo2 = ^TShareInfo2;
|
---|
152 |
|
---|
153 | procedure NetApiBufferFree(Buf: Pointer) stdcall; external 'netapi32.dll';
|
---|
154 | function NetShareGetInfo(SeverName, NetName: PWideChar; Level: DWORD;
|
---|
155 | Buf: Pointer): LongInt; stdcall; external 'netapi32.dll';
|
---|
156 | function NetShareDel(ServerName, ShareName : PWideChar; Reserved: DWord):
|
---|
157 | LongInt; stdcall; external 'netapi32.dll';
|
---|
158 | function NetShareAdd(ServerName : PWideChar; Level : DWord;
|
---|
159 | Buffer : Pointer; var ParamError :DWord) : Longint; stdcall; external 'netapi32.dll';
|
---|
160 |
|
---|
161 |
|
---|
162 | function CommonAppDataPath: string;
|
---|
163 | const
|
---|
164 | SHGFP_TYPE_CURRENT = 0;
|
---|
165 | MAXPATH = 255;
|
---|
166 | var
|
---|
167 | Path: array [0..MAXPATH] of Char;
|
---|
168 | begin
|
---|
169 | SHGetFolderPath(0, CSIDL_COMMON_APPDATA, 0, SHGFP_TYPE_CURRENT, @Path[0]);
|
---|
170 | Result := Path;
|
---|
171 | end;
|
---|
172 |
|
---|
173 | function ApplicationDataFolder: string;
|
---|
174 | begin
|
---|
175 | Result := CommonAppDataPath + '\' + Creator + '\' + ApplicationName;
|
---|
176 | if not DirectoryExists(Result) then
|
---|
177 | ForceDirectories(Result);
|
---|
178 | end;
|
---|
179 |
|
---|
180 | procedure ShellLaunch(const S: String);
|
---|
181 | begin
|
---|
182 | ShellExecute(0, 'open', PChar(S), '', '', SW_SHOWNORMAL);
|
---|
183 | end;
|
---|
184 |
|
---|
185 | function GetComputerNetName: string;
|
---|
186 | var
|
---|
187 | buffer: array[0..255] of char;
|
---|
188 | size: dword;
|
---|
189 | begin
|
---|
190 | size := 256;
|
---|
191 | if GetComputerName(buffer, size) then
|
---|
192 | Result := buffer
|
---|
193 | else
|
---|
194 | Result := ''
|
---|
195 | end;
|
---|
196 |
|
---|
197 | function TMainForm.GetCentralaHomepage: Boolean;
|
---|
198 | begin
|
---|
199 | with TRegistry.Create do
|
---|
200 | try
|
---|
201 | RootKey := HKEY_CURRENT_USER;
|
---|
202 | OpenKey('\Software\Microsoft\Internet Explorer\Main', True);
|
---|
203 | Result := ReadString('Start Page') = BrowserHomepage;
|
---|
204 | finally
|
---|
205 | Free;
|
---|
206 | end;
|
---|
207 | end;
|
---|
208 |
|
---|
209 | procedure TMainForm.SetCentralaHomepage(const Value: Boolean);
|
---|
210 | begin
|
---|
211 | with TRegistry.Create do
|
---|
212 | try
|
---|
213 | RootKey := HKEY_CURRENT_USER;
|
---|
214 | OpenKey('\Software\Microsoft\Internet Explorer\Main', True);
|
---|
215 | if Value then begin
|
---|
216 | WriteString('LastStartPage', ReadString('Start Page'));
|
---|
217 | WriteString('Start Page', BrowserHomepage);
|
---|
218 | end else WriteString('Start Page', ReadString('LastStartPage'));
|
---|
219 | finally
|
---|
220 | Free;
|
---|
221 | end;
|
---|
222 | end;
|
---|
223 |
|
---|
224 | procedure TMainForm.FormShow(Sender: TObject);
|
---|
225 | begin
|
---|
226 | LogExceptions.NazevAplikace := ApplicationName + ' ' + Version;
|
---|
227 |
|
---|
228 | CheckBox4.Checked := CentralaHomepage;
|
---|
229 | CheckBox5.Checked := WorkgroupZdechov;
|
---|
230 | CheckBox6.Checked := ShareUnblockFirewall;
|
---|
231 | CheckBox9.Checked := NetSharedFolder;
|
---|
232 | end;
|
---|
233 |
|
---|
234 | procedure TMainForm.Button2Click(Sender: TObject);
|
---|
235 | begin
|
---|
236 | CoolTrayIcon1.HideMainForm;
|
---|
237 | end;
|
---|
238 |
|
---|
239 | procedure TMainForm.Button1Click(Sender: TObject);
|
---|
240 | begin
|
---|
241 | CentralaHomepage := CheckBox4.Checked;
|
---|
242 | WorkgroupZdechov := CheckBox5.Checked;
|
---|
243 | ShareUnblockFirewall := CheckBox6.Checked;
|
---|
244 | NetSharedFolder := CheckBox9.Checked;
|
---|
245 |
|
---|
246 | CoolTrayIcon1.HideMainForm;
|
---|
247 | SaveOptions;
|
---|
248 | end;
|
---|
249 |
|
---|
250 | function TMainForm.GetWorkgroupZdechov: Boolean;
|
---|
251 | var
|
---|
252 | Command: TDosCommand;
|
---|
253 | I: Integer;
|
---|
254 | Lines2: TStringList;
|
---|
255 | begin
|
---|
256 | Lines2 := TStringList.Create;
|
---|
257 | Result := False;
|
---|
258 | Command := TDosCommand.Create(nil);
|
---|
259 | with Command do try
|
---|
260 | CommandLine := ExtractFilePath(Application.ExeName)+'netdom member \\'+GetComputerNetName+' /query';
|
---|
261 | OutputLines := Lines2;
|
---|
262 | Execute2;
|
---|
263 | for I := 0 to Lines2.Count - 1 do
|
---|
264 | if Pos(' ' + Workgroup + '.', Lines2[I]) > 0 then Result := True;
|
---|
265 | finally
|
---|
266 | Free;
|
---|
267 | Lines2.Free;
|
---|
268 | end;
|
---|
269 | end;
|
---|
270 |
|
---|
271 | procedure TMainForm.SetWorkgroupZdechov(const Value: Boolean);
|
---|
272 | var
|
---|
273 | Command: TDosCommand;
|
---|
274 | begin
|
---|
275 | Command := TDosCommand.Create(nil);
|
---|
276 | with Command do try
|
---|
277 | if Value then CommandLine := 'netdom member \\'+GetComputerNetName+' /joinworkgroup '+WorkGroup;
|
---|
278 | Execute2;
|
---|
279 | finally
|
---|
280 | Free;
|
---|
281 | end;
|
---|
282 | end;
|
---|
283 |
|
---|
284 | procedure TMainForm.estst1Click(Sender: TObject);
|
---|
285 | begin
|
---|
286 | NetworkTest.Show;
|
---|
287 | end;
|
---|
288 |
|
---|
289 | procedure TMainForm.Ukonit1Click(Sender: TObject);
|
---|
290 | begin
|
---|
291 | Close;
|
---|
292 | end;
|
---|
293 |
|
---|
294 | function TMainForm.GetRunOnSystemStart: Boolean;
|
---|
295 | begin
|
---|
296 | with TRegistry.Create do
|
---|
297 | try
|
---|
298 | RootKey := HKEY_LOCAL_MACHINE;
|
---|
299 | OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run', True);
|
---|
300 | Result := ReadString(ApplicationName) = Application.ExeName;
|
---|
301 | finally
|
---|
302 | Free;
|
---|
303 | end;
|
---|
304 | end;
|
---|
305 |
|
---|
306 | procedure TMainForm.SetRunOnSystemStart(const Value: Boolean);
|
---|
307 | begin
|
---|
308 | with TRegistry.Create do
|
---|
309 | try
|
---|
310 | RootKey := HKEY_LOCAL_MACHINE;
|
---|
311 | OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run', True);
|
---|
312 | if Value then WriteString(ApplicationName, Application.ExeName)
|
---|
313 | else DeleteValue(ApplicationName);
|
---|
314 | finally
|
---|
315 | Free;
|
---|
316 | end;
|
---|
317 | end;
|
---|
318 |
|
---|
319 | procedure TMainForm.FormCreate(Sender: TObject);
|
---|
320 | begin
|
---|
321 | // Connecting := False;
|
---|
322 | with CoolTrayIcon1 do begin
|
---|
323 | HideTaskbarIcon;
|
---|
324 | Hint := ApplicationName;
|
---|
325 | end;
|
---|
326 |
|
---|
327 | LoadOptions;
|
---|
328 | Application.ShowMainForm := not FirstStart;
|
---|
329 | end;
|
---|
330 |
|
---|
331 | procedure TMainForm.Nastaven1Click(Sender: TObject);
|
---|
332 | begin
|
---|
333 | CoolTrayIcon1.ShowMainForm;
|
---|
334 | end;
|
---|
335 |
|
---|
336 | function TMainForm.GetShareUnblockFirewall: Boolean;
|
---|
337 | begin
|
---|
338 | with TRegistry.Create do
|
---|
339 | try
|
---|
340 | RootKey := HKEY_LOCAL_MACHINE;
|
---|
341 | OpenKey('\SYSTEM\CurrentControlSet\Services\SharedAccess\Parameters\FirewallPolicy\StandardProfile\GloballyOpenPorts\List', True);
|
---|
342 | Result := (ReadString('137:UDP') = '137:UDP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22001')
|
---|
343 | and (ReadString('138:UDP') = '138:UDP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22002')
|
---|
344 | and (ReadString('139:TCP') = '139:TCP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22004')
|
---|
345 | and (ReadString('445:TCP') = '445:TCP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22005');
|
---|
346 | finally
|
---|
347 | Free;
|
---|
348 | end;
|
---|
349 | end;
|
---|
350 |
|
---|
351 | procedure TMainForm.SetShareUnblockFirewall(const Value: Boolean);
|
---|
352 | begin
|
---|
353 | with TRegistry.Create do
|
---|
354 | try
|
---|
355 | RootKey := HKEY_LOCAL_MACHINE;
|
---|
356 | OpenKey('\SYSTEM\CurrentControlSet\Services\SharedAccess\Parameters\FirewallPolicy\StandardProfile\GloballyOpenPorts\List', True);
|
---|
357 | if Value then begin
|
---|
358 | WriteString('137:UDP', '137:UDP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22001');
|
---|
359 | WriteString('138:UDP', '138:UDP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22002');
|
---|
360 | WriteString('139:TCP', '139:TCP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22004');
|
---|
361 | WriteString('445:TCP', '445:TCP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22005');
|
---|
362 | end else begin
|
---|
363 | WriteString('137:UDP', '137:UDP:LocalSubNet:Enabled:@xpsp2res.dll,-22001');
|
---|
364 | WriteString('138:UDP', '138:UDP:LocalSubNet:Enabled:@xpsp2res.dll,-22002');
|
---|
365 | WriteString('139:TCP', '139:TCP:LocalSubNet:Enabled:@xpsp2res.dll,-22004');
|
---|
366 | WriteString('445:TCP', '445:TCP:LocalSubNet:Enabled:@xpsp2res.dll,-22005');
|
---|
367 | end;
|
---|
368 | finally
|
---|
369 | Free;
|
---|
370 | end;
|
---|
371 | end;
|
---|
372 |
|
---|
373 | procedure TMainForm.FormDestroy(Sender: TObject);
|
---|
374 | begin
|
---|
375 | SaveOptions;
|
---|
376 | end;
|
---|
377 |
|
---|
378 | procedure TMainForm.Button3Click(Sender: TObject);
|
---|
379 | begin
|
---|
380 | CheckBox4.Checked := True;
|
---|
381 | CheckBox5.Checked := True;
|
---|
382 | CheckBox6.Checked := True;
|
---|
383 | CheckBox9.Checked := True;
|
---|
384 | end;
|
---|
385 |
|
---|
386 | procedure TMainForm.Oprogramu1Click(Sender: TObject);
|
---|
387 | begin
|
---|
388 | AboutWindow.ShowModal;
|
---|
389 | end;
|
---|
390 |
|
---|
391 | function TMainForm.GetNetSharedFolder: Boolean;
|
---|
392 | var
|
---|
393 | PShareInfo: PShareInfo2;
|
---|
394 | begin
|
---|
395 | Result := False;
|
---|
396 | NetShareGetInfo(nil, MainSharedFolderName, 2, @PShareInfo);
|
---|
397 | if Assigned(PShareInfo) then begin
|
---|
398 | Result := PShareInfo.shi2_path = MainSharedFolderPath;
|
---|
399 | NetApiBufferFree(PShareInfo);
|
---|
400 | end;
|
---|
401 | end;
|
---|
402 |
|
---|
403 | procedure TMainForm.SetNetSharedFolder(const Value: Boolean);
|
---|
404 | var
|
---|
405 | Err: Cardinal;
|
---|
406 | ShareInfo: TShareInfo2;
|
---|
407 | begin
|
---|
408 | if Value then begin
|
---|
409 | if not DirectoryExists(MainSharedFolderPath) then ForceDirectories(MainSharedFolderPath);
|
---|
410 | with ShareInfo do begin
|
---|
411 | shi2_netname := MainSharedFolderName;
|
---|
412 | shi2_path := MainSharedFolderPath;
|
---|
413 | shi2_permissions := ACCESS_ALL;
|
---|
414 | shi2_remark := '';
|
---|
415 | shi2_type := STYPE_DISKTREE;
|
---|
416 | shi2_max_uses := High(Cardinal);
|
---|
417 | shi2_passwd := '';
|
---|
418 | end;
|
---|
419 | NetShareAdd(nil, 2, @ShareInfo, Err);
|
---|
420 | end else begin
|
---|
421 | NetShareDel(nil, MainSharedFolderName, 0);
|
---|
422 | end;
|
---|
423 | end;
|
---|
424 |
|
---|
425 | procedure TMainForm.Init;
|
---|
426 | var
|
---|
427 | Hostname: string;
|
---|
428 | begin
|
---|
429 | HostName := 'default';
|
---|
430 |
|
---|
431 | //DefaultGateway := GetDefaultGateway;
|
---|
432 | //if AutoDial then Dial;
|
---|
433 | end;
|
---|
434 |
|
---|
435 | function GetIPFromHost(var HostName, IPaddr, WSAErr: string): Boolean;
|
---|
436 | type
|
---|
437 | Name = array[0..100] of Char;
|
---|
438 | PName = ^Name;
|
---|
439 | var
|
---|
440 | HEnt: pHostEnt;
|
---|
441 | HName: PName;
|
---|
442 | WSAData: TWSAData;
|
---|
443 | i: Integer;
|
---|
444 | begin
|
---|
445 | Result := False;
|
---|
446 | if WSAStartup($0101, WSAData) <> 0 then begin
|
---|
447 | WSAErr := 'Winsock is not responding."';
|
---|
448 | Exit;
|
---|
449 | end;
|
---|
450 | IPaddr := '';
|
---|
451 | New(HName);
|
---|
452 | if GetHostName(HName^, SizeOf(Name)) = 0 then
|
---|
453 | begin
|
---|
454 | HostName := StrPas(HName^);
|
---|
455 | HEnt := GetHostByName(HName^);
|
---|
456 | for i := 0 to HEnt^.h_length - 1 do
|
---|
457 | IPaddr :=
|
---|
458 | Concat(IPaddr,
|
---|
459 | IntToStr(Ord(HEnt^.h_addr_list^[i])) + '.');
|
---|
460 | SetLength(IPaddr, Length(IPaddr) - 1);
|
---|
461 | Result := True;
|
---|
462 | end
|
---|
463 | else begin
|
---|
464 | case WSAGetLastError of
|
---|
465 | WSANOTINITIALISED:WSAErr:='WSANotInitialised';
|
---|
466 | WSAENETDOWN :WSAErr:='WSAENetDown';
|
---|
467 | WSAEINPROGRESS :WSAErr:='WSAEInProgress';
|
---|
468 | end;
|
---|
469 | end;
|
---|
470 | Dispose(HName);
|
---|
471 | WSACleanup;
|
---|
472 | end;
|
---|
473 |
|
---|
474 | procedure TMainForm.LoadOptions;
|
---|
475 | begin
|
---|
476 | with TRegistry.Create do
|
---|
477 | try
|
---|
478 | RootKey := RegistryRootKey;
|
---|
479 | OpenKey(RegistryPath, True);
|
---|
480 | if ValueExists('FirstStart') then FirstStart := ReadBool('FirstStart')
|
---|
481 | else FirstStart := False;
|
---|
482 | if ValueExists('NetworkTestLastUpdate') then NetworkTestLastUpdate := StrToDate(ReadString('NetworkTestLastUpdate'));
|
---|
483 | if ValueExists('PingTimeout') then PingTimeout := ReadInteger('PingTimeout')
|
---|
484 | else PingTimeout := 200;
|
---|
485 | finally
|
---|
486 | Free;
|
---|
487 | end;
|
---|
488 | end;
|
---|
489 |
|
---|
490 | procedure TMainForm.SaveOptions;
|
---|
491 | begin
|
---|
492 | with TRegistry.Create do
|
---|
493 | try
|
---|
494 | RootKey := RegistryRootKey;
|
---|
495 | OpenKey(RegistryPath, True);
|
---|
496 | WriteBool('FirstStart', True);
|
---|
497 | WriteString('NetworkTestLastUpdate', DateToStr(NetworkTestLastUpdate));
|
---|
498 | WriteInteger('PingTimeout', PingTimeout);
|
---|
499 | finally
|
---|
500 | Free;
|
---|
501 | end;
|
---|
502 | end;
|
---|
503 |
|
---|
504 | function TMainForm.GetNetworkDomain: string;
|
---|
505 | var
|
---|
506 | Command: TDosCommand;
|
---|
507 | I: Integer;
|
---|
508 | Lines2: TStringList;
|
---|
509 | begin
|
---|
510 | Lines2 := TStringList.Create;
|
---|
511 | Result := '';
|
---|
512 | Command := TDosCommand.Create(nil);
|
---|
513 | with Command do try
|
---|
514 | CommandLine := 'ipconfig /all';
|
---|
515 | OutputLines := Lines2;
|
---|
516 | Execute2;
|
---|
517 | for I := 0 to Lines2.Count - 1 do
|
---|
518 | if Pos('Prohledávací seznam pøípon DNS', Lines2[I]) > 0 then
|
---|
519 | Result := Copy(Lines2[I], Pos(':', Lines2[I]) + 2, 255);
|
---|
520 | finally
|
---|
521 | Free;
|
---|
522 | Lines2.Free;
|
---|
523 | end;
|
---|
524 | end;
|
---|
525 |
|
---|
526 | end.
|
---|