Текущий архив: 2004.10.24;
Скачать: CL | DM;

Вниз

Интернет счетчик   Найти похожие ветки 

← →
DreymanD   (2004-08-11 17:04) [0]

Привет мастерам!
Хочу сделать интернет счетчик, только не знаю такой команды, которая б, проверяла систему - подключена ли она к И-нету или нет? Надо чтоб прога висела в трее(как сделать знаю), затем когда мы подключились к И-нету, запускался таймер, который сообщал бы, сколько времени мы в И-нете провели... Если отключились - таймер остановился. Если еще раз подключились - таймер продолжает счет.

Заранее спасибо!

---

← →
MacroDenS ©   (2004-08-11 17:05) [1]

это тебе в раздел сети надо...

---

← →
Smithson ©   (2004-08-11 17:11) [2]

Что  ты имеешь в виду под "подключением к интернету"? Диалап-соединение? Или подключение выделенки? Во-втором случае подключение есть всегда, когда активна сетевая карта.
В первом, смотри в строну RAS-функций.

---

← →
DreymanD   (2004-08-11 17:37) [3]

Smithson ©   (11.08.04 17:11) [2]
Да-да, Диалап-соединение.
Начет каких Ras функций ты говоришь?

---

← →
MacroDenS ©   (2004-08-11 17:42) [4]

насчет есть ли на данный момент соединение с инетом или нет, я темку где то в FAQ видел...

---

← →
Dimaxx   (2004-08-11 22:57) [5]

Вот текст компонента по определению в сети ли тачка (иконку для палитры сам прилепишь):

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.

---

← →
AndersoNRules   (2004-08-11 23:04) [6]

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;

---

← →
[serzh]   (2004-08-13 11:52) [7]

А можно сделать, что б твоя прога сама с нетом соединялась и тогда легче время считать будет!

---

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

Текущий архив: 2004.10.24;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.025 c