Модераторы: Snowy, MetalFan, bems, Poseidon
  

Поиск:

Закрытая темаСоздание новой темы Создание опроса
> Соединение через локал 
:(
    Опции темы
Bigreddog
  Дата 6.6.2009, 10:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 27
Регистрация: 27.10.2007

Репутация: нет
Всего: нет



Код


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  и прога не определяет соединение. Говорит что соединения нет.....
PM MAIL   Вверх
Alkash
Дата 6.6.2009, 23:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


коллекционер жизни
**


Профиль
Группа: Участник
Сообщений: 516
Регистрация: 5.7.2004
Где: /

Репутация: нет
Всего: нет



Через Ras Api.


--------------------
Подпись >> /dev/null
PM MAIL ICQ MSN   Вверх
THandle
Дата 7.6.2009, 09:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Хранитель Клуба
Group Icon
Награды: 1



Профиль
Группа: Админ
Сообщений: 3639
Регистрация: 31.7.2007
Где: Moscow, Dubai

Репутация: 50
Всего: 372




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

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


Модератор: закрыто.
PM   Вверх
  
Закрытая темаСоздание новой темы Создание опроса
Правила форума "Delphi: Для новичков"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Для новичков | Следующая тема »


 




[ Время генерации скрипта: 0.0446 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.