Форум: "Сети";
Текущий архив: 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.036 c