用ADOConnection连接局域网的数据库服务器，网络
突然网络断开，要求应用程序弹出数据库连接配置的窗体，如何实现？求最优方法！
思路：
1.在本程序中用ADOConnection检测网络，连不上就弹出配置窗体。这样的方法是可行，
但有问题，ADOConnection检测网络的速度太慢，差不多二三十秒，而且这一段时间系统
象死机一样，无法正常操作界面，如果用这种方法，请给出快速检测网络通不通的方法，
最好5～10秒就可以检测出来，用ping不好，服务器装了防火墙就检测不到了，而且不要
影响界面的正常操作。
2.使用多线程技术或再开一个小程序写本地ini文件，检测网络状态，要求不影响主程序
的正常操作，（检测网络时屏幕不要死），我没用过多线程技术，请给出详细代码。
急用，多谢各位老大了。
2楼: 用一个timer；
try
ADOConnection.conned:=true;
except
showmessage(＇＇连接数据库失败~~！＇＇);
end; 如速达软件卸载
3楼: 请认真看看题目。
4楼: 如果你只是想判断是否连上数据库那上面的方法是可行的，你只要在提示的地方调出数据库设置窗体就行了。不过，你说如果网络断了的话，你再设置连接有什么用（因为已经连不上了）
5楼: “弹出数据库连接配置的窗体”就是弹出：服务器名、用户名、密码、数据库名。
这个窗体已经做好了，我当然知道在哪里show出来。
问题是：ADOConnection检测网络的速度太慢，差不多二三十秒，而且这一段时间系统
象死机一样，无法正常“操作！”界面，如果用这种方法，请给出“快速！”检测网络
通不通的方法，最好5～10秒就可以检测出来。
大侠出来帮帮忙啊。。。。。。
6楼: 如果ADOconnection检测太慢，那给你一个检测计算机是否连网的函数吧，希望对你有用（不过我还是觉得用adoconnection好一些，因为你连得上网，但可能因为别的原因还是连不上数据库，这样的问题它也可以检测出来）；
功 能: 检测网络状态
参 数:
IpAddr: 被测试网络上主机的IP地址或名称，建议使用Ip
返回值: 成功: True 失败: False;
Function CheckNet(IpAddr: string): Boolean;
type
PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation = packed record
TTL: Byte; // Time To Live (used for traceroute)
TOS: Byte; // Type Of Service (usually 0)
Flags: Byte; // IP header flags (usually 0)
OptionsSize: Byte; // Size of options data (usually 0, max 40)
OptionsData: PChar; // Options data buffer
end;
PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply = packed record
Address: DWord; // replying address
Status: DWord; // IP status value (see below)
RTT: DWord; // Round Trip Time in milliseconds
DataSize: Word; // reply data size
Reserved: Word;
Data: Pointer; // pointer to reply data buffer
Options: TIPOptionInformation; // reply options
end;
TIcmpCreateFile = function: THandle; stdcall;
TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;
TIcmpSendEcho = function(
IcmpHandle: THandle;
DestinationAddress: DWord;
RequestData: Pointer;
RequestSize: Word;
RequestOptions: PIPOptionInformation;
ReplyBuffer: Pointer;
ReplySize: DWord;
Timeout: DWord
): DWord; stdcall;
const
Size = 32;
TimeOut = 1000;
var
wsadata: TWSAData;
Address: DWord; // Address of host to contact
HostName, HostIP: String; // Name and dotted IP of host to contact
Phe: PHostEnt; // HostEntry buffer for name lookup
BufferSize, nPkts: Integer;
pReqData, pData: Pointer;
pIPE: PIcmpEchoReply; // ICMP Echo reply buffer
IPOpt: TIPOptionInformation; // IP Options for packet to send
const
IcmpDLL = ＇＇icmp.dll＇＇;
var
hICMPlib: HModule;
IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho;
hICMP: THandle; // Handle for the ICMP Calls
begin
// initialise winsock
Result:=True;
if WSAStartup(2,wsadata) <> 0 then begin
Result:=False;
halt;
end;
// register the icmp.dll stuff
hICMPlib := loadlibrary(icmpDLL);
if hICMPlib <> null then begin
@ICMPCreateFile := GetProcAddress(hICMPlib, ＇＇IcmpCreateFile＇＇);
@IcmpCloseHandle:= GetProcAddress(hICMPlib, ＇＇IcmpCloseHandle＇＇);
@IcmpSendEcho:= GetProcAddress(hICMPlib, ＇＇IcmpSendEcho＇＇);
if (@ICMPCreateFile = Nil) or (@IcmpCloseHandle = Nil) or (@IcmpSendEcho = Nil) then begin
Result:=False;
halt;
end;
hICMP := IcmpCreateFile;
if hICMP = INVALID_HANDLE_VALUE then begin
Result:=False;
halt;
end;
end else begin
Result:=False;
halt;
end;
// ------------------------------------------------------------
Address := inet_addr(PChar(IpAddr));
if (Address = INADDR_NONE) then begin
Phe := GetHostByName(PChar(IpAddr));
if Phe = Nil then Result:=False
else begin
Address := longint(plongint(Phe^.h_addr_list^)^);
HostName := Phe^.h_name;
HostIP := StrPas(inet_ntoa(TInAddr(Address)));
end;
end
else begin
Phe := GetHostByAddr(@Address, 4, PF_INET);
if Phe = Nil then Result:=False;
end;
if Address = INADDR_NONE then
begin
Result:=False;
end;
// Get some data buffer space and put something in the packet to send
BufferSize := SizeOf(TICMPEchoReply) + Size;
GetMem(pReqData, Size);
GetMem(pData, Size);
GetMem(pIPE, BufferSize);
FillChar(pReqData^, Size, $AA);
pIPE^.Data := pData;
// Finally Send the packet
FillChar(IPOpt, SizeOf(IPOpt), 0);
IPOpt.TTL := 64;
NPkts := IcmpSendEcho(hICMP, Address, pReqData, Size,
@IPOpt, pIPE, BufferSize, TimeOut);
if NPkts = 0 then Result:=False;
// Free those buffers
FreeMem(pIPE); FreeMem(pData); FreeMem(pReqData);
// --------------------------------------------------------------
IcmpCloseHandle(hICMP);
FreeLibrary(hICMPlib);
// free winsock
if WSACleanup <> 0 then Result:=False;
end
企业管理软件版7楼: 感谢楼上的，有没有代码简短又快速的方法？这个太长了，我怎么写在程序里啊？
而且看不懂啊，需要什么dll吗？能透过防火墙吗？再等高手另辟蹊径啊。
8楼: 定义一个过程;
procedure ErrorProc(Sender: TObject; E: Exception);
................
procedure TFrmMain.ErrorProc(Sender: TObject; E: Exception);
begin
try
if pos(＇＇[ConnectionWrite (send()).]General network error. Check your network documentation＇＇,E.message) > 0 then
begin
showmessage(＇＇网络不通＇＇ + #10#13 +＇＇对不起！＇＇);
application.Terminate;
end;
if pos(＇＇Violation of PRIMARY KEY constraint＇＇,E.message) > 0 then
begin
showmessage(＇＇主简重复！＇＇ + #10#13 +＇＇对不起！＇＇);
abort;
end;
if pos(＇＇[DBNETLIB][ConnectionOpen (Connect()).]＇＇,E.message) > 0 then
begin
showmessage(＇＇网络不通＇＇ + #10#13 +＇＇不通！＇＇);
application.Terminate;
end;
if Pos(＇＇Some values may have been changed＇＇, E.Message) > 0 then
showmessage(＇＇网络数据共享存取规则发生错误＇＇ + #10#13 +
＇＇您要改动的数据已经被其他人修改了！＇＇);
if Pos(＇＇Access violation at address＇＇, E.Message) > 0 then
myclass.showmessage(＇＇error＇＇,＇＇程序出现意外，请与 袁锋 联系＇＇);
except
// myclass.ShowMessage(＇＇error＇＇,＇＇程序出现意外，请与 袁锋 联系＇＇);
// application.Terminate; `
end;
end;
..............
procedure TFrmMain.FormCreate(Sender: TObject);
begin
application.OnException :=ErrorProc ;
end;
9楼: 这已经写成一个函数了，你直接拷过去，然后调用就行了，函数里怎么实现不用理它。我也是从网上考下来的，没测试过，不知道它检测有多快，如果太慢就用多线程吧。。。。。。。。。。。。。
10楼: 有别的方法吗？请认真看一下题目。
11楼: 如果做到这样也可以：客户端在没有安装SQLSERVER或MSDE的前提下，也没有安装SQL客户端
工具或其它dll文件，如何判断能不能连通一台SQL服务器？思路：ping 计算机的1433端口，
但是如何用Delphi程序获取是不是ping通了呢？
12楼: ApplicationEvents中捕抓连接中断的异常，
if ((pos(＇＇connection＇＇, lowercase(E.Message)) <> 0) or (pos(＇＇连接失败＇＇, lowercase(E.Message)) <> 0)) then
begin
showmessage(＇＇服务器连接发生故障，系统运行异常中断！＇＇);
******添加你所要处理的，如重新连接***********
end; 如进销存库存设计
13楼: 再开一个线程专门来检测网络连通状态，要求不影响主程序的正常操作，
（检测网络时屏幕不要死，即在后台检测网络），请给出详细代码，有会多线程的吗？
企业管理软件版14楼: 网络端开，程序可以判断到的，必然出现异常错误，
但是服务器端不会导致数据库错误的
15楼: 用InDv Clients 中的 TIdTelnet 控件
代码如下：
try
IdTelnet1.Host:=ServerIP;
IdTelnet1.Port:=1433;
IdTelnet1.Connect();
IdTelnet1.Disconnect;
except
LMDHiTimer2.Enabled:=false;
if MessageDlg(＇＇与数据库服务连接中断，是否重新连接数据库恢复（请确认数据库服务已正常启动）＇＇, mtConfirmation, [mbYes, mbNo], 0)=mrYes then
begin
DBPub.DbToll.Connected:=false;
DBPub.DbToll.Connected:=true;
LMDHiTimer2.Enabled:=true;
end
else
begin
LMDHiTimer2.Enabled:=true;
end;
end;
16楼: 你可以用IDUDP控件客户端装一个客户端每一秒钟发一个包去服务端难证一下!
17楼: 设置ConnectionTimeout 为 5~10 秒
18楼: 使用公文包模式，这样就不怕网络连接中断了！
19楼: 呵呵!楼上的说的有道理啊,不过估计楼主要改N多地方啊才能达到效果啊!
20楼: 最后无奈，只好写一个托盘小程序，实时检测ADOCONN的连接，不通时改写本地ini配置文件
企业管理软件版21楼: 可以这样做的。
try
post;
except
try
if not ado.connected then
ado.connect
else
begin
ado.close;
ado.open;
end;
post;
except
// 报错。。
end;
end;
22楼: 檢查數據庫看是否在這個Tstringlist表裡就可以了。如函數：
{=================================================================
功 能: 返回網絡中SQLServer列表
參 數: List: 需要填充的List
返回值: 成功: True,並填充List 失敗 False
=================================================================}
Function GetSQLServerList(var List: Tstringlist): boolean;
var
i: integer;
sRetValue: String;
SQLServer: Variant;
ServerList: Variant;
begin
Result := False;
List.Clear;
try
SQLServer := CreateOleObject(＇＇SQLDMO.Application＇＇);
ServerList := SQLServer.ListAvailableSQLServers;
for i := 1 to Serverlist.Count do
list.Add (Serverlist.item(i));
Result := True;
Finally
SQLServer := NULL;
ServerList := NULL;
end;
end; 如用友财务软件论坛
联系我们
