source: trunk/MainWindow.pas

Last change on this file was 3, checked in by george, 15 years ago
  • Upraveno: Verze 1.2.
File size: 23.3 KB
Line 
1unit MainWindow;
2
3interface
4
5uses
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
11const
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
35type
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
138var
139 MainForm: TMainForm;
140
141function GetIPFromHost(var HostName, IPaddr, WSAErr: string): Boolean;
142function GetComputerNetName: string;
143function CommonAppDataPath: string;
144procedure ShellLaunch(const S: String);
145
146implementation
147
148uses UNetworkTest, UAboutWindow, ULogExceptions, DateUtils, Math,
149 UDialingLog, StrUtils;
150
151{$R *.dfm}
152
153const
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
174type
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
187procedure NetApiBufferFree(Buf: Pointer) stdcall; external 'netapi32.dll';
188function NetShareGetInfo(SeverName, NetName: PWideChar; Level: DWORD;
189 Buf: Pointer): LongInt; stdcall; external 'netapi32.dll';
190function NetShareDel(ServerName, ShareName : PWideChar; Reserved: DWord):
191 LongInt; stdcall; external 'netapi32.dll';
192function NetShareAdd(ServerName : PWideChar; Level : DWord;
193 Buffer : Pointer; var ParamError :DWord) : Longint; stdcall; external 'netapi32.dll';
194
195
196function CommonAppDataPath: string;
197const
198 SHGFP_TYPE_CURRENT = 0;
199 MAXPATH = 255;
200var
201 Path: array [0..MAXPATH] of Char;
202begin
203 SHGetFolderPath(0, CSIDL_COMMON_APPDATA, 0, SHGFP_TYPE_CURRENT, @Path[0]);
204 Result := Path;
205end;
206
207function ApplicationDataFolder: string;
208begin
209 Result := CommonAppDataPath + '\' + Creator + '\' + ApplicationName;
210 if not DirectoryExists(Result) then
211 ForceDirectories(Result);
212end;
213
214procedure ShellLaunch(const S: String);
215begin
216 ShellExecute(0, 'open', PChar(S), '', '', SW_SHOWNORMAL);
217end;
218
219function GetComputerNetName: string;
220var
221 buffer: array[0..255] of char;
222 size: dword;
223begin
224 size := 256;
225 if GetComputerName(buffer, size) then
226 Result := buffer
227 else
228 Result := ''
229end;
230
231function TMainForm.GetLocalNetworkRouting: Boolean;
232var
233 Command: TDosCommand;
234 I: Integer;
235 Lines2: TStringList;
236begin
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;
251end;
252
253procedure TMainForm.SetLocalNetworkRouting(const Value: Boolean);
254var
255 Command: TDosCommand;
256begin
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;
265end;
266
267function TMainForm.GetCentralaHomepage: Boolean;
268begin
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;
277end;
278
279procedure TMainForm.SetCentralaHomepage(const Value: Boolean);
280begin
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;
292end;
293
294procedure TMainForm.FormShow(Sender: TObject);
295begin
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;
318end;
319
320procedure TMainForm.Button2Click(Sender: TObject);
321begin
322 CoolTrayIcon1.HideMainForm;
323end;
324
325procedure TMainForm.Button1Click(Sender: TObject);
326begin
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;
341end;
342
343function TMainForm.GetWorkgroupZdechov: Boolean;
344var
345 Command: TDosCommand;
346 I: Integer;
347 Lines2: TStringList;
348begin
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;
362end;
363
364procedure TMainForm.SetWorkgroupZdechov(const Value: Boolean);
365var
366 Command: TDosCommand;
367begin
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;
375end;
376
377procedure TMainForm.estst1Click(Sender: TObject);
378begin
379 NetworkTest.Show;
380end;
381
382procedure TMainForm.Ukonit1Click(Sender: TObject);
383begin
384 Close;
385end;
386
387function TMainForm.GetRunOnSystemStart: Boolean;
388begin
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;
397end;
398
399procedure TMainForm.SetRunOnSystemStart(const Value: Boolean);
400begin
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;
410end;
411
412procedure TMainForm.FormCreate(Sender: TObject);
413begin
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
441end;
442
443procedure TMainForm.Nastaven1Click(Sender: TObject);
444begin
445 CoolTrayIcon1.ShowMainForm;
446end;
447
448function TMainForm.GetShareUnblockFirewall: Boolean;
449begin
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;
461end;
462
463procedure TMainForm.SetShareUnblockFirewall(const Value: Boolean);
464begin
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;
483end;
484
485procedure TMainForm.Dial;
486var
487 I: Integer;
488begin
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;
506end;
507
508procedure TMainForm.Timer1Timer(Sender: TObject);
509begin
510 if MagRasCon1.ConnectState <> RASCS_Connected then begin
511 Timer1.Enabled := False;
512 Dial;
513 end;
514end;
515
516procedure TMainForm.FormDestroy(Sender: TObject);
517begin
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;
533end;
534
535procedure TMainForm.AddConnection;
536var
537 I: Integer;
538begin
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;
567end;
568
569function TMainForm.GetZdechovNetConnection: Boolean;
570var
571 I: Integer;
572begin
573 MagRasGetEntryList('');
574 I := 0;
575 while (I < MagRasNumEntryRec) and
576 (MagRasEntryRecs[I].EntryName <> DefaultConnectionName) do I := I + 1;
577 Result := I < MagRasNumEntryRec;
578end;
579
580procedure TMainForm.SetZdechovNetConnection(const Value: Boolean);
581begin
582 if Value then AddConnection else DeleteConnection;
583end;
584
585procedure TMainForm.DeleteConnection;
586begin
587 with MagRasCon1 do begin
588 EntryName := DefaultConnectionName;
589 DeletePhonebook;
590 end;
591end;
592
593procedure TMainForm.Button3Click(Sender: TObject);
594begin
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);
605end;
606
607procedure TMainForm.Oprogramu1Click(Sender: TObject);
608begin
609 AboutWindow.ShowModal;
610end;
611
612function TMainForm.GetNetSharedFolder: Boolean;
613var
614 PShareInfo: PShareInfo2;
615begin
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;
622end;
623
624procedure TMainForm.SetNetSharedFolder(const Value: Boolean);
625var
626 Err: Cardinal;
627 ShareInfo: TShareInfo2;
628begin
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;
644end;
645
646procedure TMainForm.Zznamvyten1Click(Sender: TObject);
647begin
648 if not DialingLog.Visible then DialingLog.ShowModal;
649end;
650
651procedure TMainForm.MagRasCon1StateChanged(Sender: TObject);
652var
653 Info: string;
654begin
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;
694end;
695
696procedure TMainForm.Init;
697var
698 WSAErr: string;
699 Hostname: string;
700begin
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;
709end;
710
711procedure TMainForm.Timer2Timer(Sender: TObject);
712begin
713 MagRasCon1.CurrentStatusEx(DialHandle, 0);
714end;
715
716function GetIPFromHost(var HostName, IPaddr, WSAErr: string): Boolean;
717type
718 Name = array[0..100] of Char;
719 PName = ^Name;
720var
721 HEnt: pHostEnt;
722 HName: PName;
723 WSAData: TWSAData;
724 i: Integer;
725begin
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;
753end;
754
755procedure TMainForm.DialLog(Message: string);
756var
757 LogFile: TTextFileStream;
758begin
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;
770end;
771
772procedure TMainForm.Button4Click(Sender: TObject);
773begin
774 OpenDialog1.FileName := Edit1.Text;
775 if OpenDialog1.Execute then begin
776 Edit1.Text := OpenDialog1.FileName;
777 end;
778end;
779
780procedure TMainForm.CheckBox10Click(Sender: TObject);
781begin
782 Edit1.Enabled := CheckBox10.Checked;
783 Button4.Enabled := CheckBox10.Checked;
784end;
785
786end.
Note: See TracBrowser for help on using the repository browser.