Changeset 3


Ignore:
Timestamp:
Nov 27, 2008, 12:16:27 PM (15 years ago)
Author:
george
Message:
  • Upraveno: Verze 1.2.
Location:
trunk
Files:
1 added
5 edited

Legend:

Unmodified
Added
Removed

  • trunk/KonfiguratorZdechovNET.dpr

    r2 r3  
    1010  ULogExceptions in 'ULogExceptions.pas' {LogExceptions},
    1111  UMapFile in 'UMapFile.pas',
    12   UDialingLog in 'UDialingLog.pas' {DialingLog};
     12  UDialingLog in 'UDialingLog.pas' {DialingLog},
     13  UTextFileStream in 'UTextFileStream.pas';
    1314
    1415{$R *.res}

  • trunk/MainWindow.dfm

    r2 r3  
    22  Left = 586
    33  Top = 285
    4   Width = 350
    5   Height = 359
     4  Width = 351
     5  Height = 400
    66  Caption = 'Nastaven'#237
    77  Color = clBtnFace
    … …  
    1919  OnShow = FormShow
    2020  DesignSize = (
    21     342
    22     325)
     21    343
     22    366)
    2323  PixelsPerInch = 96
    2424  TextHeight = 13
    2525  object Bevel1: TBevel
    2626    Left = 8
    27     Top = 282
    28     Width = 328
     27    Top = 323
     28    Width = 329
    2929    Height = 2
    3030    Anchors = [akLeft, akRight, akBottom]
    3131  end
    3232  object Button1: TButton
    33     Left = 263
    34     Top = 290
     33    Left = 264
     34    Top = 331
    3535    Width = 75
    3636    Height = 25
    … …  
    4141  end
    4242  object Button2: TButton
    43     Left = 183
    44     Top = 290
     43    Left = 184
     44    Top = 331
    4545    Width = 75
    4646    Height = 25
    … …  
    5353    Left = 8
    5454    Top = 80
    55     Width = 328
     55    Width = 329
    5656    Height = 121
    5757    Anchors = [akLeft, akTop, akRight]
    … …  
    120120  object CheckBox3: TCheckBox
    121121    Left = 8
    122     Top = 258
     122    Top = 299
    123123    Width = 161
    124124    Height = 17
    … …  
    137137  object Button3: TButton
    138138    Left = 8
    139     Top = 290
     139    Top = 331
    140140    Width = 129
    141141    Height = 25
    … …  
    168168    Caption = 'Vytvo'#345'it sd'#237'lenou slo'#382'ku C:\Net pro z'#225'pis'
    169169    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
    170216  end
    171217  object CoolTrayIcon1: TCoolTrayIcon
    … …  
    370416  end
    371417  object MagRasCon1: TMagRasCon
    372     SubEntry = 1
     418    SubEntry = 0
    373419    CallbackId = 0
    374420    CountryID = 0
    … …  
    462508    Top = 16
    463509  end
     510  object OpenDialog1: TOpenDialog
     511    Title = 'Vyberte soubor'
     512    Left = 264
     513    Top = 16
     514  end
    464515end

  • trunk/MainWindow.pas

    r2 r3  
    77  Dialogs, StdCtrls, ComCtrls, ShellApi, DosCommand, Registry, Menus,
    88  CoolTrayIcon, ExtCtrls, XPMan, magrascon, magrasedt, magrasent, SHFolder,
    9   ShlObj, magrasapi, Winsock;
     9  ShlObj, magrasapi, Winsock, UTextFileStream;
    1010
    1111const
    … …  
    1414  HomePage = 'http://www.zdechov.net/';
    1515  Email = 'robie@centrum.cz';
    16   Version = '1.1';
    17   ReleaseDate = '24.8.2006';
     16  Version = '1.2';
     17  ReleaseDate = '4.9.2006';
    1818  Creator = 'Chronosoft';
    1919  RegistryRootKey = HKEY_LOCAL_MACHINE;
    … …  
    2121  ChangeLogFile = 'Novinky.txt';
    2222  Licence = 'Copyleft';
     23
     24  DefaultLogFileName = 'DialLog.txt';
    2325
    2426  BrowserHomepage = 'http://centrala.zdechov.net/';
    … …  
    6264    Timer2: TTimer;
    6365    Label2: TLabel;
     66    OpenDialog1: TOpenDialog;
     67    GroupBox2: TGroupBox;
     68    CheckBox10: TCheckBox;
     69    Label3: TLabel;
     70    Edit1: TEdit;
     71    Button4: TButton;
    6472    procedure FormShow(Sender: TObject);
    6573    procedure Button2Click(Sender: TObject);
    … …  
    7684    procedure MagRasCon1StateChanged(Sender: TObject);
    7785    procedure Timer2Timer(Sender: TObject);
     86    procedure Button4Click(Sender: TObject);
     87    procedure CheckBox10Click(Sender: TObject);
    7888  private
    7989    Connecting: Boolean;
    … …  
    93103    function GetNetSharedFolder: Boolean;
    94104    procedure SetNetSharedFolder(const Value: Boolean);
    95     function GetDefaultGateway: string;
    96105  public
    97106    DefaultGateway: string;
     107    LogFileName: string;
    98108    FirstStart: Boolean;
    99109    LastState: Word;
    … …  
    104114    ConnectionName: string;
    105115    NetworkTestLastUpdate: TDateTime;
     116    LogFileEnabled: Boolean;
    106117    property LocalNetworkRouting: Boolean read GetLocalNetworkRouting
    107118      write SetLocalNetworkRouting;
    … …  
    122133    procedure AddConnection;
    123134    procedure DeleteConnection;
     135    procedure DialLog(Message: string);
    124136  end;
    125137
    … …  
    181193  Buffer : Pointer; var ParamError :DWord) : Longint; stdcall; external 'netapi32.dll';
    182194
     195
    183196function CommonAppDataPath: string;
    184197const
    … …  
    190203  SHGetFolderPath(0, CSIDL_COMMON_APPDATA, 0, SHGFP_TYPE_CURRENT, @Path[0]);
    191204  Result := Path;
     205end;
     206
     207function ApplicationDataFolder: string;
     208begin
     209  Result := CommonAppDataPath + '\' + Creator + '\' + ApplicationName;
     210  if not DirectoryExists(Result) then
     211    ForceDirectories(Result);
    192212end;
    193213
    … …  
    290310  ComboBox1.ItemIndex := ComboBox1.Items.IndexOf(ConnectionName);
    291311
     312  CheckBox10.Checked := LogFileEnabled;
     313  Edit1.Text := LogFileName;
     314  Edit1.Enabled := LogFileEnabled;
     315  Button4.Enabled := LogFileEnabled;
     316
    292317  Label2.Caption := 'Brána: ' + DefaultGateway;
    293318end;
    … …  
    309334  ZdechovNetConnection := CheckBox8.Checked;
    310335  NetSharedFolder := CheckBox9.Checked;
     336  LogFileEnabled := CheckBox10.Checked;
     337  LogFileName := Edit1.Text;
    311338
    312339  ConnectionName := ComboBox1.Items.Strings[ComboBox1.ItemIndex];
    313340  CoolTrayIcon1.HideMainForm;
    314 end;
    315 
    316 function TMainForm.GetDefaultGateway: string;
    317 var
    318   Command: TDosCommand;
    319   I: Integer;
    320   Lines2: TStringList;
    321 begin
    322   Lines2 := TStringList.Create;
    323   Result := '';
    324   Command := TDosCommand.Create(nil);
    325   with Command do try
    326     CommandLine := 'route print';
    327     OutputLines := Lines2;
    328     Execute2;
    329     for I := 0 to Lines2.Count - 1 do
    330       if Pos('choz', Lines2[I]) > 0 then
    331         Result := Trim(Copy(Lines2[I], 15, 256));
    332   finally
    333     Free;
    334     Lines2.Free;
    335   end;
    336341end;
    337342
    … …  
    425430      if ValueExists('PingTimeout') then PingTimeout := ReadInteger('PingTimeout')
    426431        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;
    427436    finally
    428437      Free;
    … …  
    481490      MagRasCon1.DisconnectEx(DialHandle, 0, 3000, False);
    482491
    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í');
    485494        with MagRasCon1 do begin
    486495      GetConnections;
    … …  
    491500              PhoneNumber :=    '';
    492501            DialHandle := 0;
    493         AutoConnectEx(DialHandle);
     502        if AutoConnectEx(DialHandle) <> 0 then
     503          if Assigned(DialingLog) then DialLog('Dialling Failed - ' + MagRasCon1.StatusStr);
    494504      end;
    495505    end;
    … …  
    516526      WriteString('NetworkTestLastUpdate', DateToStr(NetworkTestLastUpdate));
    517527      WriteInteger('PingTimeout', PingTimeout);
     528      WriteBool('LogFileEnabled', LogFileEnabled);
     529      WriteString('LogFileName', LogFileName);
    518530    finally
    519531      Free;
    … …  
    541553    bRequireMSEncryptedPassword := False;
    542554    bSoftwareCompression := True;
     555    bCustom := True;
    543556
    544557    // device stuff
    … …  
    655668  // see if new event, else display it
    656669  LastState := MagRasCon1.ConnectState ;
    657   DialingLog.Memo1.Lines.Add (Info + MagRasCon1.StatusStr
     670  if Assigned(DialingLog) then DialLog(Info + MagRasCon1.StatusStr
    658671    +   ' (' + IntToStr(LastState) + ')');
    659672
    … …  
    740753end;
    741754
     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
    742786end.

  • trunk/UDialingLog.dfm

    r2 r3  
    11object DialingLog: TDialingLog
    2   Left = 278
    3   Top = 135
    4   Width = 442
    5   Height = 408
     2  Left = 396
     3  Top = 196
     4  Width = 410
     5  Height = 397
    66  Caption = 'Z'#225'znam vyt'#225#269'en'#237
    77  Color = clBtnFace
    … …  
    1313  OldCreateOrder = False
    1414  DesignSize = (
    15     434
    16     374)
     15    402
     16    363)
    1717  PixelsPerInch = 96
    1818  TextHeight = 13
    … …  
    2020    Left = 8
    2121    Top = 8
    22     Width = 419
    23     Height = 359
     22    Width = 387
     23    Height = 345
    2424    Anchors = [akLeft, akTop, akRight, akBottom]
    2525    ReadOnly = True

  • trunk/UNetworkTest.pas

    r1 r3  
    6969
    7070procedure TNetworkTest.FormCreate(Sender: TObject);
    71 
    7271var
    7372  Soubor: TextFile;
    7473  Row: string;
     74  Hostname: string;
     75  LocalIp: string;
     76  WSAErr: string;
    7577
    7678function Parse: string;
    … …  
    9092
    9193begin
     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
    92112  try
    93     PingList := TPingList.Create(True);
    94     ChDir(ExtractFileDir(Application.ExeName));
    95 
    96     // Update list from internet
    97     if (Trunc(Now) <> Trunc(MainForm.NetworkTestLastUpdate)) or
    98     (not FileExists(NetworkListFilename)) then try
    99        Row := IdHTTP1.Get(NetworkListURL);
    100        AssignFile(Soubor, NetworkListFilename);
    101        Rewrite(Soubor);
    102        Write(Soubor, Row);
    103      finally
    104        CloseFile(Soubor);
    105      end;
    106 
    107     // Load from file
    108113    AssignFile(Soubor, NetworkListFilename);
    109114    Reset(Soubor);
Note: See TracChangeset for help on using the changeset viewer.