TZoCInetChecker：检测网络连接的类

{ TZoCInetChecker }
procedure InternetCallback(hInternet: HINTERNET; dwContext: DWORD;
  dwInternetStatus: DWORD; lpvStatusInformation: hwnd;
  dwStatusInformationLength: DWORD); stdcall;
var
  cpContext                             : pREQUEST_CONTEXT;
  FConnected                            : Boolean;
  dwindex, dwcodelen                    : dword;
  dwcode                                : array[1..20] of char;
  res                                   : pchar;
begin
  cpContext := pREQUEST_CONTEXT(dwContext);
  PostMessage(cpContext^.hWindow, WM_STATUSCHANGE, dwInternetStatus, 0);
  if dwInternetStatus = INTERNET_STATUS_REQUEST_COMPLETE then
  begin
    dwIndex := 0;
    dwCodeLen := 10;
    HttpQueryInfo(Pointer(LPINTERNET_ASYNC_RESULT(lpvStatusInformation).dwResult),
      HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex);
    res := pchar(@dwcode);
    //HTTP_STATUS_OK 200 The request completed successfully
    //HTTP_STATUS_REDIRECT 302 The requested resource resides temporarily under a different URI
    FConnected := (res = '200') or (res = '302');
    InternetCloseHandle(Pointer(LPINTERNET_ASYNC_RESULT(lpvStatusInformation).dwResult));
    InternetCloseHandle(cpContext^.hOpen);
    PostMessage(cpContext^.hWindow, WM_CHECKCOMPLETE, Integer(FConnected), 0);
  end;
end;

constructor TZoCInetChecker.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FWindowHandle := AllocateHWnd(WndProc);
  FAccessType := atDirectConnect;
  FAsynRequest := True;
  FUserAgent := 'ZoCSoft Internet Checker 1.0';
end;

destructor TZoCInetChecker.Destroy;
begin
  InternetCloseHandle(hOpenUrl);
  if FWindowHandle <> 0 then
    DeallocateHWnd(FWindowHandle);
  inherited Destroy;
end;

procedure TZoCInetChecker.DoOnStatusChange(StatusCode: Cardinal);
begin
  if Assigned(FOnStatusChange) then
    FOnStatusChange(Self, StatusCode);
end;
function TZoCInetChecker.Execute: Boolean;
var
  Flags                                 : Cardinal;
begin
  if FUrl = '' then
    Exit;
  FBusy := True;
  if Assigned(FOnStart) then
    FOnStart(Self);
  if FAsynRequest then
    Flags := INTERNET_FLAG_ASYNC
  else
    Flags := 0;
  case FAccessType of
    atDirectConnect:
      hOpen := InternetOpen(PChar(FUserAgent), INTERNET_OPEN_TYPE_DIRECT,
        nil, nil, Flags);
    atPreConfig:
      hOpen := InternetOpen(PChar(FUserAgent), INTERNET_OPEN_TYPE_PRECONFIG,
        nil, nil, Flags);
    atPreConfigWithNoProxy:
      hOpen := InternetOpen(PChar(FUserAgent),
        INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY,
        nil, nil, Flags);
    atProxy:
      hOpen := InternetOpen(PChar(FUserAgent), INTERNET_OPEN_TYPE_PROXY,
        PChar(FProxy), nil, Flags);
  end;
  RC.hWindow := FWindowHandle;
  RC.hOpen := hOpen;
  if FAsynRequest then
    iscCallback := InternetSetStatusCallback(hOpen,
      INTERNET_STATUS_CALLBACK(@InternetCallback));
  hOpenUrl := InternetOpenUrl(hOpen, PChar(FUrl), nil, 0,
    INTERNET_FLAG_RELOAD, Cardinal(@RC));
  Result := hOpenUrl <> nil;
end;

procedure TZoCInetChecker.WndProc(var Msg: TMessage);
begin
  case Msg.Msg of
    WM_STATUSCHANGE:
      DoOnStatusChange(Msg.WParam);
    WM_CHECKCOMPLETE:
      begin
        FBusy := True;
        if Assigned(FOnComplete) then
          FOnComplete(Self, Boolean(Msg.WParam));
      end;
  else
    Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
  end;
end;

function StatusCode2StatusText(StatusCode: Cardinal): string;
begin
  case StatusCode of
    INTERNET_STATUS_CLOSING_CONNECTION:
      Result := 'Closing connection to the server.';
    INTERNET_STATUS_CONNECTED_TO_SERVER:
      Result := 'Successfully connected to the socket address.';
    INTERNET_STATUS_CONNECTING_TO_SERVER:
      Result := 'Connecting to the socket address.';
    INTERNET_STATUS_CONNECTION_CLOSED:
      Result := 'Closed the connection to the server.';
    INTERNET_STATUS_DETECTING_PROXY:
      Result := 'Proxy has been detected.';
    INTERNET_STATUS_HANDLE_CLOSING:
      Result := 'Handle value has been terminated.';
    INTERNET_STATUS_HANDLE_CREATED:
      Result := 'InternetConnect has created a new handle.';
    INTERNET_STATUS_INTERMEDIATE_RESPONSE:
      Result := 'Received status code message from the server.';
    INTERNET_STATUS_NAME_RESOLVED:
      Result := 'Successfully found the IP address.';
    INTERNET_STATUS_RECEIVING_RESPONSE:
      Result := 'Waiting for the server to respond.';
    INTERNET_STATUS_REDIRECT:
      Result := 'Request is about to be redirected.';
    INTERNET_STATUS_REQUEST_COMPLETE:
      Result := 'Completed.';
    INTERNET_STATUS_REQUEST_SENT:
      Result := 'Successfully sent the information request to the server.';
    INTERNET_STATUS_RESOLVING_NAME:
      Result := 'Looking up the IP address of the name.';
    INTERNET_STATUS_RESPONSE_RECEIVED:
      Result := 'Successfully received a response from the server.';
    INTERNET_STATUS_SENDING_REQUEST:
      Result := 'Sending the information request to the server.';
    INTERNET_STATUS_STATE_CHANGE:
      Result := 'Security State Change.';
  else
    Result := 'Unknown Status.';
  end;
end;

end.

    不出所料，网络小灵通果然不负众望得到不少同学的支持，大家也不用坐在计算机前无聊地看网络是否恢复了，因为它不仅能检测内网是否连通，也能检测外网是否能上，在检测成功后它会播放自定义的声音通知，为此我还专门找寝室一个兄弟录制了两段粗犷的“通网了”/“断网了”音频为大家解闷；再后来还加入了查找本网段内空闲IP和检查哪个IP可能在搞ARP欺骗的功能，直到学校的网络秩序逐渐转好，网络状况也慢慢好转，网络小灵通才回到了我的Code Repository里面，安睡了。

上一页  [1] [2] [3] 

【责编:Peng】