idTcpServer服务器，几个小时就死，求解！附代码

这里是窗体里的部分关键代码type
  {用户的增，删，刷新指令}
  TRefreshParam = (rpRefreshAll, rpAppendItem, rpDeleteItem);
  {用户的请求指令}
  TSendCmdParam = (Data, List, Inst, Mdfy, Lgin, Dele, WebL, AWeb, MWeb, DWeb, SWeb, Visi, Excb);
  PCmdRec = ^TCmdRec;
  TCmdRec = record
    Cmd: string;
  end;
  TFIndex = class(TForm)
    Timer1: TTimer;
    pmClearMemo: TPopupMenu;
    miClearLog: TMenuItem;
    pmRefresh: TPopupMenu;
    mmiRefresh: TMenuItem;
    IdTCPServer: TIdTCPServer;
    IdSchedulerOfThreadPool1: TIdSchedulerOfThreadPool;
    Memo1: TMemo;
    StatusBar1: TStatusBar;
    lvUsers: TListView;
    ckisLog: TCheckBox;
    procedure IdTCPServerException(AContext: TIdContext; AException: Exception);
    procedure IdTCPServerConnect(AContext: TIdContext);
    procedure IdTCPServerDisconnect(AContext: TIdContext);
    procedure IdTCPServerExecute(AContext: TIdContext);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure miClearLogClick(Sender: TObject);
    procedure mmiRefreshClick(Sender: TObject);
    procedure ckisLogClick(Sender: TObject);
  private
    FSqlConnStr: string;
    FUsers: TThreadList;
    FIsShowLog: Boolean;
    AppPath: string;
    DAndE: TDESCrypt;
    FLockUI: TCriticalSection;
    procedure LockUI;
    procedure UnlockUI;
    procedure InitApp;
    procedure LogInMemo(const S: string);
    //不同指令
    procedure SendFileToUser(AUser: TUser; const FileName: string);
    procedure SendStrmToUser(AUser: TUser; const DataStr: string);
    procedure SendLognToUser(AUser: TUser; const DataStr: string);
    procedure SendModyToUser(AUser: TUser; const DataStr: string);
    procedure SendInstToUser(AUser: TUser; const DataStr: string);
    procedure SendDeleToUser(AUser: TUser; const DataStr: string);
    procedure SendWebLToUser(AUser: TUser; const DataStr: string);
    procedure SendAWebToUser(AUser: TUser; const DataStr: string);
    procedure SendMWebToUser(AUser: TUser; const DataStr: string);
    procedure SendDWebToUser(AUser: TUser; const DataStr: string);
    procedure SendSWebToUser(AUser: TUser; const DataStr: string);
    procedure SendVisiToUser(AUser: TUser; const DataStr: string);
    procedure SendExcbToUser(AUser: TUser; const DataStr: string);
    //不同指令的执行方法
     function UserLogin(DataStr: string): string;
    function GetDataListUser(DataStr: string): Tmemorystream;
    function InsertServer(DataStr: string): string;
    function ModifyServer(DataStr: string): string;
    function DeleteServer(DataStr: string): string;
    function GetWebList(DataStr: string): Tmemorystream;
    function AddWebSite(DataStr: string): string;
    function MdyWebSite(DataStr: string): string;
    function DelWebSite(DataStr: string): string;
    function SrtWebSite(DataStr: string): string;
    function MirVisible(DataStr: string): string;
    function Exchangedb(DataStr: string): string;
    function SafeUserData(var UserSendDataStr, SqlUID: string): Boolean;    //用户列表相关操作
    procedure WMRefreshUsers(var msg: TMessage); message WM_REFRESH_USERS;
    procedure RefreshUsersInListView;
    procedure DeleteUserInListView(AClient: TUser);
    procedure AddUserInListView(AClient: TUser);
  end;var
  FIndex: TFIndex;
  FormHanlde: HWND = 0;procedure TFIndex.FormCreate(Sender: TObject);
begin
  FormHanlde := Self.Handle;
  AppPath := ExtractFilePath(Paramstr(0));
  DAndE := TDESCrypt.Create;
  FUsers := TThreadList.Create;
  FLockUI := TCriticalSection.Create;
  FIsShowLog := false;
  InitApp;
  IdTCPServer.Active := True;
end;procedure TFIndex.LockUI;
begin
  FLockUI.Enter;
end;procedure TFIndex.UnlockUI;
begin
  FLockUI.Leave;
end;procedure TFIndex.LogInMemo(const S: string);
begin
  LockUI;
  try
    Memo1.Lines.Add(S);
  finally
    UnlockUI;
  end;
end;
procedure TFIndex.Timer1Timer(Sender: TObject);
var ConnCount: Integer;
  lst: Tlist;
begin
  lst := IdTCPServer.Contexts.LockList;
  try
    ConnCount := lst.Count;
    StatusBar1.Panels[0].Text := format('当前线程数为[%d]', [ConnCount]);
  finally
    IdTCPServer.Contexts.UnlockList;
  end;
end;

procedure TFIndex.WMRefreshUsers(var msg: TMessage);
begin
  if msg.msg = WM_REFRESH_USERS then
  begin
    case TRefreshParam(msg.WParam) of
      rpRefreshAll:
        begin
          RefreshUsersInListView;
        end;
      rpAppendItem:
        begin
          AddUserInListView(TUser(msg.LParam));
        end;
      rpDeleteItem:
        begin
          DeleteUserInListView(TUser(msg.LParam));
        end;
    end;
  end;
end;procedure TFIndex.RefreshUsersInListView;
var
  lst: TList;
  I: Integer;
begin
  lvUsers.Items.BeginUpdate;
  try
    lvUsers.Clear;
    lst := FUsers.LockList;
    try
      for I := 0 to lst.Count - 1 do
        SendMessage(FormHanlde, WM_REFRESH_USERS, Ord(rpAppendItem), Integer(lst[I]));
    finally
      FUsers.UnlockList;
    end;
  finally
    lvUsers.Items.EndUpdate;
  end;
end;procedure TFIndex.DeleteUserInListView(AClient: TUser);
begin
  if AClient.ListItem <> nil then
    AClient.ListItem.Delete;
end;procedure TFIndex.AddUserInListView(AClient: TUser);
var
  Item: TListItem;
begin
  Item := lvUsers.Items.Add;
  Item.Caption := AClient.UserName;
  AClient.ListItem := Item;
  Item.SubItems.Add(Format('%s[%d]', [AClient.IP, AClient.Port]));
  Item.SubItems.Add(DateTimeToStr(AClient.LoginTime));
  Item.Checked := AClient.Selected;
end;procedure TFIndex.IdTCPServerConnect(AContext: TIdContext);
var
  Client: TUser;
  AUserName: string;
  lst: TList;
  I: Integer;
  I64: Cardinal;
  Guid: TGUID;
  LoginSuccessful: Boolean;
begin
  CoInitialize(nil);
  I64 := GetTickCount;
  CoCreateGuid(Guid);
  AUserName := Format('U%.5d%d%s', [Random(99999), I64, GuidToString(Guid)]);
  LoginSuccessful := False;
  lst := FUsers.LockList;
  try
    for I := 0 to lst.Count - 1 do
      if SameText(TUser(lst[I]).UserName, AUserName) then Exit;    Client := TUser.Create(AContext.Binding.PeerIP, AUserName,
      AContext.Binding.PeerPort, AContext);
    lst.Add(Client);
    AContext.Connection.IOHandler.ReadTimeout := 3000;
    LoginSuccessful := True;
    SendMessage(FormHanlde, WM_REFRESH_USERS, Ord(rpAppendItem), Integer(Client));
  finally
    FUsers.UnlockList;
    if LoginSuccessful then
      AContext.Connection.IOHandler.WriteLn('LOGIN')
    else begin
      AContext.Connection.IOHandler.WriteLn('LOGINED');
      AContext.Data := nil;
      if AContext.Connection.Connected then
        AContext.Connection.Disconnect;
    end;
  end;
end;procedure TFIndex.IdTCPServerDisconnect(AContext: TIdContext);
var
  Client: TUser;
begin
  Client := TUser(AContext.Data);
  try
    if Client <> nil then
    begin
      Client.Lock;
      try
        Client.Context := nil;
      finally
        Client.Unlock;
      end;
      FUsers.Remove(Client);
      SendMessage(FormHanlde, WM_REFRESH_USERS, Ord(rpRefreshAll), 0);
      Client.Free;
    end;
  finally
    CoUnInitialize;
  end;
end;procedure TFIndex.IdTCPServerException(AContext: TIdContext;
  AException: Exception);
var
  Client: TUser;
begin
  Client := TUser(AContext.Data);
  FUsers.Remove(Client);
  SendMessage(FormHanlde, WM_REFRESH_USERS, Ord(rpRefreshAll), 0);
  AContext.Data := nil;
  if AContext.Connection.Connected then
    AContext.Connection.Disconnect;
