Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Сети";
Текущий архив: 2004.05.30;
Скачать: [xml.tar.bz2];

Вниз

Как установить тип Internet-соединения?   Найти похожие ветки 

 
NS   (2004-04-09 08:00) [0]

Подскажите, как можно установить:
1) Момент подключения к Internet.
2) Тип соединения с Internet: Dual-Up или по локальной сети (через выделенку)


 
Verg ©   (2004-04-09 09:41) [1]

Я не знаю, что ты называешь "подключение к Internet",
воспользовавшись IpHlpApi.dll, можно
GetBestInterface - узнать интерфейс, через который доступен Шлюз по умолчанию
GetIfEntry - узнать его тип и прч. параметры
NotifyRouteChange - отслеживать моменты появления/исчезновения этого шлюза


 
Verg ©   (2004-04-09 10:05) [2]

К примеру, для Win2K:

program DefaultIF;

{$APPTYPE CONSOLE}

uses
 Windows,
 WinSock,
 SysUtils;

const
 MAX_INTERFACE_NAME_LEN  = 256;
 MAX_TRANSPORT_NAME_LEN  = 40;
 MAX_MEDIA_NAME          = 16;
 MAX_PORT_NAME           = 16;
 MAX_DEVICE_NAME         = 128;
 MAX_PHONE_NUMBER_LEN    = 128;
 MAX_DEVICETYPE_NAME     = 16;
 MAXLEN_IFDESCR          = 256;
 MAXLEN_PHYSADDR         = 8;

 MIB_IF_TYPE_OTHER              = 1;
 MIB_IF_TYPE_ETHERNET           = 6;
 MIB_IF_TYPE_TOKENRING          = 9;
 MIB_IF_TYPE_FDDI               = 15;
 MIB_IF_TYPE_PPP                = 23;
 MIB_IF_TYPE_LOOPBACK           = 24;
 MIB_IF_TYPE_SLIP               = 28;
 
type
   TMIB_IFROW = record
           wszName : array[0..MAX_INTERFACE_NAME_LEN-1] of widechar;
           dwIndex,
           dwType,
           dwMtu,
           dwSpeed,
           dwPhysAddrLen : DWORD;
           bPhysAddr : array[0..MAXLEN_PHYSADDR-1] of BYTE;
           dwAdminStatus,
           dwOperStatus,
           dwLastChange,
           dwInOctets,
           dwInUcastPkts,
           dwInNUcastPkts,
           dwInDiscards,
           dwInErrors,
           dwInUnknownProtos,
           dwOutOctets,
           dwOutUcastPkts,
           dwOutNUcastPkts,
           dwOutDiscards,
           dwOutErrors,
           dwOutQLen,
           dwDescrLen : DWORD;
           bDescr : array[0..MAXLEN_IFDESCR-1] of BYTE;
end;
PMIB_IFROW = ^TMIB_IFROW;

var
 NotifyOverlapped : TOverlapped;
 IFRow : TMIB_IFROW;
 S : string;
 NFH : THandle;
 Res : DWORD;
 EndFlag : boolean;

function GetBestInterface(
 dwDestAddr : DWORD;     // destination IP address
 var pdwBestIfIndex : DWORD // index of interface with the best route
) : DWORD; stdcall; external "IPHLPAPI.DLL";

function GetIfEntry(var pIfRow : TMIB_IFROW ): DWORD; stdcall; external "IPHLPAPI.DLL";

function NotifyRouteChange(var Handle : THandle;
                          var overlapped : TOverlapped
                         ):DWORD; stdcall; external "IPHLPAPI.DLL";

function CtrlHandler(dwCtrlType : DWORD):BOOL; stdcall;
begin
 Result := BOOL(true);
 EndFlag := true;
 SetEvent(NotifyOverlapped.hEvent);
end;

function ToOem(const S : string):string;
begin
 Result := S;
 if Result<>"" then
   CharToOemBuff(pchar(Result), pchar(Result), length(Result));
end;

procedure PrintErr(Err : DWORD; Wt : boolean);
begin
 Writeln(ToOem(SysErrorMessage(Err)));
 if Wt then ReadLn;
end;

procedure CheckResult( Res : DWORD);
begin
 if Res <> NO_ERROR then
 begin
   PrintErr(Res, true);
   halt(0);
 end;
end;

begin
 ZeroMemory(@NotifyOverLapped, sizeof(NotifyOverLapped));
 NotifyOverLapped.hEvent := CreateEvent(nil, true, false, nil);
 EndFlag := false;
 SetConsoleCtrlHandler(@CtrlHandler, LongBool(TRUE));
 repeat
   ZeroMemory(@IFRow, sizeof(IFRow));
   if GetBestInterface(INADDR_ANY, IFRow.dwIndex ) <> NO_ERROR then
     writeln(ToOem("Default gateway отсутствует"))
   else begin
      CheckResult( GetIfEntry(IFRow) );
      case IFRow.dwType of
        MIB_IF_TYPE_OTHER     : S:= "OTHER";
        MIB_IF_TYPE_ETHERNET  : S:= "ETHERNET";
        MIB_IF_TYPE_TOKENRING : S:= "TOKENRING";
        MIB_IF_TYPE_FDDI      : S:= "FDDI";
        MIB_IF_TYPE_PPP       : S:= "PPP";
        MIB_IF_TYPE_LOOPBACK  : S:= "LOOPBACK";
        MIB_IF_TYPE_SLIP      : S:= "SLIP";
      else
        S:="UNKNOWN"
      end;
      writeln(ToOem("Default gateway доступен через интерфейс типа "+S)," (",IFRow.dwSpeed,"bps)");
   end;
   Res := NotifyRouteChange(NFH, NotifyOverlapped);
   if Res <> ERROR_IO_PENDING then
     CheckResult( Res );
   if not EndFlag then
   if WaitForSingleObject(NotifyOverlapped.hEvent, INFINITE) <> WAIT_OBJECT_0 then
   begin
     PrintErr(GetLastError, true);
     break;
   end;
 until EndFlag;
 Closehandle(NotifyOverlapped.hEvent);
 Writeln("Game over");
end.


 
Orc ©   (2004-04-09 11:59) [3]

Можно прозаичнее решить:


uses
 WinInet;

const
 MODEM = 1;
 LAN = 2;
 PROXY = 4;
 BUSY = 8;

function GetConnectionKind(var strKind: string): Boolean;
var
 flags: DWORD;
begin
 strKind := "";
 Result := InternetGetConnectedState(@flags, 0);
 if Result then
 begin
   if (flags and MODEM) = MODEM then strKind := "Modem";
   if (flags and LAN) = LAN then strKind := "LAN";
   if (flags and PROXY) = PROXY then strKind := "Proxy";
   if (flags and BUSY) = BUSY then strKind := "Modem Busy";
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 strKind: string;
begin
 if GetConnectionKind(strKind) then
   ShowMessage(strKind);
end;


 
NS   (2004-04-12 07:53) [4]

Спасибо, то что надо!



Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2004.05.30;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.03 c
14-1083917961
malkolinge
2004-05-07 12:19
2004.05.30
Интересно есть на форуме хоть один человек, кто ни разу


14-1084441323
TUser
2004-05-13 13:42
2004.05.30
AutoCAD?


3-1083759637
int21h
2004-05-05 16:20
2004.05.30
Aliace in Paradox


1-1084695704
temp
2004-05-16 12:21
2004.05.30
Как создать файл в памяти, т.е. не сохраняя его на диск? Например


7-1083246222
p_sA[11]
2004-04-29 17:43
2004.05.30
Дефолтовая раскладка клавиатуры





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский