(老板每天都来逼啊)socketconnection通讯，服务端死锁现象 ( 积分: 146 )

小D用socketconnection通讯网上服务器，近段时间不知道是怎么回事情，经常出现服务端死掉的现象，不知道是何原因，网上服务端我也只写了两个方法，写入的数据很少，scktsrvr是注册在服务器里面的服务程序了。一旦死了，关掉服务端也不行，只能重启服务器........郁闷中，请大侠救我。

小D用socketconnection通讯网上服务器，近段时间不知道是怎么回事情，经常出现服务端死掉的现象，不知道是何原因，网上服务端我也只写了两个方法，写入的数据很少，scktsrvr是注册在服务器里面的服务程序了。一旦死了，关掉服务端也不行，只能重启服务器........郁闷中，请大侠救我。

是不是死连接造成的阿，scktsvr的timeout设置一个时间看看

那你介绍一下具体的情况了,scktsrvr.exe我觉得有bug,在多用户发送数据包的大小超过一定大小时特别容易死锁.

是我的服务端死了。

那你把ScktSrvr.exe关闭时服务端会不会恢复正常呢?

把socketconnection改成FREE模式就好了

怎么改成free模式！

服务器是不是双CPU或开了多线程啊？如果是，则要修改ScktSrvr.exe了，如果不是，那就不知为何了。

一个不错的问题，感兴趣，请允许订阅！

scktsrvr有bug, 我们用的都是修改过的.
在双CPU上的BUG在borland已经有了修改过后的代码(不是borland修改的,而是第三方).

to HydonLee :我不知道服务器上是否用了双cpu,现在急切的想知道如何解决我的问题,如果可以的话,请您发一份修改好以后scktsrvr给我
hongbinfang@hotmail.com

scktsrvr修改后的源码在delphi盒子上好像有一个，楼主可以试一下

手工启动scktsrvr.exe（可以写在注册表的run里），
不要在服务里启动scktsrvr.exe（很不稳定）！

to xianguo :如何写进注册表。
to 大家：现在确定了，是因为数据并发的时候，才出现死锁现象。

先确定不是程序本身的问题

我的意思是写在注册表中，做成自启动(必须登录)
在HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows/CurrentVersion/Run中增加字符串值
scktsrvr.exe 数值数据为 D:/Program Files/Borland/Delphi7/Bin/scktsrvr.exe
(路径根据实际情况调整)

lich,你也出现了啊
明天我贴代码，我感觉我写的服务端有点小问题，今天有客户说：远程调用出错。
不知道问题在哪里，还是请大家帮忙！

unit fMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus, ComCtrls, Global, ShellAPI, rdmDataSvr;
const
WM_TRAYICON = WM_USER + 1;
type
TfrmMain = class(TForm)
MainMenu: TMainMenu;
LogMemo: TMemo;
N1: TMenuItem;
Q1: TMenuItem;
StatusBar: TStatusBar;
PopupMenu: TPopupMenu;
miMainForm: TMenuItem;
miSetForm: TMenuItem;
N4: TMenuItem;
miQuit: TMenuItem;
procedure N1Click(Sender: TObject);
procedure Q1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure miSetFormClick(Sender: TObject);
procedure miQuitClick(Sender: TObject);
procedure miMainFormClick(Sender: TObject);
private
{ Private declarations }
dmtCurrent : TDateTime;
protected
procedure WMTrayIcon(var message:TMessage);
message WM_TRAYICON;
Procedure WMSysCommand(Var Msg : TMessage);Message WM_SYSCOMMAND;
public
{ Public declarations }
DataCommSvr : TDataCommSvr;
procedure AddLog(strLog: string);
end;

var
frmMain: TfrmMain;
implementation
{$R *.dfm}
uses fSet;
{ TfrmMain }
procedure ModifyTrayIcon(ActionWord);
var
FIconData: TNotifyIconData;
begin
with FIconDatado
begin
cbsize:=Sizeof(TNotifyIconData);
uid:=0;
uflags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
wnd:=frmMain.handle;
ucallbackmessage:=WM_TrayIcon;
hicon:=Application.Icon.Handle ;
strpcopy(sztip,Application.Title );
end;
Shell_NotifyIcon(Action,@FIconData);
end;

