- Timestamp:
- Nov 27, 2008, 12:16:27 PM (16 years ago)
- Location:
- trunk
- Files:
-
- 1 added
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/KonfiguratorZdechovNET.dpr
r2 r3 10 10 ULogExceptions in 'ULogExceptions.pas' {LogExceptions}, 11 11 UMapFile in 'UMapFile.pas', 12 UDialingLog in 'UDialingLog.pas' {DialingLog}; 12 UDialingLog in 'UDialingLog.pas' {DialingLog}, 13 UTextFileStream in 'UTextFileStream.pas'; 13 14 14 15 {$R *.res} -
trunk/MainWindow.dfm
r2 r3 2 2 Left = 586 3 3 Top = 285 4 Width = 35 05 Height = 3594 Width = 351 5 Height = 400 6 6 Caption = 'Nastaven'#237 7 7 Color = clBtnFace … … 19 19 OnShow = FormShow 20 20 DesignSize = ( 21 34 222 3 25)21 343 22 366) 23 23 PixelsPerInch = 96 24 24 TextHeight = 13 25 25 object Bevel1: TBevel 26 26 Left = 8 27 Top = 28228 Width = 32 827 Top = 323 28 Width = 329 29 29 Height = 2 30 30 Anchors = [akLeft, akRight, akBottom] 31 31 end 32 32 object Button1: TButton 33 Left = 26 334 Top = 29033 Left = 264 34 Top = 331 35 35 Width = 75 36 36 Height = 25 … … 41 41 end 42 42 object Button2: TButton 43 Left = 18 344 Top = 29043 Left = 184 44 Top = 331 45 45 Width = 75 46 46 Height = 25 … … 53 53 Left = 8 54 54 Top = 80 55 Width = 32 855 Width = 329 56 56 Height = 121 57 57 Anchors = [akLeft, akTop, akRight] … … 120 120 object CheckBox3: TCheckBox 121 121 Left = 8 122 Top = 2 58122 Top = 299 123 123 Width = 161 124 124 Height = 17 … … 137 137 object Button3: TButton 138 138 Left = 8 139 Top = 290139 Top = 331 140 140 Width = 129 141 141 Height = 25 … … 168 168 Caption = 'Vytvo'#345'it sd'#237'lenou slo'#382'ku C:\Net pro z'#225'pis' 169 169 TabOrder = 8 170 end 171 object GroupBox2: TGroupBox 172 Left = 8 173 Top = 208 174 Width = 329 175 Height = 84 176 Anchors = [akLeft, akTop, akRight] 177 Caption = 'Z'#225'znam vyt'#225#269'en'#237 178 TabOrder = 9 179 DesignSize = ( 180 329 181 84) 182 object Label3: TLabel 183 Left = 8 184 Top = 36 185 Width = 82 186 Height = 13 187 Caption = 'Cesta k souboru:' 188 end 189 object CheckBox10: TCheckBox 190 Left = 8 191 Top = 16 192 Width = 233 193 Height = 17 194 Caption = 'Zaznamen'#225'vat lad'#237'c'#237' informace do souboru' 195 TabOrder = 0 196 OnClick = CheckBox10Click 197 end 198 object Edit1: TEdit 199 Left = 8 200 Top = 52 201 Width = 241 202 Height = 21 203 Anchors = [akLeft, akTop, akRight] 204 TabOrder = 1 205 end 206 object Button4: TButton 207 Left = 259 208 Top = 50 209 Width = 62 210 Height = 25 211 Anchors = [akTop, akRight] 212 Caption = 'Vybrat...' 213 TabOrder = 2 214 OnClick = Button4Click 215 end 170 216 end 171 217 object CoolTrayIcon1: TCoolTrayIcon … … 370 416 end 371 417 object MagRasCon1: TMagRasCon 372 SubEntry = 1418 SubEntry = 0 373 419 CallbackId = 0 374 420 CountryID = 0 … … 462 508 Top = 16 463 509 end 510 object OpenDialog1: TOpenDialog 511 Title = 'Vyberte soubor' 512 Left = 264 513 Top = 16 514 end 464 515 end -
trunk/MainWindow.pas
r2 r3 7 7 Dialogs, StdCtrls, ComCtrls, ShellApi, DosCommand, Registry, Menus, 8 8 CoolTrayIcon, ExtCtrls, XPMan, magrascon, magrasedt, magrasent, SHFolder, 9 ShlObj, magrasapi, Winsock ;9 ShlObj, magrasapi, Winsock, UTextFileStream; 10 10 11 11 const … … 14 14 HomePage = 'http://www.zdechov.net/'; 15 15 Email = 'robie@centrum.cz'; 16 Version = '1. 1';17 ReleaseDate = ' 24.8.2006';16 Version = '1.2'; 17 ReleaseDate = '4.9.2006'; 18 18 Creator = 'Chronosoft'; 19 19 RegistryRootKey = HKEY_LOCAL_MACHINE; … … 21 21 ChangeLogFile = 'Novinky.txt'; 22 22 Licence = 'Copyleft'; 23 24 DefaultLogFileName = 'DialLog.txt'; 23 25 24 26 BrowserHomepage = 'http://centrala.zdechov.net/'; … … 62 64 Timer2: TTimer; 63 65 Label2: TLabel; 66 OpenDialog1: TOpenDialog; 67 GroupBox2: TGroupBox; 68 CheckBox10: TCheckBox; 69 Label3: TLabel; 70 Edit1: TEdit; 71 Button4: TButton; 64 72 procedure FormShow(Sender: TObject); 65 73 procedure Button2Click(Sender: TObject); … … 76 84 procedure MagRasCon1StateChanged(Sender: TObject); 77 85 procedure Timer2Timer(Sender: TObject); 86 procedure Button4Click(Sender: TObject); 87 procedure CheckBox10Click(Sender: TObject); 78 88 private 79 89 Connecting: Boolean; … … 93 103 function GetNetSharedFolder: Boolean; 94 104 procedure SetNetSharedFolder(const Value: Boolean); 95 function GetDefaultGateway: string;96 105 public 97 106 DefaultGateway: string; 107 LogFileName: string; 98 108 FirstStart: Boolean; 99 109 LastState: Word; … … 104 114 ConnectionName: string; 105 115 NetworkTestLastUpdate: TDateTime; 116 LogFileEnabled: Boolean; 106 117 property LocalNetworkRouting: Boolean read GetLocalNetworkRouting 107 118 write SetLocalNetworkRouting; … … 122 133 procedure AddConnection; 123 134 procedure DeleteConnection; 135 procedure DialLog(Message: string); 124 136 end; 125 137 … … 181 193 Buffer : Pointer; var ParamError :DWord) : Longint; stdcall; external 'netapi32.dll'; 182 194 195 183 196 function CommonAppDataPath: string; 184 197 const … … 190 203 SHGetFolderPath(0, CSIDL_COMMON_APPDATA, 0, SHGFP_TYPE_CURRENT, @Path[0]); 191 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); 192 212 end; 193 213 … … 290 310 ComboBox1.ItemIndex := ComboBox1.Items.IndexOf(ConnectionName); 291 311 312 CheckBox10.Checked := LogFileEnabled; 313 Edit1.Text := LogFileName; 314 Edit1.Enabled := LogFileEnabled; 315 Button4.Enabled := LogFileEnabled; 316 292 317 Label2.Caption := 'Brána: ' + DefaultGateway; 293 318 end; … … 309 334 ZdechovNetConnection := CheckBox8.Checked; 310 335 NetSharedFolder := CheckBox9.Checked; 336 LogFileEnabled := CheckBox10.Checked; 337 LogFileName := Edit1.Text; 311 338 312 339 ConnectionName := ComboBox1.Items.Strings[ComboBox1.ItemIndex]; 313 340 CoolTrayIcon1.HideMainForm; 314 end;315 316 function TMainForm.GetDefaultGateway: string;317 var318 Command: TDosCommand;319 I: Integer;320 Lines2: TStringList;321 begin322 Lines2 := TStringList.Create;323 Result := '';324 Command := TDosCommand.Create(nil);325 with Command do try326 CommandLine := 'route print';327 OutputLines := Lines2;328 Execute2;329 for I := 0 to Lines2.Count - 1 do330 if Pos('choz', Lines2[I]) > 0 then331 Result := Trim(Copy(Lines2[I], 15, 256));332 finally333 Free;334 Lines2.Free;335 end;336 341 end; 337 342 … … 425 430 if ValueExists('PingTimeout') then PingTimeout := ReadInteger('PingTimeout') 426 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; 427 436 finally 428 437 Free; … … 481 490 MagRasCon1.DisconnectEx(DialHandle, 0, 3000, False); 482 491 483 DialingLog.Memo1.Lines.Add('');484 DialingLog.Memo1.Lines.Add(DateTimeToStr(Now) + ': Vytáèím pøípojení');492 if Assigned(DialingLog) then DialLog(''); 493 if Assigned(DialingLog) then DialLog(DateTimeToStr(Now) + ': Vytáèím pøípojení'); 485 494 with MagRasCon1 do begin 486 495 GetConnections; … … 491 500 PhoneNumber := ''; 492 501 DialHandle := 0; 493 AutoConnectEx(DialHandle); 502 if AutoConnectEx(DialHandle) <> 0 then 503 if Assigned(DialingLog) then DialLog('Dialling Failed - ' + MagRasCon1.StatusStr); 494 504 end; 495 505 end; … … 516 526 WriteString('NetworkTestLastUpdate', DateToStr(NetworkTestLastUpdate)); 517 527 WriteInteger('PingTimeout', PingTimeout); 528 WriteBool('LogFileEnabled', LogFileEnabled); 529 WriteString('LogFileName', LogFileName); 518 530 finally 519 531 Free; … … 541 553 bRequireMSEncryptedPassword := False; 542 554 bSoftwareCompression := True; 555 bCustom := True; 543 556 544 557 // device stuff … … 655 668 // see if new event, else display it 656 669 LastState := MagRasCon1.ConnectState ; 657 DialingLog.Memo1.Lines.Add(Info + MagRasCon1.StatusStr670 if Assigned(DialingLog) then DialLog(Info + MagRasCon1.StatusStr 658 671 + ' (' + IntToStr(LastState) + ')'); 659 672 … … 740 753 end; 741 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 742 786 end. -
trunk/UDialingLog.dfm
r2 r3 1 1 object DialingLog: TDialingLog 2 Left = 2783 Top = 1 354 Width = 4 425 Height = 4082 Left = 396 3 Top = 196 4 Width = 410 5 Height = 397 6 6 Caption = 'Z'#225'znam vyt'#225#269'en'#237 7 7 Color = clBtnFace … … 13 13 OldCreateOrder = False 14 14 DesignSize = ( 15 4 3416 3 74)15 402 16 363) 17 17 PixelsPerInch = 96 18 18 TextHeight = 13 … … 20 20 Left = 8 21 21 Top = 8 22 Width = 41923 Height = 3 5922 Width = 387 23 Height = 345 24 24 Anchors = [akLeft, akTop, akRight, akBottom] 25 25 ReadOnly = True -
trunk/UNetworkTest.pas
r1 r3 69 69 70 70 procedure TNetworkTest.FormCreate(Sender: TObject); 71 72 71 var 73 72 Soubor: TextFile; 74 73 Row: string; 74 Hostname: string; 75 LocalIp: string; 76 WSAErr: string; 75 77 76 78 function Parse: string; … … 90 92 91 93 begin 94 PingList := TPingList.Create(True); 95 ChDir(ExtractFileDir(Application.ExeName)); 96 97 HostName := 'default'; 98 GetIPFromHost(Hostname, LocalIp, WSAErr); 99 if LocalIp <> '127.0.0.1' then 100 // Update list from internet 101 if (Trunc(Now) <> Trunc(MainForm.NetworkTestLastUpdate)) or 102 (not FileExists(NetworkListFilename)) then try 103 Row := IdHTTP1.Get(NetworkListURL); 104 AssignFile(Soubor, NetworkListFilename); 105 Rewrite(Soubor); 106 Write(Soubor, Row); 107 CloseFile(Soubor); 108 finally 109 end; 110 111 // Load from file 92 112 try 93 PingList := TPingList.Create(True);94 ChDir(ExtractFileDir(Application.ExeName));95 96 // Update list from internet97 if (Trunc(Now) <> Trunc(MainForm.NetworkTestLastUpdate)) or98 (not FileExists(NetworkListFilename)) then try99 Row := IdHTTP1.Get(NetworkListURL);100 AssignFile(Soubor, NetworkListFilename);101 Rewrite(Soubor);102 Write(Soubor, Row);103 finally104 CloseFile(Soubor);105 end;106 107 // Load from file108 113 AssignFile(Soubor, NetworkListFilename); 109 114 Reset(Soubor);
Note:
See TracChangeset
for help on using the changeset viewer.