end;procedure TFIndex.IdTCPServerExecute(AContext: TIdContext);
var
  Client: TUser;
  msg, Cmd, CmdDataStr: string;
  MyEnum: TSendCmdParam;
  tmp: Double;
begin
  sleep(10);
  Client := TUser(AContext.Data);
  if Client = nil then
    AContext.Connection.Disconnect
  else
  begin
    //清除掉长连接用户
    try
      Tmp := SecondSpan(now(), Client.LoginTime);
      if (Tmp > 30) then
      begin
        FUsers.LockList;
        try
          FUsers.Remove(Client);
          SendMessage(FormHanlde, WM_REFRESH_USERS, Ord(rpDeleteItem), Integer(Client));
        finally
          FUsers.UnlockList;
        end;
        AContext.Connection.Disconnect;
        exit;
      end;
    except
      on E: Exception do
      begin
        LogInMemo('异常类名称:' + E.ClassName + #13#10 + '异常信息:' + E.Message);
      end;    end;
    //开始处理相应指令
    msg := AContext.Connection.IOHandler.ReadLn;
    if trim(msg) = '' then exit;    try
      msg := DAndE.Decrypt(msg);
    except
      exit;
    end;    if FormHanlde <> 0 then
      if FIsShowLog then
        LogInMemo(Format('IP: %s 的用户请求命令：“%s”',
          [Client.IP, msg]));    try
      Cmd := Trim(Copy(msg, 1, 4));
      CmdDataStr := Trim(Copy(msg, 6, Length(msg)));
      MyEnum := TSendCmdParam(GetEnumvalue(TypeInfo(TSendCmdParam), Cmd));
      case MyEnum of
        Data: Cmd := Format('Data%s', [AppPath + 'WebData.zip']);
        List: Cmd := Format('List%s', [CmdDataStr]);
        Inst: Cmd := Format('Inst%s', [CmdDataStr]);
        Mdfy: Cmd := Format('Mdfy%s', [CmdDataStr]);
        Lgin: Cmd := Format('Lgin%s', [CmdDataStr]);
        Dele: Cmd := Format('Dele%s', [CmdDataStr]);
        WebL: Cmd := Format('WebL%s', [CmdDataStr]);
        AWeb: Cmd := Format('AWeb%s', [CmdDataStr]);
        MWeb: Cmd := Format('MWeb%s', [CmdDataStr]);
        DWeb: Cmd := Format('DWeb%s', [CmdDataStr]);
        SWeb: Cmd := Format('SWeb%s', [CmdDataStr]);
        Visi: Cmd := Format('Visi%s', [CmdDataStr]);
        Excb: Cmd := Format('Excb%s', [CmdDataStr]);
      else exit;
      end;    except
      exit;
    end;
    if Cmd = '' then Exit;    try
      msg := Trim(Copy(Cmd, 1, 4));
      CmdDataStr := Trim(Copy(Cmd, 5, Length(Cmd)));
      MyEnum := TSendCmdParam(GetEnumvalue(TypeInfo(TSendCmdParam), msg));
      case MyEnum of
        Data: SendFileToUser(Client, CmdDataStr);
        List: SendStrmToUser(Client, CmdDataStr);
        Inst: SendInstToUser(Client, CmdDataStr);
        Mdfy: SendModyToUser(Client, CmdDataStr);
        Lgin: SendLognToUser(Client, CmdDataStr);
        Dele: SendDeleToUser(Client, CmdDataStr);
        WebL: SendWebLToUser(Client, CmdDataStr);
        AWeb: SendAWebToUser(Client, CmdDataStr);
        MWeb: SendMWebToUser(Client, CmdDataStr);
        DWeb: SendDWebToUser(Client, CmdDataStr);
        SWeb: SendSWebToUser(Client, CmdDataStr);
        Visi: SendVisiToUser(Client, CmdDataStr);
        Excb: SendExcbToUser(Client, CmdDataStr);
      else exit;
      end;
    except
      exit;
    end;
  end;
end;

用了codesite，主要是把执行的方法输出出来，看看死的时候，死在那个函数上了。
目前还在观察。

我做过，不是idTcpServer的问题，你仔细找一下自己的原因

我知道不是idTcpServer的原因，自己也分析不出来原因。所以过来请教的。
我自己都修改了10几次了，依然不得法门……

调试易

idTcpServer服务器，几个小时就死，求解！附代码

解决方案 »