TClient/ServerSocket下的通讯程序，客户端无故自动关闭（简直就是一个自杀文件！）(100分)

想砸机器先 （可是砸了机器就不能发贴来问了，还是先把它的脑袋寄存在身体旁边，
等我实在受不了的时候。 嘿嘿）

我为什么要砸它？！ 那我就慢慢道来了

我编了一个局时网内部校时的软件，分客户端和服务器端 两个独立的工程啦。

校时部分用的是 TidTime 的控件。 网络的信息通讯使用的是 TServerSocket and
TClientSocket ，在设计和运行期间都还正常。

主要功能有　客户端开机时校时，每隔多久自动校时一次（小时级别的），可以手动
校时　　服务器端可以查看当前有多少台客户端　可以强行要求没台客户机自动校时。

现在　技术方面我遇到的问题都　在　大富翁　这里搜索得到答案　解决了。
（好象现在，我发消息的时候，不能登陆　大富翁　的全文检索　的　网站　555555）

在测试的时候 ，问题来了： 服务器端开在这里。 在局域网内其他机器上运行 客户端
的软件，一切正常 就是【运行大约 五 分钟后 客户端程序自动关闭 ] 了。 我屡试屡
自动关闭。我急死了。 本来以为要交差了的事情，冒出一个莫名其妙的问题来。

注：当客户端与服务器端都同在一台机器上的时候却是相安无事的。 客户端不自动关闭的。

太郁闷了。 请问大家遇到过这样的问题没有啊 。

注： 我使用的 1024 端口（用其他的也试了，照旧）

如果没遇到过 ，也可以一起来讨论 讨论嘛。 有奖竟猜也行啊

把你的程序贴出来看看

客户端程序 5 个 UNIT 代码太多了

贴什么好啊。。

我把 主的 程序贴出来吧

unit U_Main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Registry, Menus, ExtCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdTime, ShellAPI, AppEvnts, XPMenu, ImgList,
ScktComp, U_LogFile;

const
g_REG_InfoPath = '/Fortune/NetTime/Client';
g_Soft_Name = 'NetTime_Client';
g_REG_AutoRun = 'Software/Microsoft/Windows/CurrentVersion/Run';
wm_icb=wm_user + 1000; //定义用户消息

