本文转载自我2006年在csdn发布的博客
1、由来
几年前读书的时候有很长一段时间学校的网络很烂，一来上网的人多网络就可能断掉，过一段时间又会恢复；二来一幢楼只有一个网段，学校显然是低估了学生们对网络对需求和对计算机购买能力，所以有些放学才开机的同学常为分不到IP而烦恼。
学校里大家最常做的事之一就是整天开着FTP下资源，所以网络断掉又恢复最叫人恼火了。因为FTP服务器通常都会限制连接，所以为了在网络恢复时抢先一步，同学们会设置FTP客户端自动重连，并把重连的时间间隔设置得尽可能小，这类同学通常是不怎么关机的，我就是其中之一^_^b；有的同学不怎么下资源，但是网络不知道什么时候恢复也很烦恼，所以干脆就一直打开ping xxx.xxx.xxx.xxx -t一直ping服务器，并且过一会儿就看看屏幕，“莫办法啊”；还有的苦于分不到IP，或者干脆就故意捣乱，要不就用ping不断向别人发大数据包，要不用“网络执法官”来发ARP欺骗把别人踢出去……总之是乱了套了。
对于这种情况，技术手段就应该发挥一下作用了。先是有同学写了个带GUI的ping，如果网络通畅就在通知栏显示绿灯的图标，否则就是红灯，但这种方法也有问题。大家都知道，教育网有其特殊之处，我们有时候把教育网内称为内网，而需要代理才能访问的外部网络称为外网（由于有外网的存在，proxy探测软件在学校里用得相当广）。ping的手段对于检测内网问题不大，速度快，把学校主页或者网关作为目标就行了，但对外网就有问题了。Internet上服务器为防止攻击，会采取的措施之一是把ICMP响应关掉，客户端不能ping通服务器。
由于既然带GUI的ping不能解决问题，我当时就决定写一个真正能解决问题的软件，后来女朋友帮我取名为“网络小灵通”——一个可爱而贴切的名字。
2、分析
既然ping不能用，当然要另寻出路。我于是想到了TCP ping。是啊，ping不通，但我还是可以上网，因为Internet上的服务器再怎么着也不会把HTTP的端口封掉吧，所以解决的方案其实非常的Straightforward，剩下就是如何实现了。以我的习惯，先上网去搜，有现成的代码就直接为我所用，实在不行再自己写。
结果居然找了很久没找到，看来老外的网络没这么烂，许多检测是否On-Line的代码也根本不能解决问题。像url.dll提供的InetIsOffline函数，简直一点用的都没有（也许是IE4.0时代用于拨号网络的），同样RasEnumConnections也不能用。既然没有直接的函数可用，看来是要写一写了，当然我不打算直接用纯socket的方式，我也不熟悉，WinINet API（Windows® Internet API）应该是最好的选择，名字不就叫做Internet API么？
下面是最先写出的一个函数：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
function CheckUrl(url:string):boolean;
var
hSession, hfile, hRequest: hInternet;
dwindex,dwcodelen :dword;
dwcode:array[1..20] of char;
res : pchar;
begin
//检查URL是否包含http://，如果不包含则加上
if pos('http://',lowercase(url))=0 then
url := 'http://'+url;
Result := false;
hSession := InternetOpen('InetURL:/1.0',
INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0); //建立会话句柄
if assigned(hsession) then
begin
hfile := InternetOpenUrl(hsession, pchar(url), nil, 0,
INTERNET_FLAG_RELOAD, 0); //打开URL所指资源
dwIndex := 0;
dwCodeLen := 10;
HttpQueryInfo(hfile, `HTTP`_QUERY_STATUS_CODE,
@dwcode, dwcodeLen, dwIndex); //获取返回的`HTTP`头信息
res := pchar(@dwcode);
result:= (res ='200') or (res ='302');
if assigned(hfile) then
InternetCloseHandle(hfile); //关闭URL资源句柄
InternetCloseHandle(hsession); //关闭Internet会话句柄
end;
end;
毫无疑问，这个函数可以完成任务。它尝试Open一个Internet Session，然后检查返回的HTTP头信息。状态值200表示连接服务器成功，302表示Redirect之后连接成功，对这两种情况我们都可以认为能够成功地连接到Internet并打开网页了。但我认为这还不够好，一个函数的实现虽然简单，但因为是阻塞的调用，所以不够优美，如果能够知道Windows在连接的时候处于什么状态岂不是更好。试想如果大家用浏览器上网的时候总会感觉“阻塞”一下才能看到网页，那可是非常差的Experience。
3、TZoCInetChecker实现
所以非阻塞的异步探测是非常必要的，WinInet也提供了这样的调用方式，关键在于调用InternetSetStatusCallback函数通知WinInet在有状态反馈时通知我们。如果是用MFC的话CInternetSession类倒是可以用，不过Delphi的VCL没有这样直接的类，只好自己写了，我们的封装能力也决不弱于C++ ^_^
下面就是那时写的一个类TZoCInetChecker，提供了一个Method，几个Properties，还有几个Events，用起来和上面那个阻塞调用的函数一样方便，当然，它也包含了阻塞方式的检测：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
方法
Execute： 调用我就好了，其它的交给我去办
属性
Busy： 我正忙着呢，还没检测完，一会儿再来
AccessType： 你希望我怎么连接网络，直接连还是用代理？
AsynRequest： 同步检测的话我们要有一会儿看不到对方了，呜呜
UserAgent： 想告诉Web服务器是阿猫还是阿狗在连接？在这里设置就好了
Proxy： 让我用代理连网络，用哪个代理啊？
Url： 原来是要检测这个地址能不能访问，保证办到
事件
OnStart： 开始检测之前我会在这里通知你一声
OnStatusChange：检测过程中发生什么事我会在这里及时通知你的
OnComplete： 检测完成了，成功不成功我都会告诉你
{**********************************************************}
{ }
{ TZoCInetChecker Component Version 1.00 }
{ }
{ Function: Asynchronously Check if a given web page }
{ can be successfully retreived and feed back }
{ the user with callback status infomation }
{ }
{ }
{ This is a freeware. If you made cool changes on it, }
{ please send them to me. }
{ }
{ Email: eagleboost@msn.com }
{ URL: http://www.ZoCsoft.com }
{ }
{ History: + New Feature, - Removed, * Modified }
{ }
{ version 1.00 2005-06-03 }
{ The first version }
{ }
{**********************************************************}
unit ZoCInetChecker;
interface
uses
Windows, Messages, SysUtils, Classes, `WinInet`;
const
INTERNET_STATUS_DETECTING_PROXY = 80;
{$EXTERNALSYM INTERNET_STATUS_DETECTING_PROXY}
WM_STATUSCHANGE = WM_USER + 200;
WM_CHECKCOMPLETE = WM_USER + 201;
type
LPINTERNET_ASYNC_RESULT = ^INTERNET_ASYNC_RESULT;
INTERNET_ASYNC_RESULT = record
dwResult: DWORD;
dwError: DWORD;
end;
pREQUEST_CONTEXT = ^REQUEST_CONTEXT;
REQUEST_CONTEXT = record
hWindow: HWND;
hOpen: HINTERNET; //HINTERNET handle created by InternetOpen
end;
TOnStatusChangeEvent = procedure(Sender: TObject; StatusCode: Cardinal) of object;
TOnCompleteEvent = procedure(Sender: TObject; Connected: Boolean) of object;
TAccessType = (atDirectConnect, atPreConfig, atPreConfigWithNoProxy, atProxy);
TZoCInetChecker = class(TComponent)
private
{ Private declarations }
FUrl: string;
FAccessType: TAccessType;
FProxy: string;
FOnStart: TNotifyEvent;
FOnStatusChange: TOnStatusChangeEvent;
FOnComplete: TOnCompleteEvent;
FBusy: Boolean;
hOpenUrl, hOpen: HINTERNET;
FUserAgent: string;
FWindowHandle: HWnd;
iscCallback: INTERNET_STATUS_CALLBACK;
RC: REQUEST_CONTEXT;
FAsynRequest: Boolean;
procedure WndProc(var Msg: TMessage);
protected
{ Protected declarations }
procedure DoOnStatusChange(StatusCode: Cardinal); dynamic;
public
{ Public declarations }
property Busy: Boolean read FBusy write FBusy;
function Execute: Boolean;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property AccessType: TAccessType read FAccessType write FAccessType
default atDirectConnect;
property AsynRequest: Boolean read FAsynRequest write FAsynRequest
default True;
property UserAgent: string read FUserAgent write FUserAgent;
property Proxy: string read FProxy write FProxy;
property Url: string read FUrl write FUrl;
property OnStart: TNotifyEvent read FOnStart write FOnStart;
property OnStatusChange: TOnStatusChangeEvent read FOnStatusChange write
FOnStatusChange;
property OnComplete: TOnCompleteEvent read FOnComplete write FOnComplete;
end;
procedure Register;
function StatusCode2StatusText(StatusCode: Cardinal): string;
implementation
procedure Register;
begin
RegisterComponents('ZoC', [TZoCInetChecker]);
end;
{ 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.
4、后记
不出所料，网络小灵通果然不负众望得到不少同学的支持，大家也不用坐在计算机前无聊地看网络是否恢复了，因为它不仅能检测内网是否连通，也能检测外网是否能上，在检测成功后它会播放自定义的声音通知，为此我还专门找寝室一个兄弟录制了两段粗犷的“通网了”/“断网了”音频为大家解闷；再后来还加入了查找本网段内空闲IP和检查哪个IP可能在搞ARP欺骗的功能，直到学校的网络秩序逐渐转好，网络状况也慢慢好转，网络小灵通才回到了我的Code Repository里面，安睡了。
