Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Проверить соединение с Интернетом и узнать тип соединения


Директору пивзавода от группы программистов. Заявление: "Просим Вас предоставить выделенную линию со скоростью 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.

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.