1 | unit MainWindow;
|
---|
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, magrascon, magrasedt, magrasent, SHFolder,
|
---|
9 | ShlObj, magrasapi, 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.2';
|
---|
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 |
|
---|
26 | BrowserHomepage = 'http://centrala.zdechov.net/';
|
---|
27 | WorkGroup = 'ZDECHOV';
|
---|
28 | DefaultConnectionName = 'ZdìchovNET';
|
---|
29 | ConnectionHost = 'centrala.zdechov.net';
|
---|
30 | MainSharedFolderPath = 'C:\Net';
|
---|
31 | MainSharedFolderName = 'Net';
|
---|
32 | LocalNetAddr = '192.168.0.0';
|
---|
33 | LocalNetMask = '255.255.0.0';
|
---|
34 |
|
---|
35 | type
|
---|
36 | TMainForm = class(TForm)
|
---|
37 | Button1: TButton;
|
---|
38 | Button2: TButton;
|
---|
39 | GroupBox1: TGroupBox;
|
---|
40 | CheckBox1: TCheckBox;
|
---|
41 | ComboBox1: TComboBox;
|
---|
42 | Label1: TLabel;
|
---|
43 | CheckBox2: TCheckBox;
|
---|
44 | CheckBox3: TCheckBox;
|
---|
45 | Bevel1: TBevel;
|
---|
46 | CheckBox4: TCheckBox;
|
---|
47 | CoolTrayIcon1: TCoolTrayIcon;
|
---|
48 | Button3: TButton;
|
---|
49 | PopupMenu1: TPopupMenu;
|
---|
50 | Ukonit1: TMenuItem;
|
---|
51 | estst1: TMenuItem;
|
---|
52 | Nastaven1: TMenuItem;
|
---|
53 | CheckBox5: TCheckBox;
|
---|
54 | XPManifest1: TXPManifest;
|
---|
55 | CheckBox6: TCheckBox;
|
---|
56 | MagRasCon1: TMagRasCon;
|
---|
57 | Timer1: TTimer;
|
---|
58 | CheckBox7: TCheckBox;
|
---|
59 | MagRasEdt1: TMagRasEdt;
|
---|
60 | CheckBox8: TCheckBox;
|
---|
61 | Oprogramu1: TMenuItem;
|
---|
62 | CheckBox9: TCheckBox;
|
---|
63 | Zznamvyten1: TMenuItem;
|
---|
64 | Timer2: TTimer;
|
---|
65 | Label2: TLabel;
|
---|
66 | OpenDialog1: TOpenDialog;
|
---|
67 | GroupBox2: TGroupBox;
|
---|
68 | CheckBox10: TCheckBox;
|
---|
69 | Label3: TLabel;
|
---|
70 | Edit1: TEdit;
|
---|
71 | Button4: TButton;
|
---|
72 | procedure FormShow(Sender: TObject);
|
---|
73 | procedure Button2Click(Sender: TObject);
|
---|
74 | procedure Button1Click(Sender: TObject);
|
---|
75 | procedure estst1Click(Sender: TObject);
|
---|
76 | procedure Ukonit1Click(Sender: TObject);
|
---|
77 | procedure FormCreate(Sender: TObject);
|
---|
78 | procedure Nastaven1Click(Sender: TObject);
|
---|
79 | procedure Timer1Timer(Sender: TObject);
|
---|
80 | procedure FormDestroy(Sender: TObject);
|
---|
81 | procedure Button3Click(Sender: TObject);
|
---|
82 | procedure Oprogramu1Click(Sender: TObject);
|
---|
83 | procedure Zznamvyten1Click(Sender: TObject);
|
---|
84 | procedure MagRasCon1StateChanged(Sender: TObject);
|
---|
85 | procedure Timer2Timer(Sender: TObject);
|
---|
86 | procedure Button4Click(Sender: TObject);
|
---|
87 | procedure CheckBox10Click(Sender: TObject);
|
---|
88 | private
|
---|
89 | Connecting: Boolean;
|
---|
90 | DialHandle: Cardinal;
|
---|
91 | function GetLocalNetworkRouting: Boolean;
|
---|
92 | procedure SetLocalNetworkRouting(const Value: Boolean);
|
---|
93 | function GetCentralaHomepage: Boolean;
|
---|
94 | procedure SetCentralaHomepage(const Value: Boolean);
|
---|
95 | function GetWorkgroupZdechov: Boolean;
|
---|
96 | procedure SetWorkgroupZdechov(const Value: Boolean);
|
---|
97 | function GetRunOnSystemStart: Boolean;
|
---|
98 | procedure SetRunOnSystemStart(const Value: Boolean);
|
---|
99 | function GetShareUnblockFirewall: Boolean;
|
---|
100 | procedure SetShareUnblockFirewall(const Value: Boolean);
|
---|
101 | function GetZdechovNetConnection: Boolean;
|
---|
102 | procedure SetZdechovNetConnection(const Value: Boolean);
|
---|
103 | function GetNetSharedFolder: Boolean;
|
---|
104 | procedure SetNetSharedFolder(const Value: Boolean);
|
---|
105 | public
|
---|
106 | DefaultGateway: string;
|
---|
107 | LogFileName: string;
|
---|
108 | FirstStart: Boolean;
|
---|
109 | LastState: Word;
|
---|
110 | HostFilterIndex: Integer;
|
---|
111 | PingTimeout: Integer;
|
---|
112 | AutoDial: Boolean;
|
---|
113 | AutoRedial: Boolean;
|
---|
114 | ConnectionName: string;
|
---|
115 | NetworkTestLastUpdate: TDateTime;
|
---|
116 | LogFileEnabled: Boolean;
|
---|
117 | property LocalNetworkRouting: Boolean read GetLocalNetworkRouting
|
---|
118 | write SetLocalNetworkRouting;
|
---|
119 | property CentralaHomepage: Boolean read GetCentralaHomepage
|
---|
120 | write SetCentralaHomepage;
|
---|
121 | property WorkgroupZdechov: Boolean read GetWorkgroupZdechov
|
---|
122 | write SetWorkgroupZdechov;
|
---|
123 | property RunOnSystemStart: Boolean read GetRunOnSystemStart
|
---|
124 | write SetRunOnSystemStart;
|
---|
125 | property ShareUnblockFirewall: Boolean read GetShareUnblockFirewall
|
---|
126 | write SetShareUnblockFirewall;
|
---|
127 | property ZdechovNetConnection: Boolean read GetZdechovNetConnection
|
---|
128 | write SetZdechovNetConnection;
|
---|
129 | property NetSharedFolder: Boolean read GetNetSharedFolder
|
---|
130 | write SetNetSharedFolder;
|
---|
131 | procedure Init;
|
---|
132 | procedure Dial;
|
---|
133 | procedure AddConnection;
|
---|
134 | procedure DeleteConnection;
|
---|
135 | procedure DialLog(Message: string);
|
---|
136 | end;
|
---|
137 |
|
---|
138 | var
|
---|
139 | MainForm: TMainForm;
|
---|
140 |
|
---|
141 | function GetIPFromHost(var HostName, IPaddr, WSAErr: string): Boolean;
|
---|
142 | function GetComputerNetName: string;
|
---|
143 | function CommonAppDataPath: string;
|
---|
144 | procedure ShellLaunch(const S: String);
|
---|
145 |
|
---|
146 | implementation
|
---|
147 |
|
---|
148 | uses UNetworkTest, UAboutWindow, ULogExceptions, DateUtils, Math,
|
---|
149 | UDialingLog, StrUtils;
|
---|
150 |
|
---|
151 | {$R *.dfm}
|
---|
152 |
|
---|
153 | const
|
---|
154 |
|
---|
155 | // Share types
|
---|
156 | STYPE_ALL = -1; //note: my const
|
---|
157 | STYPE_DISKTREE = 0;
|
---|
158 | STYPE_PRINTQ = 1;
|
---|
159 | STYPE_DEVICE = 2;
|
---|
160 | STYPE_IPC = 3;
|
---|
161 | STYPE_SPECIAL = $80000000;
|
---|
162 |
|
---|
163 | // Share permission
|
---|
164 | ACCESS_READ = 1;
|
---|
165 | ACCESS_WRITE = 2;
|
---|
166 | ACCESS_CREATE = 4;
|
---|
167 | ACCESS_EXEC = 8;
|
---|
168 | ACCESS_DELETE = 16;
|
---|
169 | ACCESS_ATRIB = 32;
|
---|
170 | ACCESS_PERM = 64;
|
---|
171 | ACCESS_ALL = ACCESS_READ or ACCESS_WRITE or ACCESS_CREATE or ACCESS_EXEC or
|
---|
172 | ACCESS_DELETE or ACCESS_ATRIB or ACCESS_PERM;
|
---|
173 |
|
---|
174 | type
|
---|
175 | TShareInfo2 = record
|
---|
176 | shi2_netname : PWideChar;
|
---|
177 | shi2_type : DWORD;
|
---|
178 | shi2_remark : PWideChar;
|
---|
179 | shi2_permissions : DWORD;
|
---|
180 | shi2_max_uses : DWORD;
|
---|
181 | shi2_current_uses : DWORD;
|
---|
182 | shi2_path : PWideChar;
|
---|
183 | shi2_passwd : PWideChar;
|
---|
184 | end;
|
---|
185 | PShareInfo2 = ^TShareInfo2;
|
---|
186 |
|
---|
187 | procedure NetApiBufferFree(Buf: Pointer) stdcall; external 'netapi32.dll';
|
---|
188 | function NetShareGetInfo(SeverName, NetName: PWideChar; Level: DWORD;
|
---|
189 | Buf: Pointer): LongInt; stdcall; external 'netapi32.dll';
|
---|
190 | function NetShareDel(ServerName, ShareName : PWideChar; Reserved: DWord):
|
---|
191 | LongInt; stdcall; external 'netapi32.dll';
|
---|
192 | function NetShareAdd(ServerName : PWideChar; Level : DWord;
|
---|
193 | Buffer : Pointer; var ParamError :DWord) : Longint; stdcall; external 'netapi32.dll';
|
---|
194 |
|
---|
195 |
|
---|
196 | function CommonAppDataPath: string;
|
---|
197 | const
|
---|
198 | SHGFP_TYPE_CURRENT = 0;
|
---|
199 | MAXPATH = 255;
|
---|
200 | var
|
---|
201 | Path: array [0..MAXPATH] of Char;
|
---|
202 | begin
|
---|
203 | SHGetFolderPath(0, CSIDL_COMMON_APPDATA, 0, SHGFP_TYPE_CURRENT, @Path[0]);
|
---|
204 | Result := Path;
|
---|
205 | end;
|
---|
206 |
|
---|
207 | function ApplicationDataFolder: string;
|
---|
208 | begin
|
---|
209 | Result := CommonAppDataPath + '\' + Creator + '\' + ApplicationName;
|
---|
210 | if not DirectoryExists(Result) then
|
---|
211 | ForceDirectories(Result);
|
---|
212 | end;
|
---|
213 |
|
---|
214 | procedure ShellLaunch(const S: String);
|
---|
215 | begin
|
---|
216 | ShellExecute(0, 'open', PChar(S), '', '', SW_SHOWNORMAL);
|
---|
217 | end;
|
---|
218 |
|
---|
219 | function GetComputerNetName: string;
|
---|
220 | var
|
---|
221 | buffer: array[0..255] of char;
|
---|
222 | size: dword;
|
---|
223 | begin
|
---|
224 | size := 256;
|
---|
225 | if GetComputerName(buffer, size) then
|
---|
226 | Result := buffer
|
---|
227 | else
|
---|
228 | Result := ''
|
---|
229 | end;
|
---|
230 |
|
---|
231 | function TMainForm.GetLocalNetworkRouting: Boolean;
|
---|
232 | var
|
---|
233 | Command: TDosCommand;
|
---|
234 | I: Integer;
|
---|
235 | Lines2: TStringList;
|
---|
236 | begin
|
---|
237 | Lines2 := TStringList.Create;
|
---|
238 | Result := False;
|
---|
239 | Command := TDosCommand.Create(nil);
|
---|
240 | with Command do try
|
---|
241 | CommandLine := 'route print ' + LocalNetAddr + ' mask ' + LocalNetMask +
|
---|
242 | ' ' + DefaultGateway + ' metric 30';
|
---|
243 | OutputLines := Lines2;
|
---|
244 | Execute2;
|
---|
245 | for I := 0 to Lines2.Count - 1 do
|
---|
246 | if Pos(LocalNetMask, Lines2[I]) > 0 then Result := True;
|
---|
247 | finally
|
---|
248 | Free;
|
---|
249 | Lines2.Free;
|
---|
250 | end;
|
---|
251 | end;
|
---|
252 |
|
---|
253 | procedure TMainForm.SetLocalNetworkRouting(const Value: Boolean);
|
---|
254 | var
|
---|
255 | Command: TDosCommand;
|
---|
256 | begin
|
---|
257 | Command := TDosCommand.Create(nil);
|
---|
258 | with Command do try
|
---|
259 | if Value then CommandLine := 'route -p add '+LocalNetAddr+' mask '+LocalNetMask+' '+DefaultGateway+' metric 30'
|
---|
260 | else CommandLine := 'route delete '+LocalNetAddr+' mask '+LocalNetMask+' '+DefaultGateway+' metric 30';
|
---|
261 | Execute2;
|
---|
262 | finally
|
---|
263 | Free;
|
---|
264 | end;
|
---|
265 | end;
|
---|
266 |
|
---|
267 | function TMainForm.GetCentralaHomepage: Boolean;
|
---|
268 | begin
|
---|
269 | with TRegistry.Create do
|
---|
270 | try
|
---|
271 | RootKey := HKEY_CURRENT_USER;
|
---|
272 | OpenKey('\Software\Microsoft\Internet Explorer\Main', True);
|
---|
273 | Result := ReadString('Start Page') = BrowserHomepage;
|
---|
274 | finally
|
---|
275 | Free;
|
---|
276 | end;
|
---|
277 | end;
|
---|
278 |
|
---|
279 | procedure TMainForm.SetCentralaHomepage(const Value: Boolean);
|
---|
280 | begin
|
---|
281 | with TRegistry.Create do
|
---|
282 | try
|
---|
283 | RootKey := HKEY_CURRENT_USER;
|
---|
284 | OpenKey('\Software\Microsoft\Internet Explorer\Main', True);
|
---|
285 | if Value then begin
|
---|
286 | WriteString('LastStartPage', ReadString('Start Page'));
|
---|
287 | WriteString('Start Page', BrowserHomepage);
|
---|
288 | end else WriteString('Start Page', ReadString('LastStartPage'));
|
---|
289 | finally
|
---|
290 | Free;
|
---|
291 | end;
|
---|
292 | end;
|
---|
293 |
|
---|
294 | procedure TMainForm.FormShow(Sender: TObject);
|
---|
295 | begin
|
---|
296 | LogExceptions.NazevAplikace := ApplicationName + ' ' + Version;
|
---|
297 |
|
---|
298 | CheckBox1.Checked := AutoRedial;
|
---|
299 | CheckBox2.Checked := LocalNetworkRouting;
|
---|
300 | CheckBox3.Checked := RunOnSystemStart;
|
---|
301 | CheckBox4.Checked := CentralaHomepage;
|
---|
302 | CheckBox5.Checked := WorkgroupZdechov;
|
---|
303 | CheckBox6.Checked := ShareUnblockFirewall;
|
---|
304 | CheckBox7.Checked := AutoDial;
|
---|
305 | CheckBox8.Checked := ZdechovNetConnection;
|
---|
306 | CheckBox9.Checked := NetSharedFolder;
|
---|
307 |
|
---|
308 | MagRasCon1.GetPhoneBookEntries ;
|
---|
309 | ComboBox1.Items.Assign(MagRasCon1.PhoneBookEntries);
|
---|
310 | ComboBox1.ItemIndex := ComboBox1.Items.IndexOf(ConnectionName);
|
---|
311 |
|
---|
312 | CheckBox10.Checked := LogFileEnabled;
|
---|
313 | Edit1.Text := LogFileName;
|
---|
314 | Edit1.Enabled := LogFileEnabled;
|
---|
315 | Button4.Enabled := LogFileEnabled;
|
---|
316 |
|
---|
317 | Label2.Caption := 'Brána: ' + DefaultGateway;
|
---|
318 | end;
|
---|
319 |
|
---|
320 | procedure TMainForm.Button2Click(Sender: TObject);
|
---|
321 | begin
|
---|
322 | CoolTrayIcon1.HideMainForm;
|
---|
323 | end;
|
---|
324 |
|
---|
325 | procedure TMainForm.Button1Click(Sender: TObject);
|
---|
326 | begin
|
---|
327 | AutoRedial := CheckBox1.Checked;
|
---|
328 | LocalNetworkRouting := CheckBox2.Checked;
|
---|
329 | RunOnSystemStart := CheckBox3.Checked;
|
---|
330 | CentralaHomepage := CheckBox4.Checked;
|
---|
331 | WorkgroupZdechov := CheckBox5.Checked;
|
---|
332 | ShareUnblockFirewall := CheckBox6.Checked;
|
---|
333 | AutoDial := CheckBox7.Checked;
|
---|
334 | ZdechovNetConnection := CheckBox8.Checked;
|
---|
335 | NetSharedFolder := CheckBox9.Checked;
|
---|
336 | LogFileEnabled := CheckBox10.Checked;
|
---|
337 | LogFileName := Edit1.Text;
|
---|
338 |
|
---|
339 | ConnectionName := ComboBox1.Items.Strings[ComboBox1.ItemIndex];
|
---|
340 | CoolTrayIcon1.HideMainForm;
|
---|
341 | end;
|
---|
342 |
|
---|
343 | function TMainForm.GetWorkgroupZdechov: Boolean;
|
---|
344 | var
|
---|
345 | Command: TDosCommand;
|
---|
346 | I: Integer;
|
---|
347 | Lines2: TStringList;
|
---|
348 | begin
|
---|
349 | Lines2 := TStringList.Create;
|
---|
350 | Result := False;
|
---|
351 | Command := TDosCommand.Create(nil);
|
---|
352 | with Command do try
|
---|
353 | CommandLine := ExtractFilePath(Application.ExeName)+'netdom member \\'+GetComputerNetName+' /query';
|
---|
354 | OutputLines := Lines2;
|
---|
355 | Execute2;
|
---|
356 | for I := 0 to Lines2.Count - 1 do
|
---|
357 | if Pos(' ' + Workgroup + '.', Lines2[I]) > 0 then Result := True;
|
---|
358 | finally
|
---|
359 | Free;
|
---|
360 | Lines2.Free;
|
---|
361 | end;
|
---|
362 | end;
|
---|
363 |
|
---|
364 | procedure TMainForm.SetWorkgroupZdechov(const Value: Boolean);
|
---|
365 | var
|
---|
366 | Command: TDosCommand;
|
---|
367 | begin
|
---|
368 | Command := TDosCommand.Create(nil);
|
---|
369 | with Command do try
|
---|
370 | if Value then CommandLine := 'netdom member \\'+GetComputerNetName+' /joinworkgroup '+WorkGroup;
|
---|
371 | Execute2;
|
---|
372 | finally
|
---|
373 | Free;
|
---|
374 | end;
|
---|
375 | end;
|
---|
376 |
|
---|
377 | procedure TMainForm.estst1Click(Sender: TObject);
|
---|
378 | begin
|
---|
379 | NetworkTest.Show;
|
---|
380 | end;
|
---|
381 |
|
---|
382 | procedure TMainForm.Ukonit1Click(Sender: TObject);
|
---|
383 | begin
|
---|
384 | Close;
|
---|
385 | end;
|
---|
386 |
|
---|
387 | function TMainForm.GetRunOnSystemStart: Boolean;
|
---|
388 | begin
|
---|
389 | with TRegistry.Create do
|
---|
390 | try
|
---|
391 | RootKey := HKEY_LOCAL_MACHINE;
|
---|
392 | OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run', True);
|
---|
393 | Result := ReadString(ApplicationName) = Application.ExeName;
|
---|
394 | finally
|
---|
395 | Free;
|
---|
396 | end;
|
---|
397 | end;
|
---|
398 |
|
---|
399 | procedure TMainForm.SetRunOnSystemStart(const Value: Boolean);
|
---|
400 | begin
|
---|
401 | with TRegistry.Create do
|
---|
402 | try
|
---|
403 | RootKey := HKEY_LOCAL_MACHINE;
|
---|
404 | OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run', True);
|
---|
405 | if Value then WriteString(ApplicationName, Application.ExeName)
|
---|
406 | else DeleteValue(ApplicationName);
|
---|
407 | finally
|
---|
408 | Free;
|
---|
409 | end;
|
---|
410 | end;
|
---|
411 |
|
---|
412 | procedure TMainForm.FormCreate(Sender: TObject);
|
---|
413 | begin
|
---|
414 | Connecting := False;
|
---|
415 | with CoolTrayIcon1 do begin
|
---|
416 | HideTaskbarIcon;
|
---|
417 | Hint := ApplicationName;
|
---|
418 | end;
|
---|
419 |
|
---|
420 | with TRegistry.Create do
|
---|
421 | try
|
---|
422 | RootKey := RegistryRootKey;
|
---|
423 | OpenKey(RegistryPath, True);
|
---|
424 | if ValueExists('FirstStart') then FirstStart := ReadBool('FirstStart')
|
---|
425 | else FirstStart := False;
|
---|
426 | if ValueExists('AutoDial') then AutoDial := ReadBool('AutoDial');
|
---|
427 | if ValueExists('AutoRedial') then AutoRedial := ReadBool('AutoRedial');
|
---|
428 | if ValueExists('ConnectionName') then ConnectionName := ReadString('ConnectionName');
|
---|
429 | if ValueExists('NetworkTestLastUpdate') then NetworkTestLastUpdate := StrToDate(ReadString('NetworkTestLastUpdate'));
|
---|
430 | if ValueExists('PingTimeout') then PingTimeout := ReadInteger('PingTimeout')
|
---|
431 | else PingTimeout := 200;
|
---|
432 | if ValueExists('LogFileEnabled') then LogFileEnabled := ReadBool('LogFileEnabled')
|
---|
433 | else LogFileEnabled := False;
|
---|
434 | if ValueExists('LogFileName') then LogFileName := ReadString('LogFileName')
|
---|
435 | else LogFileName := ApplicationDataFolder + '\' + DefaultLogFileName;
|
---|
436 | finally
|
---|
437 | Free;
|
---|
438 | end;
|
---|
439 | Application.ShowMainForm := not FirstStart;
|
---|
440 |
|
---|
441 | end;
|
---|
442 |
|
---|
443 | procedure TMainForm.Nastaven1Click(Sender: TObject);
|
---|
444 | begin
|
---|
445 | CoolTrayIcon1.ShowMainForm;
|
---|
446 | end;
|
---|
447 |
|
---|
448 | function TMainForm.GetShareUnblockFirewall: Boolean;
|
---|
449 | begin
|
---|
450 | with TRegistry.Create do
|
---|
451 | try
|
---|
452 | RootKey := HKEY_LOCAL_MACHINE;
|
---|
453 | OpenKey('\SYSTEM\CurrentControlSet\Services\SharedAccess\Parameters\FirewallPolicy\StandardProfile\GloballyOpenPorts\List', True);
|
---|
454 | Result := (ReadString('137:UDP') = '137:UDP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22001')
|
---|
455 | and (ReadString('138:UDP') = '138:UDP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22002')
|
---|
456 | and (ReadString('139:TCP') = '139:TCP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22004')
|
---|
457 | and (ReadString('445:TCP') = '445:TCP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22005');
|
---|
458 | finally
|
---|
459 | Free;
|
---|
460 | end;
|
---|
461 | end;
|
---|
462 |
|
---|
463 | procedure TMainForm.SetShareUnblockFirewall(const Value: Boolean);
|
---|
464 | begin
|
---|
465 | with TRegistry.Create do
|
---|
466 | try
|
---|
467 | RootKey := HKEY_LOCAL_MACHINE;
|
---|
468 | OpenKey('\SYSTEM\CurrentControlSet\Services\SharedAccess\Parameters\FirewallPolicy\StandardProfile\GloballyOpenPorts\List', True);
|
---|
469 | if Value then begin
|
---|
470 | WriteString('137:UDP', '137:UDP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22001');
|
---|
471 | WriteString('138:UDP', '138:UDP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22002');
|
---|
472 | WriteString('139:TCP', '139:TCP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22004');
|
---|
473 | WriteString('445:TCP', '445:TCP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22005');
|
---|
474 | end else begin
|
---|
475 | WriteString('137:UDP', '137:UDP:LocalSubNet:Enabled:@xpsp2res.dll,-22001');
|
---|
476 | WriteString('138:UDP', '138:UDP:LocalSubNet:Enabled:@xpsp2res.dll,-22002');
|
---|
477 | WriteString('139:TCP', '139:TCP:LocalSubNet:Enabled:@xpsp2res.dll,-22004');
|
---|
478 | WriteString('445:TCP', '445:TCP:LocalSubNet:Enabled:@xpsp2res.dll,-22005');
|
---|
479 | end;
|
---|
480 | finally
|
---|
481 | Free;
|
---|
482 | end;
|
---|
483 | end;
|
---|
484 |
|
---|
485 | procedure TMainForm.Dial;
|
---|
486 | var
|
---|
487 | I: Integer;
|
---|
488 | begin
|
---|
489 | if MagRasCon1.ConnectState = RASCS_Connected then
|
---|
490 | MagRasCon1.DisconnectEx(DialHandle, 0, 3000, False);
|
---|
491 |
|
---|
492 | if Assigned(DialingLog) then DialLog('');
|
---|
493 | if Assigned(DialingLog) then DialLog(DateTimeToStr(Now) + ': Vytáèím pøípojení');
|
---|
494 | with MagRasCon1 do begin
|
---|
495 | GetConnections;
|
---|
496 | I := 0;
|
---|
497 | while (I < Connections.Count) and (Connections.EntryName(I) <> ConnectionName) do I := I + 1;
|
---|
498 | if not (I < Connections.Count) then begin
|
---|
499 | EntryName := ConnectionName;
|
---|
500 | PhoneNumber := '';
|
---|
501 | DialHandle := 0;
|
---|
502 | if AutoConnectEx(DialHandle) <> 0 then
|
---|
503 | if Assigned(DialingLog) then DialLog('Dialling Failed - ' + MagRasCon1.StatusStr);
|
---|
504 | end;
|
---|
505 | end;
|
---|
506 | end;
|
---|
507 |
|
---|
508 | procedure TMainForm.Timer1Timer(Sender: TObject);
|
---|
509 | begin
|
---|
510 | if MagRasCon1.ConnectState <> RASCS_Connected then begin
|
---|
511 | Timer1.Enabled := False;
|
---|
512 | Dial;
|
---|
513 | end;
|
---|
514 | end;
|
---|
515 |
|
---|
516 | procedure TMainForm.FormDestroy(Sender: TObject);
|
---|
517 | begin
|
---|
518 | with TRegistry.Create do
|
---|
519 | try
|
---|
520 | RootKey := RegistryRootKey;
|
---|
521 | OpenKey(RegistryPath, True);
|
---|
522 | WriteBool('FirstStart', True);
|
---|
523 | WriteBool('AutoDial', AutoDial);
|
---|
524 | WriteBool('AutoRedial', AutoRedial);
|
---|
525 | WriteString('ConnectionName', ConnectionName);
|
---|
526 | WriteString('NetworkTestLastUpdate', DateToStr(NetworkTestLastUpdate));
|
---|
527 | WriteInteger('PingTimeout', PingTimeout);
|
---|
528 | WriteBool('LogFileEnabled', LogFileEnabled);
|
---|
529 | WriteString('LogFileName', LogFileName);
|
---|
530 | finally
|
---|
531 | Free;
|
---|
532 | end;
|
---|
533 | end;
|
---|
534 |
|
---|
535 | procedure TMainForm.AddConnection;
|
---|
536 | var
|
---|
537 | I: Integer;
|
---|
538 | begin
|
---|
539 | if MagRasCon1.ValidateName(DefaultConnectionName) = 0 then
|
---|
540 | with MagRasEdt1 do begin
|
---|
541 | PPPDefault;
|
---|
542 | PhoneBookPath := ''; // 4.60
|
---|
543 | // telephone numbers
|
---|
544 | SetCanonical(ConnectionHost) ;
|
---|
545 |
|
---|
546 | // dial params
|
---|
547 | UserName := LowerCase(GetComputerNetName);
|
---|
548 | Password := '';
|
---|
549 |
|
---|
550 | bPreviewUserPw := True;
|
---|
551 | bShowDialingProgress := True;
|
---|
552 | bRequireCHAP := False;
|
---|
553 | bRequireMSEncryptedPassword := False;
|
---|
554 | bSoftwareCompression := True;
|
---|
555 | bCustom := True;
|
---|
556 |
|
---|
557 | // device stuff
|
---|
558 | I := 0;
|
---|
559 | MagRasCon1.GetDeviceList;
|
---|
560 | while (I < MagRasCon1.DeviceNameList.Count) and
|
---|
561 | (Pos('PPTP', MagRasCon1.DeviceNameList[I]) = 0) do I := I + 1;
|
---|
562 | DeviceName := MagRasCon1.DeviceNameList[I];
|
---|
563 | DeviceType := MagRasCon1.DeviceTypeList[I] ;
|
---|
564 | if PutAllEntryProps(DefaultConnectionName) = 0 then
|
---|
565 | PutDialProps (DefaultConnectionName);
|
---|
566 | end;
|
---|
567 | end;
|
---|
568 |
|
---|
569 | function TMainForm.GetZdechovNetConnection: Boolean;
|
---|
570 | var
|
---|
571 | I: Integer;
|
---|
572 | begin
|
---|
573 | MagRasGetEntryList('');
|
---|
574 | I := 0;
|
---|
575 | while (I < MagRasNumEntryRec) and
|
---|
576 | (MagRasEntryRecs[I].EntryName <> DefaultConnectionName) do I := I + 1;
|
---|
577 | Result := I < MagRasNumEntryRec;
|
---|
578 | end;
|
---|
579 |
|
---|
580 | procedure TMainForm.SetZdechovNetConnection(const Value: Boolean);
|
---|
581 | begin
|
---|
582 | if Value then AddConnection else DeleteConnection;
|
---|
583 | end;
|
---|
584 |
|
---|
585 | procedure TMainForm.DeleteConnection;
|
---|
586 | begin
|
---|
587 | with MagRasCon1 do begin
|
---|
588 | EntryName := DefaultConnectionName;
|
---|
589 | DeletePhonebook;
|
---|
590 | end;
|
---|
591 | end;
|
---|
592 |
|
---|
593 | procedure TMainForm.Button3Click(Sender: TObject);
|
---|
594 | begin
|
---|
595 | CheckBox1.Checked := True;
|
---|
596 | CheckBox2.Checked := True;
|
---|
597 | CheckBox3.Checked := True;
|
---|
598 | CheckBox4.Checked := True;
|
---|
599 | CheckBox5.Checked := True;
|
---|
600 | CheckBox6.Checked := True;
|
---|
601 | CheckBox7.Checked := True;
|
---|
602 | CheckBox8.Checked := True;
|
---|
603 | CheckBox9.Checked := True;
|
---|
604 | ComboBox1.ItemIndex := ComboBox1.Items.IndexOf(DefaultConnectionName);
|
---|
605 | end;
|
---|
606 |
|
---|
607 | procedure TMainForm.Oprogramu1Click(Sender: TObject);
|
---|
608 | begin
|
---|
609 | AboutWindow.ShowModal;
|
---|
610 | end;
|
---|
611 |
|
---|
612 | function TMainForm.GetNetSharedFolder: Boolean;
|
---|
613 | var
|
---|
614 | PShareInfo: PShareInfo2;
|
---|
615 | begin
|
---|
616 | Result := False;
|
---|
617 | NetShareGetInfo(nil, MainSharedFolderName, 2, @PShareInfo);
|
---|
618 | if Assigned(PShareInfo) then begin
|
---|
619 | Result := PShareInfo.shi2_path = MainSharedFolderPath;
|
---|
620 | NetApiBufferFree(PShareInfo);
|
---|
621 | end;
|
---|
622 | end;
|
---|
623 |
|
---|
624 | procedure TMainForm.SetNetSharedFolder(const Value: Boolean);
|
---|
625 | var
|
---|
626 | Err: Cardinal;
|
---|
627 | ShareInfo: TShareInfo2;
|
---|
628 | begin
|
---|
629 | if Value then begin
|
---|
630 | if not DirectoryExists(MainSharedFolderPath) then ForceDirectories(MainSharedFolderPath);
|
---|
631 | with ShareInfo do begin
|
---|
632 | shi2_netname := MainSharedFolderName;
|
---|
633 | shi2_path := MainSharedFolderPath;
|
---|
634 | shi2_permissions := ACCESS_ALL;
|
---|
635 | shi2_remark := '';
|
---|
636 | shi2_type := STYPE_DISKTREE;
|
---|
637 | shi2_max_uses := High(Cardinal);
|
---|
638 | shi2_passwd := '';
|
---|
639 | end;
|
---|
640 | NetShareAdd(nil, 2, @ShareInfo, Err);
|
---|
641 | end else begin
|
---|
642 | NetShareDel(nil, MainSharedFolderName, 0);
|
---|
643 | end;
|
---|
644 | end;
|
---|
645 |
|
---|
646 | procedure TMainForm.Zznamvyten1Click(Sender: TObject);
|
---|
647 | begin
|
---|
648 | if not DialingLog.Visible then DialingLog.ShowModal;
|
---|
649 | end;
|
---|
650 |
|
---|
651 | procedure TMainForm.MagRasCon1StateChanged(Sender: TObject);
|
---|
652 | var
|
---|
653 | Info: string;
|
---|
654 | begin
|
---|
655 | if LastState = MagRasCon1.ConnectState then Exit;
|
---|
656 |
|
---|
657 | // check type of event
|
---|
658 | Info := '';
|
---|
659 | case MagRasCon1.StateEventSource of
|
---|
660 | SourceDial: Info := ' Dial: ';
|
---|
661 | SourceStatus: begin
|
---|
662 | Info := ' Status: ';
|
---|
663 | Timer1.Enabled := True;
|
---|
664 | end;
|
---|
665 | SourceHangup: Info := ' Hangup: ';
|
---|
666 | end;
|
---|
667 |
|
---|
668 | // see if new event, else display it
|
---|
669 | LastState := MagRasCon1.ConnectState ;
|
---|
670 | if Assigned(DialingLog) then DialLog(Info + MagRasCon1.StatusStr
|
---|
671 | + ' (' + IntToStr(LastState) + ')');
|
---|
672 |
|
---|
673 | // if dialling need to see what's happened
|
---|
674 | if DialHandle <> 0 then begin
|
---|
675 | // online OK, restart timer
|
---|
676 | if (MagRasCon1.ConnectState = RASCS_Connected) then begin
|
---|
677 | // ConnHandle := DialHandle
|
---|
678 | // DialHandle := 0;
|
---|
679 | // TimerStatus.Enabled := True;
|
---|
680 | end;
|
---|
681 |
|
---|
682 | // dialling failed, either an error or disconnected
|
---|
683 | if ((MagRasCon1.ConnectState > RASBase) and
|
---|
684 | (MagRasCon1.ConnectState < RASCS_Paused)) or
|
---|
685 | (MagRasCon1.ConnectState = RASCS_Disconnected) then begin
|
---|
686 | // disconnect, returns when done or after three seconds, no StateChanged
|
---|
687 | //ConnHandle := DialHandle;
|
---|
688 | //DialHandle := 0;
|
---|
689 | MagRasCon1.DisconnectEx(DialHandle, 0, 3000, False);
|
---|
690 | Timer1.Enabled := True;
|
---|
691 | // reset is done in timer event
|
---|
692 | end;
|
---|
693 | end;
|
---|
694 | end;
|
---|
695 |
|
---|
696 | procedure TMainForm.Init;
|
---|
697 | var
|
---|
698 | WSAErr: string;
|
---|
699 | Hostname: string;
|
---|
700 | begin
|
---|
701 | HostName := 'default';
|
---|
702 | GetIPFromHost(Hostname, DefaultGateway, WSAErr);
|
---|
703 | DefaultGateway := ReverseString(DefaultGateway);
|
---|
704 | DefaultGateway := '1'+Copy(DefaultGateway, Pos('.', DefaultGateway), 255);
|
---|
705 | DefaultGateway := ReverseString(DefaultGateway);
|
---|
706 |
|
---|
707 | //DefaultGateway := GetDefaultGateway;
|
---|
708 | if AutoDial then Dial;
|
---|
709 | end;
|
---|
710 |
|
---|
711 | procedure TMainForm.Timer2Timer(Sender: TObject);
|
---|
712 | begin
|
---|
713 | MagRasCon1.CurrentStatusEx(DialHandle, 0);
|
---|
714 | end;
|
---|
715 |
|
---|
716 | function GetIPFromHost(var HostName, IPaddr, WSAErr: string): Boolean;
|
---|
717 | type
|
---|
718 | Name = array[0..100] of Char;
|
---|
719 | PName = ^Name;
|
---|
720 | var
|
---|
721 | HEnt: pHostEnt;
|
---|
722 | HName: PName;
|
---|
723 | WSAData: TWSAData;
|
---|
724 | i: Integer;
|
---|
725 | begin
|
---|
726 | Result := False;
|
---|
727 | if WSAStartup($0101, WSAData) <> 0 then begin
|
---|
728 | WSAErr := 'Winsock is not responding."';
|
---|
729 | Exit;
|
---|
730 | end;
|
---|
731 | IPaddr := '';
|
---|
732 | New(HName);
|
---|
733 | if GetHostName(HName^, SizeOf(Name)) = 0 then
|
---|
734 | begin
|
---|
735 | HostName := StrPas(HName^);
|
---|
736 | HEnt := GetHostByName(HName^);
|
---|
737 | for i := 0 to HEnt^.h_length - 1 do
|
---|
738 | IPaddr :=
|
---|
739 | Concat(IPaddr,
|
---|
740 | IntToStr(Ord(HEnt^.h_addr_list^[i])) + '.');
|
---|
741 | SetLength(IPaddr, Length(IPaddr) - 1);
|
---|
742 | Result := True;
|
---|
743 | end
|
---|
744 | else begin
|
---|
745 | case WSAGetLastError of
|
---|
746 | WSANOTINITIALISED:WSAErr:='WSANotInitialised';
|
---|
747 | WSAENETDOWN :WSAErr:='WSAENetDown';
|
---|
748 | WSAEINPROGRESS :WSAErr:='WSAEInProgress';
|
---|
749 | end;
|
---|
750 | end;
|
---|
751 | Dispose(HName);
|
---|
752 | WSACleanup;
|
---|
753 | end;
|
---|
754 |
|
---|
755 | procedure TMainForm.DialLog(Message: string);
|
---|
756 | var
|
---|
757 | LogFile: TTextFileStream;
|
---|
758 | begin
|
---|
759 | if Assigned(DialingLog) then DialingLog.Memo1.Lines.Add(Message);
|
---|
760 |
|
---|
761 | if LogFileEnabled then
|
---|
762 | try
|
---|
763 | if FileExists(LogFileName) then LogFile := TTextFileStream.Create(LogFileName, fmOpenReadWrite)
|
---|
764 | else LogFile := TTextFileStream.Create(LogFileName, fmCreate);
|
---|
765 | LogFile.Seek(0, soFromEnd);
|
---|
766 | LogFile.WriteLn(Message);
|
---|
767 | finally
|
---|
768 | LogFile.Free;
|
---|
769 | end;
|
---|
770 | end;
|
---|
771 |
|
---|
772 | procedure TMainForm.Button4Click(Sender: TObject);
|
---|
773 | begin
|
---|
774 | OpenDialog1.FileName := Edit1.Text;
|
---|
775 | if OpenDialog1.Execute then begin
|
---|
776 | Edit1.Text := OpenDialog1.FileName;
|
---|
777 | end;
|
---|
778 | end;
|
---|
779 |
|
---|
780 | procedure TMainForm.CheckBox10Click(Sender: TObject);
|
---|
781 | begin
|
---|
782 | Edit1.Enabled := CheckBox10.Checked;
|
---|
783 | Button4.Enabled := CheckBox10.Checked;
|
---|
784 | end;
|
---|
785 |
|
---|
786 | end.
|
---|