Changeset 2 for trunk/MainWindow.pas


Ignore:
Timestamp:
Nov 27, 2008, 12:15:06 PM (16 years ago)
Author:
george
Message:
  • Upraveno: Verze 1.1.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/MainWindow.pas

    r1 r2  
    77  Dialogs, StdCtrls, ComCtrls, ShellApi, DosCommand, Registry, Menus,
    88  CoolTrayIcon, ExtCtrls, XPMan, magrascon, magrasedt, magrasent, SHFolder,
    9   ShlObj;
     9  ShlObj, magrasapi, Winsock;
    1010
    1111const
    … …  
    1414  HomePage = 'http://www.zdechov.net/';
    1515  Email = 'robie@centrum.cz';
    16   Version = '1.0';
    17   ReleaseDate = '13.8.2006';
     16  Version = '1.1';
     17  ReleaseDate = '24.8.2006';
    1818  Creator = 'Chronosoft';
    1919  RegistryRootKey = HKEY_LOCAL_MACHINE;
    … …  
    2828  MainSharedFolderPath = 'C:\Net';
    2929  MainSharedFolderName = 'Net';
     30  LocalNetAddr = '192.168.0.0';
     31  LocalNetMask = '255.255.0.0';
    3032
    3133type
    … …  
    5759    Oprogramu1: TMenuItem;
    5860    CheckBox9: TCheckBox;
     61    Zznamvyten1: TMenuItem;
     62    Timer2: TTimer;
     63    Label2: TLabel;
    5964    procedure FormShow(Sender: TObject);
    6065    procedure Button2Click(Sender: TObject);
    … …  
    6873    procedure Button3Click(Sender: TObject);
    6974    procedure Oprogramu1Click(Sender: TObject);
     75    procedure Zznamvyten1Click(Sender: TObject);
     76    procedure MagRasCon1StateChanged(Sender: TObject);
     77    procedure Timer2Timer(Sender: TObject);
    7078  private
     79    Connecting: Boolean;
    7180    DialHandle: Cardinal;
    7281    function GetLocalNetworkRouting: Boolean;
    … …  
    8493    function GetNetSharedFolder: Boolean;
    8594    procedure SetNetSharedFolder(const Value: Boolean);
     95    function GetDefaultGateway: string;
    8696  public
     97    DefaultGateway: string;
     98    FirstStart: Boolean;
     99    LastState: Word;
    87100    HostFilterIndex: Integer;
    88101    PingTimeout: Integer;
    … …  
    105118    property NetSharedFolder: Boolean read GetNetSharedFolder
    106119      write SetNetSharedFolder;
     120    procedure Init;
    107121    procedure Dial;
    108122    procedure AddConnection;
    … …  
    113127  MainForm: TMainForm;
    114128
     129function GetIPFromHost(var HostName, IPaddr, WSAErr: string): Boolean;
    115130function GetComputerNetName: string;
    116131function CommonAppDataPath: string;
    … …  
    119134implementation
    120135
    121 uses UNetworkTest, UAboutWindow, ULogExceptions, DateUtils, Math;
     136uses UNetworkTest, UAboutWindow, ULogExceptions, DateUtils, Math,
     137  UDialingLog, StrUtils;
    122138
    123139{$R *.dfm}
    … …  
    203219  Command := TDosCommand.Create(nil);
    204220  with Command do try
    205     CommandLine := 'route print 192.168.0.0 mask 255.255.0.0 192.168.0.1 metric 30';
     221    CommandLine := 'route print ' + LocalNetAddr + ' mask ' + LocalNetMask +
     222      ' ' + DefaultGateway + ' metric 30';
    206223    OutputLines := Lines2;
    207224    Execute2;
    208225    for I := 0 to Lines2.Count - 1 do
    209       if Pos('255.255.0.0', Lines2[I]) > 0 then Result := True;
     226      if Pos(LocalNetMask, Lines2[I]) > 0 then Result := True;
    210227  finally
    211228    Free;
    … …  
    220237  Command := TDosCommand.Create(nil);
    221238  with Command do try
    222     if Value then CommandLine := 'route -p add 192.168.0.0 mask 255.255.0.0 192.168.0.1 metric 30'
    223       else CommandLine := 'route delete 192.168.0.0 mask 255.255.0.0 192.168.0.1 metric 30';
     239    if Value then CommandLine := 'route -p add '+LocalNetAddr+' mask '+LocalNetMask+' '+DefaultGateway+' metric 30'
     240      else CommandLine := 'route delete '+LocalNetAddr+' mask '+LocalNetMask+' '+DefaultGateway+' metric 30';
    224241    Execute2;
    225242  finally
    … …  
    272289  ComboBox1.Items.Assign(MagRasCon1.PhoneBookEntries);
    273290  ComboBox1.ItemIndex := ComboBox1.Items.IndexOf(ConnectionName);
     291
     292  Label2.Caption := 'Brána: ' + DefaultGateway;
    274293end;
    275294
    … …  
    295314end;
    296315
     316function TMainForm.GetDefaultGateway: string;
     317var
     318  Command: TDosCommand;
     319  I: Integer;
     320  Lines2: TStringList;
     321begin
     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;
     336end;
     337
    297338function TMainForm.GetWorkgroupZdechov: Boolean;
    298339var
    … …  
    366407procedure TMainForm.FormCreate(Sender: TObject);
    367408begin
    368   Application.ShowMainForm := False;
     409  Connecting := False;
    369410  with CoolTrayIcon1 do begin
    370411    HideTaskbarIcon;
    … …  
    376417      RootKey := RegistryRootKey;
    377418      OpenKey(RegistryPath, True);
     419      if ValueExists('FirstStart') then FirstStart := ReadBool('FirstStart')
     420        else FirstStart := False;
    378421      if ValueExists('AutoDial') then AutoDial := ReadBool('AutoDial');
    379422      if ValueExists('AutoRedial') then AutoRedial := ReadBool('AutoRedial');
    380423      if ValueExists('ConnectionName') then ConnectionName := ReadString('ConnectionName');
    381424      if ValueExists('NetworkTestLastUpdate') then NetworkTestLastUpdate := StrToDate(ReadString('NetworkTestLastUpdate'));
    382       if ValueExists('PingTimeout') then PingTimeout := ReadInteger('PingTimeout');
     425      if ValueExists('PingTimeout') then PingTimeout := ReadInteger('PingTimeout')
     426        else PingTimeout := 200;
    383427    finally
    384428      Free;
    385429    end;
    386 
    387   if AutoDial then Dial;
     430  Application.ShowMainForm := not FirstStart;
     431
    388432end;
    389433
    … …  
    399443    RootKey := HKEY_LOCAL_MACHINE;
    400444    OpenKey('\SYSTEM\CurrentControlSet\Services\SharedAccess\Parameters\FirewallPolicy\StandardProfile\GloballyOpenPorts\List', True);
    401     Result := (ReadString('137:UDP') = '137:UDP:192.168.0.0/255.255.0.0:Enabled:@xpsp2res.dll,-22001')
    402       and (ReadString('138:UDP') = '138:UDP:192.168.0.0/255.255.0.0:Enabled:@xpsp2res.dll,-22002')
    403       and (ReadString('139:TCP') = '139:TCP:192.168.0.0/255.255.0.0:Enabled:@xpsp2res.dll,-22004')
    404       and (ReadString('445:TCP') = '445:TCP:192.168.0.0/255.255.0.0:Enabled:@xpsp2res.dll,-22005');
     445    Result := (ReadString('137:UDP') = '137:UDP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22001')
     446      and (ReadString('138:UDP') = '138:UDP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22002')
     447      and (ReadString('139:TCP') = '139:TCP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22004')
     448      and (ReadString('445:TCP') = '445:TCP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22005');
    405449  finally
    406450    Free;
    … …  
    415459    OpenKey('\SYSTEM\CurrentControlSet\Services\SharedAccess\Parameters\FirewallPolicy\StandardProfile\GloballyOpenPorts\List', True);
    416460    if Value then begin
    417       WriteString('137:UDP', '137:UDP:192.168.0.0/255.255.0.0:Enabled:@xpsp2res.dll,-22001');
    418       WriteString('138:UDP', '138:UDP:192.168.0.0/255.255.0.0:Enabled:@xpsp2res.dll,-22002');
    419       WriteString('139:TCP', '139:TCP:192.168.0.0/255.255.0.0:Enabled:@xpsp2res.dll,-22004');
    420       WriteString('445:TCP', '445:TCP:192.168.0.0/255.255.0.0:Enabled:@xpsp2res.dll,-22005');
     461      WriteString('137:UDP', '137:UDP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22001');
     462      WriteString('138:UDP', '138:UDP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22002');
     463      WriteString('139:TCP', '139:TCP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22004');
     464      WriteString('445:TCP', '445:TCP:'+LocalNetAddr+'/'+LocalNetMask+':Enabled:@xpsp2res.dll,-22005');
    421465    end else begin
    422466      WriteString('137:UDP', '137:UDP:LocalSubNet:Enabled:@xpsp2res.dll,-22001');
    … …  
    434478  I: Integer;
    435479begin
    436         with MagRasCon1 do begin
    437     GetConnections;
    438     I := 0;
    439     while (I < Connections.Count) and (Connections.EntryName(I) <> ConnectionName) do I := I + 1;
    440     if not (I < Connections.Count) then begin
    441       EntryName := ConnectionName;
    442             PhoneNumber :=      '';
    443           DialHandle := 0;
    444         AutoConnectEx(DialHandle);
     480    if MagRasCon1.ConnectState = RASCS_Connected then
     481      MagRasCon1.DisconnectEx(DialHandle, 0, 3000, False);
     482
     483    DialingLog.Memo1.Lines.Add('');
     484    DialingLog.Memo1.Lines.Add(DateTimeToStr(Now) + ': Vytáèím pøípojení');
     485        with MagRasCon1 do begin
     486      GetConnections;
     487      I := 0;
     488      while (I < Connections.Count) and (Connections.EntryName(I) <> ConnectionName) do I := I + 1;
     489      if not (I < Connections.Count) then begin
     490        EntryName := ConnectionName;
     491              PhoneNumber :=    '';
     492            DialHandle := 0;
     493        AutoConnectEx(DialHandle);
     494      end;
    445495    end;
    446   end;
    447496end;
    448497
    449498procedure TMainForm.Timer1Timer(Sender: TObject);
    450499begin
    451         Dial;
     500  if MagRasCon1.ConnectState <> RASCS_Connected then begin
     501    Timer1.Enabled := False;
     502    Dial;
     503  end;
    452504end;
    453505
    … …  
    458510      RootKey := RegistryRootKey;
    459511      OpenKey(RegistryPath, True);
     512      WriteBool('FirstStart', True);
    460513      WriteBool('AutoDial', AutoDial);
    461514      WriteBool('AutoRedial', AutoRedial);
    … …  
    535588  CheckBox7.Checked := True;
    536589  CheckBox8.Checked := True;
     590  CheckBox9.Checked := True;
    537591  ComboBox1.ItemIndex := ComboBox1.Items.IndexOf(DefaultConnectionName);
    538592end;
    … …  
    577631end;
    578632
     633procedure TMainForm.Zznamvyten1Click(Sender: TObject);
     634begin
     635  if not DialingLog.Visible then DialingLog.ShowModal;
     636end;
     637
     638procedure TMainForm.MagRasCon1StateChanged(Sender: TObject);
     639var
     640        Info: string;
     641begin
     642        if LastState = MagRasCon1.ConnectState then Exit;
     643
     644  // check type of event
     645        Info := '';
     646  case MagRasCon1.StateEventSource of
     647        SourceDial: Info := ' Dial: ';
     648        SourceStatus: begin
     649      Info := ' Status: ';
     650      Timer1.Enabled := True;
     651    end;
     652        SourceHangup: Info := ' Hangup: ';
     653        end;
     654
     655  // see if new event, else display it
     656  LastState := MagRasCon1.ConnectState ;
     657  DialingLog.Memo1.Lines.Add (Info + MagRasCon1.StatusStr
     658    +   ' (' + IntToStr(LastState) + ')');
     659
     660  // if dialling need to see what's happened
     661        if DialHandle <> 0 then begin
     662        // online OK, restart timer
     663                if (MagRasCon1.ConnectState = RASCS_Connected) then begin
     664//      ConnHandle := DialHandle
     665//      DialHandle := 0;
     666//      TimerStatus.Enabled := True;
     667                end;
     668
     669          // dialling failed, either an error or disconnected
     670                if ((MagRasCon1.ConnectState > RASBase) and
     671            (MagRasCon1.ConnectState < RASCS_Paused)) or
     672            (MagRasCon1.ConnectState = RASCS_Disconnected) then begin
     673        // disconnect, returns when done or after three seconds, no StateChanged
     674        //ConnHandle := DialHandle;
     675                          //DialHandle := 0;
     676                        MagRasCon1.DisconnectEx(DialHandle, 0, 3000, False);
     677        Timer1.Enabled := True;
     678        // reset is done in timer event
     679                  end;
     680        end;
     681end;
     682
     683procedure TMainForm.Init;
     684var
     685  WSAErr: string;
     686  Hostname: string;
     687begin
     688  HostName := 'default';
     689  GetIPFromHost(Hostname, DefaultGateway, WSAErr);
     690  DefaultGateway := ReverseString(DefaultGateway);
     691  DefaultGateway := '1'+Copy(DefaultGateway, Pos('.', DefaultGateway), 255);
     692  DefaultGateway := ReverseString(DefaultGateway);
     693
     694  //DefaultGateway := GetDefaultGateway;
     695  if AutoDial then Dial;
     696end;
     697
     698procedure TMainForm.Timer2Timer(Sender: TObject);
     699begin
     700  MagRasCon1.CurrentStatusEx(DialHandle, 0);
     701end;
     702
     703function GetIPFromHost(var HostName, IPaddr, WSAErr: string): Boolean;
     704type
     705  Name = array[0..100] of Char;
     706  PName = ^Name;
     707var
     708  HEnt: pHostEnt;
     709  HName: PName;
     710  WSAData: TWSAData;
     711  i: Integer;
     712begin
     713  Result := False;     
     714  if WSAStartup($0101, WSAData) <> 0 then begin
     715    WSAErr := 'Winsock is not responding."';
     716    Exit;
     717  end;
     718  IPaddr := '';
     719  New(HName);
     720  if GetHostName(HName^, SizeOf(Name)) = 0 then
     721  begin
     722    HostName := StrPas(HName^);
     723    HEnt := GetHostByName(HName^);
     724    for i := 0 to HEnt^.h_length - 1 do
     725     IPaddr :=
     726      Concat(IPaddr,
     727      IntToStr(Ord(HEnt^.h_addr_list^[i])) + '.');
     728    SetLength(IPaddr, Length(IPaddr) - 1);
     729    Result := True;
     730  end
     731  else begin
     732   case WSAGetLastError of
     733    WSANOTINITIALISED:WSAErr:='WSANotInitialised';
     734    WSAENETDOWN      :WSAErr:='WSAENetDown';
     735    WSAEINPROGRESS   :WSAErr:='WSAEInProgress';
     736   end;
     737  end;
     738  Dispose(HName);
     739  WSACleanup;
     740end;
     741
    579742end.
Note: See TracChangeset for help on using the changeset viewer.