procedure TfrmMain.AddLog(strLog: string);
var
dmtDate: TDateTime;
strDateTime: string;
begin
dmtDate := DATE();
strDateTime := DateTimeToStr(Now);
if dmtCurrent<> dmtDate then
begin
CloseFile(LogFile);
dmtCurrent := dmtDate;
AssignFile(LogFile,ExtractFilePath(ParamStr(0))+'Log/CommSvr'+FormatDateTime('yyyymmdd',dmtCurrent)+'.Log');
if FileExists(ExtractFilePath(ParamStr(0))+'Log/CommSvr'+FormatDateTime('yyyymmdd',dmtCurrent)+'.Log') then
Append(LogFile)
else
Rewrite(LogFile);
LogMemo.Clear ;
end;
LogMemo.Lines.Add(format('%s :%s',[strDateTime, strLog]));
WriteLogFile(format('%s :%s',[strDateTime, strLog]));
end;

procedure TfrmMain.N1Click(Sender: TObject);
begin
frmSet.ShowSetFrm;
end;

procedure TfrmMain.Q1Click(Sender: TObject);
begin
Close;
end;

procedure TfrmMain.FormShow(Sender: TObject);
var
boolReaded : Boolean;
begin
ModifyTrayIcon(NIM_DELETE);
AddLog('正在读取系统配置参数.....');
while truedo
begin
boolReaded := ReadConfig ;
if not boolReaded then
if Application.MessageBox('是否设置系统参数？', '操作提示',
MB_YESNO or MB_ICONWARNING)=IDYES then
frmSet.ShowSetFrm
else
begin
AddLog('读取系统配置参数.....失败，监听服务未能启动');
break;
end
else
break;
end;
if boolReaded then
begin
AddLog('读取系统配置参数.....成功！');
DataCommSvr := TDataCommSvr.Create(frmMain);
Application.ProcessMessages;
if not DataCommSvr.ConnectDB(true) then
frmSet.ShowSetFrm
else
StatusBar.Panels[0].Text := '状态：启动监听于'+FormatDateTime('yyyy-mm-dd',date())+' '+FormatDateTime('hh:mm:ss',time());
end;
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
if Application.MessageBox('退出数据通讯服务器将不能接受客户端的数据，是否确定退出？', '操作提示',
MB_YESNO or MB_ICONWARNING)=IDYES then
begin
CanClose := true;
end
else
begin
CanClose := false ;
end;
end;

procedure TfrmMain.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
try
DataCommSvr.DisConnectDB ;
DataCommSvr.Free ;
CloseFile(LogFile);
ModifyTrayIcon(NIM_DELETE);
except
end;

Application.Terminate;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
ForceDirectories(ExtractFilePath(ParamStr(0))+'Log/');
dmtCurrent := Date();
try
LogMemo.Text := LoadLogFile;
AssignFile(LogFile,ExtractFilePath(ParamStr(0))+'Log/CommSvr'+FormatDateTime('yyyymmdd',dmtCurrent)+'.Log');
if FileExists(ExtractFilePath(ParamStr(0))+'Log/CommSvr'+FormatDateTime('yyyymmdd',dmtCurrent)+'.Log') then
Append(LogFile)
else
Rewrite(LogFile);
except
end;
end;

procedure TfrmMain.miSetFormClick(Sender: TObject);
begin
frmSet.ShowSetFrm ;
end;

procedure TfrmMain.miQuitClick(Sender: TObject);
begin
Close;
end;

procedure TfrmMain.WMTrayIcon(var Message: TMessage);
var
pt: TPoint;
begin
case Message.LParam of
WM_RBUTTONUP:
begin
if not Visible then
begin
SetForegroundWindow(Handle);
GetCursorPos(pt);
PopupMenu.Popup(pt.x, pt.y);
end
else
SetForegroundWindow(Handle);
end;
WM_LBUTTONDBLCLK:
if Visible then
SetForegroundWindow(Handle)
else
miMainFormClick(nil);
end;
end;

procedure TfrmMain.miMainFormClick(Sender: TObject);
begin
frmMain.Visible :=true;
end;

procedure TfrmMain.WMSysCommand(var Msg: TMessage);
begin
case Msg.WParam of
SC_MINIMIZE: begin
Msg.WParam:=0;
ModifyTrayIcon(NIM_ADD);
Application.MainForm.Visible:=False;
end;
SC_CLOSE :begin
Msg.WParam :=0;
ModifyTrayIcon(NIM_ADD);
Application.MainForm.Visible:=false;
end;
end;
Inherited;
end;

end.

