БОЛЬШОЙ FAQ ПО DELPHI



Проверить соединение с Интернетом и узнать тип соединения


Директору пивзавода от группы программистов. Заявление: "Просим Вас предоставить выделенную линию со скоростью 0,5 л/сек."

По нажатию на кнопку в появляется сообщение. Если не 0 - есть соединения с Интернетом. А в заголовке формы показывается тип соединения.


 unit Unit1;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   Registry, WinSock, WinInet, StdCtrls;
 
 type
   TConnectionType = (ctNone, ctProxy, ctDialup);
 
 function ConnectedToInternet : TConnectionType;
 function RasConnectionCount : Integer;
 
 type
   TForm1 = class(TForm)
     Button1: TButton;
     procedure Button1Click(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
 end;
 
 var
   Form1: TForm1;
 
 implementation
 
 {$R *.DFM}
 
 //For RasConnectionCount =======================
 const
   cERROR_BUFFER_TOO_SMALL = 603;
   cRAS_MaxEntryName = 256;
   cRAS_MaxDeviceName = 128;
   cRAS_MaxDeviceType = 16;
 
 type
   ERasError = class(Exception);
     HRASConn = DWord;
     PRASConn = ^TRASConn;
     TRASConn = record
     dwSize: DWORD;
     rasConn: HRASConn;
     szEntryName: array[0..cRAS_MaxEntryName] of Char;
     szDeviceType : array[0..cRAS_MaxDeviceType] of Char;
     szDeviceName : array [0..cRAS_MaxDeviceName] of char;
   end;
 
   TRasEnumConnections =
     function (RASConn: PrasConn; { buffer to receive Connections data }
     var BufSize: DWord; { size in bytes of buffer }
     var Connections: DWord { number of Connections written to buffer }
     ): LongInt; stdcall;
 //End RasConnectionCount =======================
 
 function ConnectedToInternet: TConnectionType;
 var
   Reg : TRegistry;
   bUseProxy : Boolean;
   UseProxy : LongWord;
 begin
   Result := ctNone;
   Reg := TRegistry.Create;
   with REG do
     try
       try
         RootKey := HKEY_CURRENT_USER;
         if OpenKey('\Software\Microsoft\Windows\CurrentVersion\Internet settings',False) then
         begin
           //I just try to read it, and trap an exception
           if GetDataType('ProxyEnable') = rdBinary then
             ReadBinaryData('ProxyEnable', UseProxy, SizeOf(LongWord) )
           else
           begin
             bUseProxy := ReadBool('ProxyEnable');
             if bUseProxy then
               UseProxy := 1
             else
               UseProxy := 0;
           end;
           if (UseProxy <> 0) and ( ReadString('ProxyServer') <> '' ) then
             Result := ctProxy;
         end;
       except
       //Obviously not connected through a proxy
       end;
     finally
       Free;
     end;
 
   //We can check RasConnectionCount even if dialup networking is not installed
   //simply because it will return 0 if the DLL is not found.
   if Result = ctNone then
   begin
     if RasConnectionCount > 0 then
       Result := ctDialup;
   end;
 end;
 
 function RasConnectionCount : Integer;
 var
   RasDLL : HInst;
   Conns : array[1..4] of TRasConn;
   RasEnums : TRasEnumConnections;
   BufSize : DWord;
   NumConns : DWord;
   RasResult : Longint;
 begin
   Result := 0;
 
   //Load the RAS DLL
   RasDLL := LoadLibrary('rasapi32.dll');
   if RasDLL = 0 then
     exit;
 
   try
     RasEnums := GetProcAddress(RasDLL,'RasEnumConnectionsA');
   if @RasEnums = nil then
     raise ERasError.Create('RasEnumConnectionsA not found in rasapi32.dll');
 
   Conns[1].dwSize := Sizeof (Conns[1]);
   BufSize := SizeOf(Conns);
 
   RasResult := RasEnums(@Conns, BufSize, NumConns);
 
   if (RasResult = 0) or (Result = cERROR_BUFFER_TOO_SMALL) then
     Result := NumConns;
   finally
     FreeLibrary(RasDLL);
   end;
 end;
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   ShowMessage(IntToStr(RasConnectionCount));
   if ConnectedToInternet=ctNone then
     Form1.Caption:='ctNone';
   if ConnectedToInternet=ctProxy then
     Form1.Caption:='ctProxy';
   if ConnectedToInternet=ctDialup then
     Form1.Caption:='ctDialup';
 end;
 
 end.
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Видеокурс ВЗЛОМ