Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Для новичков > Соединение через локал


Автор: Bigreddog 6.6.2009, 10:50
Код


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.



Скажите мне пожалуйста!: Вот код программы. Он определяет соединение через прокси и дуалап, а как сделать чтобы программа показывала и другие все возможные подключения например у меня webstream  и прога не определяет соединение. Говорит что соединения нет.....

Автор: Alkash 6.6.2009, 23:33
Через Ras Api.

Автор: THandle 7.6.2009, 09:52

M
THandle
Дубляж тем в разных разделах? 

http://forum.vingrad.ru/forum/topic-262331.html


Модератор: закрыто.

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)