我的一个同样的问题，但没有实现你们的功能？不能排除系统错误提示。
代码如下：
procedure Tfx_Login.FormCreate(Sender: TObject);
begin
{
//搜寻表看是否程序已运行
if GlobalFindAtom('PROGRAM_RUNNING') = 0 then
// 如果没运行,则在表中增加信息
//atom:=GlobalAddAtom('PROGRAM_RUNNING')
atom := PChar(GlobalAddAtom('PROGRAM_RUNNING'))
else
begin
// 如果程序已运行,则显示信息然后退出
MessageDlg('你的等程序已运行!', mtWarning,[mbOK], 0);
Halt;
end;
}
Fx_FileName:=ExtractFilePath(application.ExeName)+'fxxs.ini';
sysfxxs:=TiniFile.create(Fx_FileName);
socketconnection1.Address:=sysfxxs.ReadString('远程配置','服务器IP地址','127.000.000.000');
clientsocket1.Address:=socketconnection1.Address;
clientsocket1.Port:=socketconnection1.Port;
timer1.Enabled:=false;
timer1.Interval:=5000;
//socketconnection1.Connected:=true;
clientsocket1.Active:=true;
timer1.Enabled:=true;
//socketconnection1.Connected:=true;
clientdataset1.Active:=true;
//except
// application.MessageBox('一般网络故障，请与系统管理员联系!','提示',mb_OK);
// showmessage ('测试');
}
edtpassword.Text:='';
cbbName.Items.Clear;
with clientdataset1do
while not eofdo
begin
cbbName.Items.Add(fieldbyName('fcuser_name').AsString);
next;
end;
// end;
cbbName.ItemIndex:=0;
end;
procedure Tfx_Login.bttExitClick(Sender: TObject);
begin
close;
end;
procedure Tfx_Login.bbtOKClick(Sender: TObject);
begin
clientdataset1.Close;
clientdataset1.CommandText:='select * from fx_user where fcUser_name='''+cbbName.Text+'''';
clientdataset1.open;
if clientdataset1.FieldByName('fcpassword').asstring <> edtpassword.Text then
begin
application.MessageBox('操作员密码有误!','系统信息',mb_OK+MB_iconerror);
exit;
edtPassword.SetFocus;
end
else
begin
UserCode:=clientdataset1.fieldbyname('fcUser_id').AsString;
UserName:=clientdataset1.fieldbyname('fcUser_name').AsString;
UserAdmin:=clientdataset1.FieldByName('fiAdmin').IsBlob;
UserRight:=clientdataset1.fieldbyname('fcRight').asstring;
ModalResult:=idOK;
end
end;
procedure Tfx_Login.FormDestroy(Sender: TObject);
begin
//Globaldeleteatom(Word(atom));
end;
procedure Tfx_Login.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
socketconnection1.Connected:=true;
end;
procedure Tfx_Login.Timer1Timer(Sender: TObject);
begin
(sender as ttimer).Enabled:=false;
clientsocket1.Active:=false;
if not socketconnection1.Connected then
showmessage ('连接失败,时间:'+inttostr(timer1.Interval div 1000)+'秒');
end;
procedure Tfx_Login.SocketConnection1AfterConnect(Sender: TObject);
begin
//showmessage ('成功的连接到服务器');
end;
procedure Tfx_Login.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
var
msg:string;
begin
case ErrorCode of
10061: msg:='对方服务器没有开通 Socket Server 服务';
10054: msg:='对方没开机';
else
msg:='连接失败!';
end;
ErrorCode:=0;
timer1.Enabled:=false;
showmessage(msg);
end;
end.
