![]() |
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Интернет счетчик [D7, WinME]
DreymanD © (2004-08-11 17:04:00)Привет мастерам!
Хочу сделать интернет счетчик, только не знаю такой команды, которая б, проверяла систему - подключена ли она к И-нету или нет? Надо чтоб прога висела в трее(как сделать знаю), затем когда мы подключились к И-нету, запускался таймер, который сообщал бы, сколько времени мы в И-нете провели... Если отключились - таймер остановился. Если еще раз подключились - таймер продолжает счет.
Заранее спасибо!
[serzh] (2004-08-13 11:52:00) [1]А можно сделать, что б твоя прога сама с нетом соединялась и тогда легче время считать будет!
AndersoNRules (2004-08-11 23:04:00) [2]const
INTERNET_CONNECTION_MODEM = 1;
INTERNET_CONNECTION_LAN = 2;
INTERNET_CONNECTION_PROXY = 4;
INTERNET_CONNECTION_MODEM_BUSY = 8;
winetdll = 'wininet.dll';
...
function InternetGetConnectedState(lpdwFlags: LPDWORD; dwReserved:DWORD):BOOL; stdcall;
external winetdll name 'InternetGetConnectedState';
...
function InternetConnected: Boolean;
var dwConnectionTypes: DWORD;
begin dwConnectionTypes :=
INTERNET_CONNECTION_MODEM +
INTERNET_CONNECTION_LAN +
INTERNET_CONNECTION_PROXY;
Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;
Dimaxx (2004-08-11 22:57:00) [3]Вот текст компонента по определению в сети ли тачка (иконку для палитры сам прилепишь):
unit INetDetector;
interface
uses Windows, Messages, Classes, Forms, Winsock;
type
TINetDetector = class(TComponent)
private
FEnabled: Boolean;
FDispatchInterval: Cardinal;
FWindowHandle: hWnd;
FOnline: Boolean;
FOnChanged: TNotifyEvent;
FCurrentIP : String; {<--RLM Diagnostics}
FpCurrHostEnt : PHostEnt; {<--RLM Diagnostics}
procedure UpdateTimer;
procedure SetEnabled(Value: Boolean);
procedure SetDispatchInterval(Value: Cardinal);
procedure SetNoneBool(Value: Boolean);
procedure WndProc(var Msg: TMessage);
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property CurrentIP : String read FCurrentIP; {<--RLM Diagnostics}
property pCurrHostEnt : PHostEnt read FpCurrHostEnt; {<--RLM Diagnostics}
published
property Enabled: Boolean read FEnabled write SetEnabled;
property DispatchInterval: Cardinal read FDispatchInterval write SetDispatchInterval;
property Online: Boolean read FOnline write SetNoneBool;
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
end;
procedure Register;
implementation
constructor TINetDetector.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEnabled := True;
FDispatchInterval := 1000;
FWindowHandle := AllocateHWnd(WndProc);
UpdateTimer;
end;
destructor TINetDetector.Destroy;
begin
FEnabled := False;
UpdateTimer;
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;
procedure TINetDetector.WndProc(var Msg: TMessage);
var
OldState: Boolean;
Key: hKey;
PC: Array[0..4] of Char;
Size: Integer;
RegSays : Boolean; {<-- RLM 12/13/99}
function IsIPPresent: Boolean;
type
TaPInAddr = Array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: Array[0..63] of Char;
I: Integer;
GInitData: TWSAData;
IP: String;
begin
WSAStartup($101, GInitData);
Result := False;
GetHostName(Buffer, SizeOf(Buffer));
phe := GetHostByName(buffer);
FpCurrHostEnt := phe;
if phe = nil then Exit;
pPtr := PaPInAddr(phe^.h_addr_list);
I := 0;
while pPtr^[I] <> nil do
begin
IP := inet_ntoa(pptr^[I]^);
Inc(I);
end;
FCurrentIP := IP;
WSACleanup;
Result := (IP <> '') and (IP <> '127.0.0.1');
end;
procedure FixOnlineState;
begin
if (not OldState and FOnline) or
(OldState and not FOnline) then
if Assigned(FOnChanged) then
FOnChanged(Self);
end;
begin
with Msg do
if Msg = wm_Timer then
try
OldState := FOnline;
FOnline := IsIPPresent;
FixOnlineState;
if RegOpenKey(HKEY_LOCAL_MACHINE, 'System\CurrentControlSet\Services\RemoteAccess', Key) = ERROR_SUCCESS then
begin
Size := 4;
if RegQueryValueEx(Key, 'Remote Connection', nil, nil, @PC, @Size) = ERROR_SUCCESS then
begin
{Original}
{
FOnline := PC[0] = #1;
FixOnlineState;
}
{Changed 12/13/99 RLM -- AOL leaves PC bytes all 00's}
RegSays := PC[0] = #1;
FOnLine := FOnLine or RegSays;
FixOnlineState;
end
else
begin
FOnline := IsIPPresent;
FixOnlineState;
end;
RegCloseKey(Key);
end
else
begin
FOnline := IsIPPresent;
FixOnlineState;
end;
except
Application.HandleException(Self);
end
else
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;
procedure TINetDetector.UpdateTimer;
begin
KillTimer(FWindowHandle, 1);
if (FDispatchInterval <> 0) and FEnabled then
SetTimer(FWindowHandle, 1, FDispatchInterval, nil);
end;
procedure TINetDetector.SetEnabled(Value: Boolean);
begin
if Value <> FEnabled then
begin
FEnabled := Value;
UpdateTimer;
end;
end;
procedure TINetDetector.SetDispatchInterval(Value: Cardinal);
begin
if Value <> FDispatchInterval then
begin
FDispatchInterval := Value;
UpdateTimer;
end;
end;
procedure TINetDetector.SetNoneBool(Value: Boolean); begin {} end;
procedure Register;
begin
RegisterComponents('Internet', [TINetDetector]);
end;
end.
MacroDenS (2004-08-11 17:42:00) [4]насчет есть ли на данный момент соединение с инетом или нет, я темку где то в FAQ видел...
DreymanD (2004-08-11 17:37:00) [5]Smithson © (11.08.04 17:11) [2]
Да-да, Диалап-соединение.
Начет каких Ras функций ты говоришь?
Smithson (2004-08-11 17:11:00) [6]Что ты имеешь в виду под "подключением к интернету"? Диалап-соединение? Или подключение выделенки? Во-втором случае подключение есть всегда, когда активна сетевая карта.
В первом, смотри в строну RAS-функций.
MacroDenS (2004-08-11 17:05:00) [7]это тебе в раздел сети надо...