unit fSet;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, ComCtrls, DB, DBTables, Global;
type
TfrmSet = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
btnTestConnect: TButton;
txtUserName: TEdit;
txtServerName: TEdit;
txtUserPwd: TEdit;
txtDataBaseName: TEdit;
cbType: TComboBox;
btnOK: TBitBtn;
btnCancel: TBitBtn;
db_Test: TDatabase;
procedure FormCreate(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure btnTestConnectClick(Sender: TObject);
private
{ Private declarations }
function CheckData: Boolean;
procedure TestConnect;
public
{ Public declarations }
function ShowSetFrm: Boolean;
end;

var
frmSet: TfrmSet;
implementation
uses fMain;
{$R *.dfm}
procedure TfrmSet.FormCreate(Sender: TObject);
begin
txtServerName.Text := gsServerName;
txtDataBaseName.Text := gsDataBaseName;
txtUserName.Text := gsUserName;
txtUserPwd.Text := gsUserPwd;
end;

procedure TfrmSet.btnCancelClick(Sender: TObject);
begin
Close;
end;

procedure TfrmSet.btnOKClick(Sender: TObject);
begin
if CheckData then
begin
gsDriver := cbType.Text;
gsDataBaseName := txtDataBaseName.Text;
gsServerName := txtServerName.Text;
gsUserName := txtUserName.Text;
gsUserPwd := txtUserPwd.Text;
if not WriteConfig then
application.MessageBox('保存系统参数失败！','系统提示',MB_OK)
else
begin
application.MessageBox('系统参数如有改动，请重新启用程序！','系统提示',MB_OK);
frmMain.AddLog('修改系统参数');
end;
end;
Close;
end;

procedure TfrmSet.TestConnect;
begin
if CheckData then
begin
try
db_Test.LoginPrompt := False;
db_Test.DriverName := cbType.Text;
db_Test.Params.Values['DATABASE NAME'] := txtDataBaseName.Text;
db_Test.Params.Values['SERVER NAME'] := txtServerName.Text;
db_Test.Params.Values['USER NAME'] := txtUserName.Text;
db_Test.Params.Values['PASSWORD'] := txtUserPwd.Text;
db_Test.Connected := True;
except on e:exceptiondo
begin
application.MessageBox(pchar('连接失败：'+e.message),'系统提示',MB_OK);
exit;
end;
end;
application.MessageBox('测试连接成功!','系统提示',MB_OK);
db_Test.Close ;
end;
end;

function TfrmSet.CheckData: Boolean;
begin
Result := false;
if txtServerName.Text = '' then
begin
txtServerName.SetFocus;
application.MessageBox('服务器名不能为空!','操作提示',MB_OK+MB_ICONINFORMATION);
exit;
end;
if txtDataBaseName.Text = '' then
begin
txtDataBaseName.SetFocus;
application.MessageBox('数据库名不能为空!','操作提示',MB_OK+MB_ICONINFORMATION);
exit;
end;
if txtUserName.Text = '' then
begin
txtUserName.SetFocus;
application.MessageBox('用户名不能为空!','操作提示',MB_OK+MB_ICONINFORMATION);
exit;
end;
Result := true;
end;

function TfrmSet.ShowSetFrm: Boolean;
begin
result := true;
frmSet := TfrmSet.Create(Application);
try
frmSet.ShowModal;
finally
frmSet.Free;
end;

end;

procedure TfrmSet.btnTestConnectClick(Sender: TObject);
begin
TestConnect;
end;

end.

unit Global;
interface
uses SysUtils, Classes, inifiles;
const
sIniFile :string = 'CommServer.ini';
var
gsDriver : string;
gsServerName : string;
gsDataBaseName : string;
gsUserName : string;
gsUserPwd : string;
LogFile : TextFile;
function TransChar(AChar: Char): Integer;
function HexToStr(AStr: string): string;
function StrToHex(AStr: string): string;
function Decrypt(S: String): String;
//解密函数
function Encrypt(const S: String): String;
//加密函数
function ReadConfig: Boolean;
function WriteConfig: Boolean;
function WriteLogFile(sLog: string): Boolean;
function LoadLogFile: string;
function SplitStr(const sSource, sSeparator: string;
var RetStr: array of string): integer;

implementation
uses fMain;
function TransChar(AChar: Char): Integer;
begin
if AChar in ['0'..'9'] then
Result := Ord(AChar) - Ord('0')
else
Result := 10 + Ord(AChar) - Ord('A');
end;

function StrToHex(AStr: string): string;
var
I : Integer;
begin
Result := '';
For I := 1 to Length(AStr)do
Result := Result + IntToHex(Byte(AStr), 2);
end;

function HexToStr(AStr: string): string;
var
I : Integer;
CharValue: Word;
begin
Result := '';
For I := 1 to Trunc(Length(Astr)/2)do
begin
Result := Result + ' ';
CharValue := TransChar(AStr[2*I-1])*16 + TransChar(AStr[2*I]);
Result := Char(CharValue);
end;
end;

function Encrypt(const S: String): String;
var
I : Integer;
AKey: Word;
LockKey, BegKey, EndKey: integer;
begin
LockKey := 13;
BegKey := 53523;
EndKey := 32768;
//得到加密字符
AKey := LockKey;
Result := S;
for I := 1 to Length(S)do
begin
Result := char(byte(S) xor (AKey shr 8));
AKey := (byte(Result) + AKey) * BegKey + EndKey;
if Result = Chr(0) then
Result := S;
end;
Result := StrToHex(Result);
end;

function Decrypt(S: String): String;
var
I: Integer;
AKey: Word;
LockKey, BegKey, EndKey: integer;
begin
LockKey := 13;
BegKey := 53523;
EndKey := 32768;
S := HexToStr(S);
Result := S;
AKey := Lockkey;
for I := 1 to Length(S)do
begin
if char(byte(S) xor (AKey shr 8)) = Chr(0) then
begin
Result := S;
AKey := (byte(Chr(0)) + AKey) * BegKey + EndKey;
//保证Key的正确性
end else
begin
Result := char(byte(S) xor (AKey shr 8));
AKey := (byte(S) + AKey) * BegKey + EndKey;
end;
end;
end;

function SplitStr(const sSource, sSeparator: string;
var RetStr: array of string): integer;
var
i, upbound, len: integer;
temp, s, sp: widestring;
begin
Result := 0;
temp := '';
upbound := 0;
s := trim(sSource);
len := Length(s);
sp := trim(sSeparator);
if (s = '') or (not Length(sp) = 1) then
begin
exit;
end;

if pos(sp, s) = 0 then
begin
RetStr[upbound] := s;
Result := 1;
Exit;
end;

for i := 1 to lendo
begin
if copy(s, i, 1) = sp then
begin
if upbound > High(RetStr) then
begin
Result := upbound;
Exit;
end;
RetStr[upbound] := temp;
temp := '';
upbound := upbound + 1;
end
else
begin
temp := temp + copy(s, i, 1);
end;
end;
if upbound > High(RetStr) then
Result := upbound
else
begin
RetStr[upbound] := temp;
//the last substr
Result := upbound + 1;
end;
end;
function ReadConfig: Boolean;
var
iniFile: TIniFile;
sPassWord : string;
begin
Result := false;
if FileExists(ExtractFilePath(ParamStr(0))+sIniFile) then
begin
iniFile := TIniFile.Create(ExtractFilePath(ParamStr(0))+sIniFile);
try
gsDriver := iniFile.ReadString('SYSINFO','DatabseDriver', '');
gsServerName := iniFile.ReadString('SYSINFO','DbServerName', '');
gsDataBaseName := iniFile.ReadString('SYSINFO','DataBaseName', '');
gsUserName := iniFile.ReadString('SYSINFO','DataBaseUser', '');
sPassWord := iniFile.ReadString('SYSINFO','DataBasePass', '');
if sPassWord <> '' then
gsUserPwd := Decrypt(sPassWord)
else
gsUserPwd := '';
Result := true;
finally
iniFile.Free;
end;
end;
if (gsServerName='') or (gsDataBaseName='') or (gsUserName='') then
Result := false;
end;

function WriteConfig: Boolean;
var
iniFile: TIniFile;
sPassWord : string;
begin
Result := false;
iniFile := TIniFile.Create(ExtractFilePath(ParamStr(0))+sIniFile);
try
iniFile.WriteString('SYSINFO','DatabseDriver', gsDriver);
iniFile.WriteString('SYSINFO','DbServerName', gsServerName);
iniFile.WriteString('SYSINFO','DataBaseName', gsDataBaseName);
iniFile.WriteString('SYSINFO','DataBaseUser', gsUserName);
if gsUserPwd <> '' then
sPassWord := Encrypt(gsUserPwd)
else
sPassWord := '';
iniFile.WriteString('SYSINFO','DataBasePass', sPassWord);
Result := true;
finally
iniFile.Free;
end;
end;

function WriteLogFile(sLog: string): Boolean;
begin
Result := false;
try
Writeln(LogFile,sLog);
Flush(LogFile);
except
exit;
end;
Result := true ;
end;

function LoadLogFile: string;
var
sLogFileName: string;
sList: TStringList;
begin
Result := '';
sList := TStringList.Create;
sLogFileName := ExtractFilePath(ParamStr(0))+'Log/CommSvr'+FormatDateTime('yyyymmdd',date())+'.Log';
if FileExists(sLogFileName) then
begin
sList.LoadFromFile(sLogFileName);
Result := sList.Text ;
end;
sList.Free ;
end;

end.

to xianguo:
写进注册表不实际，因为写进注册表，当服务器重启的时候，必须登陆才能启动服务端，而写进服务却不用。