type
TFrm_Main = class(TForm)
DaytimePopupMenu: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
A1: TMenuItem;
X1: TMenuItem;
IdTime_Adjust: TIdTime;
Timer_Adjust: TTimer;
ApplicationEvents1: TApplicationEvents;
ImageList1: TImageList;
ClientSocket_Timer: TClientSocket;
Timer_AutoRun: TTimer;
XPMenu1: TXPMenu;
procedure FormCreate(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer_AdjustTimer(Sender: TObject);
procedure ApplicationEvents1Minimize(Sender: TObject);
procedure X1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure A1Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure Timer_AutoRunTimer(Sender: TObject);
procedure DaytimePopupMenuPopup(Sender: TObject);
procedure ClientSocket_TimerRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket_TimerError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
private
{ Private declarations }
procedure WMSysCommand(var msg: TMessage);message wm_syscommand;
procedure TestIsOnService;
public
{ Public declarations }
procedure wmicb(var msg:Tmessage); message wm_icb;
end;

var
Frm_Main: TFrm_Main;
TimeIcon:TNotifyIcondata;

temp_i:integer;

isBusy :boolean;
isServiceRun :boolean;

Ser_IP :string;
isReceivePssive :boolean;
isAutoRun :boolean;
isAutoAdjust :boolean;
Interval_H :integer;

procedure ExportREGInfo(var e_Ser_IP:string;var e_isReceivePssive,e_isAutoRun,e_isAutoAdjust:boolean; var e_Interval:integer);
procedure SaveREGInfo(const s_Ser_IP:string;const s_isReceivePssive,s_isAutoRun,s_isAutoAdjust:boolean; const s_Interval:integer);
function StartUpMyProgram( strPrompt,strExeFileName : string ): boolean;
function DeleteUpMyProgram( strPrompt: string ): boolean;
procedure fun_AdjustTime(const a_AdjustType:U_LogFile.TEvent);

implementation

uses U_Config, U_About, U_System, U_ICM_Ping, U_PopUp;
var
m_ReceiveCommand:string;

{$R *.dfm}

procedure TFrm_Main.wmicb(var msg:Tmessage);
var pt:Tpoint;
begin
GetCursorPos(pt);

case msg.lParam of
WM_RButtonDown:
begin
//鼠标右键被按下
SetForegroundWindow(Frm_Main.Handle);
Frm_Main.DaytimePopupMenu.Popup(pt.x,pt.y);
end;
WM_LBUTTONDBLCLK:
begin
N1Click(self);
end
else//调用父类的WndProc方法处理其它消息
inherited;
end;
end;

procedure TFrm_Main.WMSysCommand(var msg: TMessage);
begin
if msg.WParam = SC_MINIMIZE then
begin
showwindow(application.handle,sw_hide);
inherited;
end else
inherited;
end;

procedure TFrm_Main.FormCreate(Sender: TObject);
var
c_I_REG:TRegistry;
str_Input_Ser_IP:string;
begin

temp_i:=0;

FormStyle:=fsStayOnTop;
c_I_REG:=TRegistry.Create;
c_I_REG.RootKey:=HKEY_CURRENT_USER;
with c_I_REG do
if not KeyExists(g_REG_InfoPath) then
begin
StartUpMyProgram(g_Soft_Name,ExpandFileName(Application.Exename));

CreateKey(g_REG_InfoPath);
OpenKey(g_REG_InfoPath,False);
str_Input_Ser_IP:=InputBox('输入提示','请输入时钟服务器的IP地址','192.168.0.1');
WriteString('Ser_IP',str_Input_Ser_IP);
WriteBool('isReceivePssive',true);
WriteBool('isAutoRun',True);
WriteBool('isAutoAdjust',True);
WriteInteger('Interval_H',3);
CloseKey;
Free;
end;

ExportREGInfo(Ser_IP,isReceivePssive,isAutoRun,isAutoAdjust,Interval_H);
Timer_Adjust.Enabled:=isAutoAdjust;
Timer_Adjust.Interval:=1000 * Interval_H * 60 * 60;
//Timer_Adjust.Interval:=5000 * Interval_H ;

TimeIcon.cbSize:=Sizeof(TNotifyIcondata); //以下是当时间服务启动后，将应
TimeIcon.wnd:=handle; //用程序图标显示在系统托盘中
TimeIcon.uID:=0;
TimeIcon.uFlags:=nif_Message or nif_tip or nif_Icon;
TimeIcon.uCallbackMessage:=wm_icb;
TimeIcon.Sztip:='网时通 客户端 V0.1';
TimeIcon.hIcon:=Application.Icon.Handle;

if not Shell_NotifyIcon(NIM_ADD,@TimeIcon) then
begin
ShowMessage('创建托盘图标失败！');
end;

Timer_AutoRun.Enabled:=true;
isBusy:=false;
isServiceRun:=true;
ClientSocket_Timer.Port:=1024;
TestIsOnService;
end;

procedure ExportREGInfo(var e_Ser_IP:string;var e_isReceivePssive,e_isAutoRun,e_isAutoAdjust:boolean; var e_Interval:integer);
var
e_REG:TRegistry;
begin
//从注册表读取新信息
e_REG:=TRegistry.Create;
e_REG.RootKey:=HKEY_CURRENT_USER;

with e_REG do
begin
OpenKey(g_REG_InfoPath ,False);
e_Ser_IP:=ReadString('Ser_IP');
e_isReceivePssive:=ReadBool('isReceivePssive');
e_isAutoRun:=ReadBool('isAutoRun');
e_isAutoAdjust:=ReadBool('isAutoAdjust');
e_Interval:=ReadInteger('Interval_H');

CloseKey;
free;
end;
end;

procedure SaveREGInfo(const s_Ser_IP:string;const s_isReceivePssive,s_isAutoRun,s_isAutoAdjust:boolean; const s_Interval:integer);
var
s_REG:TRegistry;
begin
s_REG:=TRegistry.Create;
s_REG.RootKey:=HKEY_CURRENT_USER;

with s_REG do
begin
if not KeyExists(g_REG_InfoPath) then
CreateKey(g_REG_InfoPath);

OpenKey(g_REG_InfoPath,False);
WriteString('Ser_IP',s_Ser_IP);
WriteBool('isReceivePssive',isReceivePssive);
WriteBool('isAutoRun',s_isAutoRun);
WriteBool('isAutoAdjust',s_isAutoAdjust);
WriteInteger('Interval_H',s_Interval);

CloseKey;
Free;
end;

Ser_IP:=s_Ser_IP;
isReceivePssive:=s_isReceivePssive;
isAutoRun:=s_isAutoRun;
isAutoAdjust:=s_isAutoAdjust;
Interval_H:=s_Interval;

end;


function StartUpMyProgram( strPrompt,strExeFileName : string ): boolean;
var
registerTemp : TRegistry;
begin
registerTemp := TRegistry.Create; //建立一个Registry实例
with registerTemp do
begin
RootKey:=HKEY_LOCAL_MACHINE;//设置根键值为HKEY_LOCAL_MACHINE
//找到Software/Microsoft/Windows/CurrentVersion/Run
if OpenKey(g_REG_AutoRun,True) then
//写入自己程序的快捷方式信息
begin
WriteString( strPrompt, strExeFileName );
result := true;
end else
result := false;
//善后处理
CloseKey;
Free;
end;
end;

function DeleteUpMyProgram( strPrompt: string):boolean;
var
registerTemp : TRegistry;
begin
registerTemp := TRegistry.Create;
registerTemp.RootKey := HKEY_LOCAL_MACHINE;
with registerTemp do
try
OpenKey(g_REG_AutoRun,False);
if DeleteValue(strPrompt) then
result := true
else
result := false;
finally
Closekey;
Free;
end;
end;

procedure fun_AdjustTime(const a_AdjustType:U_LogFile.TEvent);

function AdjustTime:Boolean;
var
System_Time:TSystemTime;
begin
try
Frm_Main.IdTime_Adjust.Host:=Ser_IP; //赋服务器IP地址
if Frm_Main.IdTime_Adjust.Connected then
ShowMessage('NetTimer Server connected');
DateTimeToSystemTime(Frm_Main.IdTime_Adjust.DateTime,System_Time);
SetLocalTime(System_Time); //将获得的时间设置成本地时钟，达到校时的目的
result:=true;
except //异常处理
result:=false;
end;
end;

begin
if U_ICM_Ping.fun_Conn_Ping(Ser_IP,'Hello NetTimer Client!',1000) then
begin
//时钟服务器能够ping通
{ if isServiceRun then}
Frm_Main.TestIsOnService;
if (not AdjustTime) then
begin
U_LogFile.AddLog(a_AdjustType,r_Failed);
U_PopUp.SetPopUpActive(a_AdjustType,r_Failed);
end else
begin
U_LogFile.AddLog(a_AdjustType,r_Success);
U_PopUp.SetPopUpActive(a_AdjustType,r_Success);
end
{
else
begin
U_LogFile.AddLog(a_AdjustType,r_UnService);
U_PopUp.SetPopUpActive(a_AdjustType,r_UnService);
isServiceRun:=true;
end;
}
end else
begin
U_LogFile.AddLog(a_AdjustType,r_DisPing);
U_PopUp.SetPopUpActive(a_AdjustType,r_DisPing);
end;
end;

procedure TFrm_Main.N3Click(Sender: TObject);
begin
Application.CreateForm(TFrm_Config, Frm_Config);
Frm_Config.ShowModal;
end;

procedure TFrm_Main.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if not Shell_NotifyIcon(NIM_delete,@TimeIcon) then
begin
ShowMessage('删除托盘图表失败！');
end;
ClientSocket_Timer.Active:=false;
Action:=caFree;
end;

procedure TFrm_Main.Timer_AdjustTimer(Sender: TObject);
begin
if isAutoAdjust then
fun_AdjustTime(e_Auto)
end;

procedure TFrm_Main.ApplicationEvents1Minimize(Sender: TObject);
begin
ShowWindow(Application.Handle,SW_HIDE);
end;

procedure TFrm_Main.X1Click(Sender: TObject);
begin
close;
end;

procedure TFrm_Main.N2Click(Sender: TObject);
begin
fun_AdjustTime(e_Manual);
end;

procedure TFrm_Main.A1Click(Sender: TObject);
begin
Application.CreateForm(Tfrm_About,frm_About);
frm_About.ShowModal;
end;

procedure TFrm_Main.N1Click(Sender: TObject);
begin
Application.CreateForm(TFrm_System, Frm_System);
Frm_System.Show;
end;

procedure TFrm_Main.Timer_AutoRunTimer(Sender: TObject);
begin
Timer_AutoRun.Enabled:=false;
if isAutoRun then
fun_AdjustTime(e_Start);
end;

procedure TFrm_Main.DaytimePopupMenuPopup(Sender: TObject);
begin
if isBusy then
begin
N1.Enabled:=false;
N2.Enabled:=false;
N3.Enabled:=false;
A1.Enabled:=false
end else
begin
N1.Enabled:=true;
N2.Enabled:=true;
N3.Enabled:=true;
A1.Enabled:=true;
end;

end;

procedure TFrm_Main.ClientSocket_TimerRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
m_ReceiveCommand:=Socket.ReceiveText;

if (m_ReceiveCommand='a') and isReceivePssive then
fun_AdjustTime(e_Passive);
end;

procedure TFrm_Main.ClientSocket_TimerError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
temp_i:=temp_i+1;
ErrorCode:=0;
case ErrorEvent of
eeConnect:
begin
Socket.close;
isServiceRun :=false;
end;
end
end;

procedure TFrm_Main.TestIsOnService;
begin
ClientSocket_Timer.Active:=false;
ClientSocket_Timer.Address:=Ser_IP;
ClientSocket_Timer.Open;
end;

end.

就请大家想想 有什么东东 能让一个程序突然的 自杀呢？！

知道的就说说看嘛 我急啊 。！！ 多谢了

还请帮忙顶啦。。

先帮你顶一下吧！！
苦命的人，我把源程序拷回家看看！！

ErrorCode:=0;
case ErrorEvent of
eeConnect:
begin
Socket.close;
isServiceRun :=false;
end;
end
不一定只有eeConnect错误才要关闭套接字，比如10053和10054错误也必须关闭套接字，而你又用ErrorCode:=0;关闭了错误信息，所以客户端会无声无息地over。
建议你用日志跟踪一下套接字的错误信息，看看是哪一个错误码导致套接字死掉，然后Socket.close

楼上,请问到底什么原因会出现10053错误?我这里也经常出这个错,服务器端不是我写的,但我要写客户端.老是连上之后,发个信息过去,过十来钞之后就出现10053错误了.

多人接受答案了。