indy10 的 Idtcpserver 使用造成内存泄漏问题

Question

用indy10的idtcpserver控件制作的服务器，在处理客户端的连接后，会造成内存泄漏，请高手门帮我看一下是什么问题？
处理源码如下：
unit ufrmmain;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, IdScheduler, IdSchedulerOfThread,
  IdSchedulerOfThreadPool, IdIOHandlerChain, IdServerIOHandler,
  IdServerIOHandlerChain, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent,
  IdComponent, IdTCPServer, IdFiberWeaver, IdFiberWeaverThreaded,IdContext,
  IdSchedulerOfFiber,uConst,uLog,uService, ExtCtrls,uSynCert,uGeneralprocess,CheckMem;type
  Tfrmmain = class(TForm)
    IdTCPServer1: TIdTCPServer;
    IdServerIOHandlerChain1: TIdServerIOHandlerChain;
    IdChainEngine1: TIdChainEngine;
    IdSchedulerOfFiber1: TIdSchedulerOfFiber;
    IdFiberWeaverThreaded1: TIdFiberWeaverThreaded;
    IdSchedulerOfThreadPool2: TIdSchedulerOfThreadPool;
    IdAntiFreeze1: TIdAntiFreeze;
    Timer1: TTimer;
    procedure IdTCPServer1Execute(AContext: TIdContext);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  frmmain: Tfrmmain;implementation{$R *.dfm}procedure Tfrmmain.IdTCPServer1Execute(AContext: TIdContext);
var
  revstr:string;
  sentStr:string;
  ip_port:string;
  datestr: string;
begin
  EnterCriticalSection(FLock); //进入临界区域
  try
    try
      if (AContext.Connection.Connected){ and (not AContext.Terminated)} then
      begin
        ip_port:= AContext.Connection.Socket.Binding.PeerIP+':'+          //记录日志
          inttostr(AContext.Connection.Socket.Binding.PeerPort);        //读客户端数据
        try
          revstr:=AContext.Connection.IOHandler.ReadLn;
        except
          datestr:=formatdatetime('yyyy-mm-dd hh:nn:ss',now,LocalFormatSettings);
          Flogfile.writelog(datestr+#13#10+ip_port+#13#10+'断开与对方连接');
          AContext.Connection.disconnect;
          exit;
        end;
        revstr:= StringReplace(revstr,LINE_FLAG,#13,[rfReplaceAll]);
        revstr:= StringReplace(revstr,ENTER_FLAG,#10,[rfReplaceAll]);        //处理接收字符串
        sentStr:= ControlCenter(revstr);
        sentStr:= StringReplace(sentStr,#13,LINE_FLAG,[rfReplaceAll]);
        sentStr:= StringReplace(sentStr,#10,ENTER_FLAG,[rfReplaceAll]);        //向客户端写返回值
        try
          AContext.Connection.IOHandler.WriteLN(sentStr);
        except
          datestr:=formatdatetime('yyyy-mm-dd hh:nn:ss',now,LocalFormatSettings);
          Flogfile.writelog(datestr+#13#10+ip_port+#13#10+'服务器写回信息异常');
          AContext.Connection.disconnect;
          exit;
        end;        datestr:=formatdatetime('yyyy-mm-dd hh:nn:ss',now,LocalFormatSettings);
        Flogfile.writelog(datestr+#13#10+ip_port+#13#10+ 'receive:'+revstr+#13#10+'send:'+sentStr);
        AContext.Connection.disconnect;
      end;
    except //记录异常
      on e:exception do
      begin
        datestr:=formatdatetime('yyyy-mm-dd hh:nn:ss',now,LocalFormatSettings);
        Flogfile.writelog(datestr+#13#10+'服务处理异常'+e.Message);
        AContext.Connection.Disconnect;
        exit;
      end;
    end;
  finally
    LeaveCriticalSection(FLock); //退出临界区域
  end;end;procedure Tfrmmain.FormDestroy(Sender: TObject);
begin
  IdSchedulerOfThreadPool2.TerminateAllYarns;
  IdTCPServer1.Active:=false;
  Flogfile.Free;
  DeleteCriticalSection(BatchDelLock);//
  DeleteCriticalSection(FLock);//删除临界区域
end;procedure Tfrmmain.FormCreate(Sender: TObject);
var
  logpath,logfilename:string;
//  F:textfile;
begin
  GetLocaleFormatSettings(LCID,LocalFormatSettings);  //准备写log
  logpath:=ExtractFilePath(Application.ExeName)+LPATH;
  if not DirectoryExists(logpath) then
    if not CreateDir(logpath) then
    raise Exception.Create('Cannot create '+logpath);
  logfilename:= logpath+LOG_NAME;  InitializeCriticalSection(FLock); //初始化临界区域
  InitializeCriticalSection(BatchDelLock);// 文件锁
  Flogfile:=TLogFile.Create(logfilename);  IdSchedulerOfThreadPool2.Init;
  IdTCPServer1.DefaultPort:=LISTEN_PORT_NO;
  IdTCPServer1.Active:=true;end;procedure Tfrmmain.IdTCPServer1Connect(AContext: TIdContext);
var
  s:string;
begin
  s:=AContext.Connection.Socket.Binding.PeerIP+':'+          //记录日志
    inttostr(AContext.Connection.Socket.Binding.PeerPort);
  Flogfile.writelog(s+'已连接');
end;procedure Tfrmmain.IdTCPServer1Disconnect(AContext: TIdContext);
var
  s:string;
begin
  s:=AContext.Connection.Socket.Binding.PeerIP+':'+          //记录日志
    inttostr(AContext.Connection.Socket.Binding.PeerPort);
  Flogfile.writelog(s+'已断开连接');
end;procedure Tfrmmain.Timer1Timer(Sender: TObject);
begin
  //执行定期更新程序
  TSynCertObject.Create(
    ExtractFilePath(Application.ExeName)+LPATH+Log_OperateCert+'.txt',true,'');
end;end. 

Answer 1

to hidelphi
  是否需要我把程序的源码打包发给你?

Answer 2

这个是所有静态控件的form单元的内容，通信部分的所有功能都在这个单元里unit ufrmmain;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, IdScheduler, IdSchedulerOfThread,
  IdSchedulerOfThreadPool, IdIOHandlerChain, IdServerIOHandler,
  IdServerIOHandlerChain, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent,
  IdComponent, IdTCPServer, IdFiberWeaver, IdFiberWeaverThreaded,IdContext,
  IdSchedulerOfFiber,uConst,uLog,uService, ExtCtrls,uSynCert,uGeneralprocess,CheckMem;type
  Tfrmmain = class(TForm)
    IdTCPServer1: TIdTCPServer;
    IdServerIOHandlerChain1: TIdServerIOHandlerChain;
    IdChainEngine1: TIdChainEngine;
    IdSchedulerOfFiber1: TIdSchedulerOfFiber;
    IdFiberWeaverThreaded1: TIdFiberWeaverThreaded;
    IdSchedulerOfThreadPool2: TIdSchedulerOfThreadPool;
    IdAntiFreeze1: TIdAntiFreeze;
    Timer1: TTimer;
    procedure IdTCPServer1Execute(AContext: TIdContext);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  frmmain: Tfrmmain;implementation{$R *.dfm}procedure Tfrmmain.IdTCPServer1Execute(AContext: TIdContext);
var
  revstr:string;
  sentStr:string;
  ip_port:string;
  datestr: string;
begin
  EnterCriticalSection(FLock); //进入临界区域
  try
    try
      if (AContext.Connection.Connected){ and (not AContext.Terminated)} then
      begin
        ip_port:= AContext.Connection.Socket.Binding.PeerIP+':'+          //记录日志
          inttostr(AContext.Connection.Socket.Binding.PeerPort);        //读客户端数据
        try
          revstr:=AContext.Connection.IOHandler.ReadLn;
        except
          datestr:=formatdatetime('yyyy-mm-dd hh:nn:ss',now,LocalFormatSettings);
          Flogfile.writelog(datestr+#13#10+ip_port+#13#10+'断开与对方连接');
          AContext.Connection.disconnect;
          exit;
        end;
        revstr:= StringReplace(revstr,LINE_FLAG,#13,[rfReplaceAll]);
        revstr:= StringReplace(revstr,ENTER_FLAG,#10,[rfReplaceAll]);        //处理接收字符串
        sentStr:= ControlCenter(revstr);
        sentStr:= StringReplace(sentStr,#13,LINE_FLAG,[rfReplaceAll]);
        sentStr:= StringReplace(sentStr,#10,ENTER_FLAG,[rfReplaceAll]);        //向客户端写返回值
        try
          AContext.Connection.IOHandler.WriteLN(sentStr);
        except
          datestr:=formatdatetime('yyyy-mm-dd hh:nn:ss',now,LocalFormatSettings);
          Flogfile.writelog(datestr+#13#10+ip_port+#13#10+'服务器写回信息异常');
          AContext.Connection.disconnect;
          exit;
        end;        datestr:=formatdatetime('yyyy-mm-dd hh:nn:ss',now,LocalFormatSettings);
        Flogfile.writelog(datestr+#13#10+ip_port+#13#10+ 'receive:'+revstr+#13#10+'send:'+sentStr);
        AContext.Connection.disconnect;
      end;
    except //记录异常
      on e:exception do
      begin
        datestr:=formatdatetime('yyyy-mm-dd hh:nn:ss',now,LocalFormatSettings);
        Flogfile.writelog(datestr+#13#10+'服务处理异常'+e.Message);
        AContext.Connection.Disconnect;
        exit;
      end;
    end;
  finally
    LeaveCriticalSection(FLock); //退出临界区域
  end;end;procedure Tfrmmain.FormDestroy(Sender: TObject);
begin
  IdSchedulerOfThreadPool2.TerminateAllYarns;
  IdTCPServer1.Active:=false;
  Flogfile.Free;
  DeleteCriticalSection(BatchDelLock);//
  DeleteCriticalSection(FLock);//删除临界区域
end;procedure Tfrmmain.FormCreate(Sender: TObject);
var
  logpath,logfilename:string;
//  F:textfile;
begin
  GetLocaleFormatSettings(LCID,LocalFormatSettings);  //准备写log
  logpath:=ExtractFilePath(Application.ExeName)+LPATH;
  if not DirectoryExists(logpath) then
    if not CreateDir(logpath) then
    raise Exception.Create('Cannot create '+logpath);
  logfilename:= logpath+LOG_NAME;  InitializeCriticalSection(FLock); //初始化临界区域
  InitializeCriticalSection(BatchDelLock);// 文件锁
  Flogfile:=TLogFile.Create(logfilename);  IdSchedulerOfThreadPool2.Init;
  IdTCPServer1.DefaultPort:=LISTEN_PORT_NO;
  IdTCPServer1.Active:=true;end;procedure Tfrmmain.IdTCPServer1Connect(AContext: TIdContext);
var
  s:string;
begin
  s:=AContext.Connection.Socket.Binding.PeerIP+':'+          //记录日志
    inttostr(AContext.Connection.Socket.Binding.PeerPort);
  Flogfile.writelog(s+'已连接');
end;procedure Tfrmmain.IdTCPServer1Disconnect(AContext: TIdContext);
var
  s:string;
begin
  s:=AContext.Connection.Socket.Binding.PeerIP+':'+          //记录日志
    inttostr(AContext.Connection.Socket.Binding.PeerPort);
  Flogfile.writelog(s+'已断开连接');
end;procedure Tfrmmain.Timer1Timer(Sender: TObject);
begin
  //执行定期更新程序
  TSynCertObject.Create(
    ExtractFilePath(Application.ExeName)+LPATH+Log_OperateCert+'.txt',true,'');
end;end.

Answer 3

下面的函数是一个dll的内容，相当于一个tcp的客户端，主要部分都在了。Function BackUp(const Jh,Certificate:string):string;stdcall;
var
  ss:string;
  sockc:TMySocketClient;
  lengthJhCert:integer;
begin
  sockc:= TMySocketClient.Create;
  try
    with sockc do
    begin
      if socketConnect then
      begin
        lengthJhCert:= length(Jh)+length(Certificate);
        ss:= '4'+Jh+','+certificate+format('%'+inttostr(CODELEN)+'d',[lengthJhCert]);
        if (length(ss)<8*1024) then
          result:=sendData(ss)
        else
          result:='error';
        socketDisconnect;
      end
      else
        result:='error';
    end;
  finally
    sockc.Free;
  end;
end;
//封装了一个socket客户端unit uSocketClient;interfaceuses
  SysUtils,dialogs,IdTCPConnection, IdTCPClient, IdTCPServer,IdAntiFreeze,
  uStructrueConst;type
  TMySocketClient = class
  public
    IdTCPClient1: TIdTCPClient;
    IdAntiFreeze1: TIdAntiFreeze;
    
    constructor Create;
    destructor Destroy;    //socket通信函数
    function socketConnect():boolean;          //连接
    procedure socketDisconnect();              //断开
    function sendData(const s:string):string;         //发送数据  end;implementationfunction TMySocketClient.socketConnect():boolean;          //连接
var
  strIp:string;
  strPort:integer;
begin
  result:=false;
  if (not GetServerIpPort(strIp,strPort)) then
  begin
    showmessage('请检查wsiceinfo.ini文件中的ip,port设置是否正确.');
    exit;
  end;
  IdTCPClient1.Host:= strIp;
  IdTCPClient1.Port:= strPort;  try
    IdTCPClient1.Connect;
  except
    on  e : exception do
    begin
      //showmessage('与服务器连接时异常：'+e.Message);//'连接socket服务器失败,请重新连接！');
      exit;
    end;
  end;
  result:=true;
end;procedure TMySocketClient.socketDisconnect();       //断开
begin
  try
    IdTCPClient1.Socket.Close;
    IdTCPClient1.Disconnect;  except
    on  e : exception do
      showmessage('与服务器断开时异常：' + e.Message);//'连接socket服务器失败,请重新连接！');
  end;
end;function TMySocketClient.sendData(const s:string):string;               //发送数据 ，并接收返回结果
var
//  Asentbuffer:array[0..1023] of char;
//  Arecbuffer : array[0..1023] of char;
//  lstr : integer;
  sendstr:string;
  ret:string;
begin
  result:='';
  try
    //发送数据
    //将回车换行替换
    sendstr:= StringReplace(s,#13,LINE_FLAG,[rfReplaceAll]);
    sendstr:= StringReplace(s,#10,ENTER_FLAG,[rfReplaceAll]);
    IdTCPClient1.IOHandler.Writeln(sendstr);
    try
      //接收返回数据
      result:= IdTCPClient1.IOHandler.ReadLn;
      result:= StringReplace(result,LINE_FLAG,#13,[rfReplaceAll]);
      result:= StringReplace(result,ENTER_FLAG,#10,[rfReplaceAll]);
    except
      on  e : exception do
      begin
        showmessage('接收服务器返回结果异常：'+e.Message);//'连接socket服务器失败,请重新连接！');
        result:='error';
      end;
    end;
  except
      on  e : exception do
      begin
        showmessage('向服务器发送信息时异常：'+e.Message);//'连接socket服务器失败,请重新连接！');
        result:='error';
      end;
  end;
end;constructor TMySocketClient.Create;
begin
  inherited create;
  IdTCPClient1:=TIdTCPClient.Create(nil);
//  IdAntiFreeze1:=TIdAntiFreeze.Create(nil);//  socketConnect;
end;destructor TMySocketClient.Destroy;
begin
//  socketDisconnect;
  IdTCPClient1.Free;
//  IdAntiFreeze1.Free;
  inherited Destroy;
end;end.

Answer 4

不是还缺个uStructrueConst单元，Indy10的TCP Demo代码我贴上来unit MainForm;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdTelnet;type
  TfrmMain = class(TForm)
    Label2: TLabel;
    edHost: TEdit;
    Label3: TLabel;
    edPort: TEdit;
    btnConnect: TButton;
    Bevel1: TBevel;
    memMsgs: TMemo;
    Panel1: TPanel;
    edMsg: TEdit;
    Client: TIdTCPClient;
    Timer1: TTimer;
    procedure btnConnectClick(Sender: TObject);
    procedure ClientConnect(Sender: TObject);
    procedure ClientDisconnect(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure edMsgKeyPress(Sender: TObject; var Key: Char);
    procedure Timer1Timer(Sender: TObject);
    procedure ClientConnected(Sender: TObject);
    procedure ClientDisconnected(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  frmMain: TfrmMain;implementation{$R *.dfm}procedure TfrmMain.btnConnectClick(Sender: TObject);
begin
  if Client.Connected then
    Client.Disconnect
  else
    begin
      Client.Host := edHost.Text;
      Client.Port := StrToIntDef(edPort.Text, 8800);
      edPort.Text := IntToStr(Client.Port);
      memMsgs.Lines.Clear;
      Client.Connect;
    end;
end;procedure TfrmMain.ClientConnect(Sender: TObject);
begin
  edPort.Enabled := false;
  edHost.Enabled := false;
  btnConnect.Caption := 'Disconnect';
end;procedure TfrmMain.ClientDisconnect(Sender: TObject);
begin
  edPort.Enabled := true;
  edHost.Enabled := true;
  btnConnect.Caption := 'Connect';
end;procedure TfrmMain.FormCreate(Sender: TObject);
begin
  memMsgs.Align := alClient;
  memMsgs.Lines.Clear;
  edMsg.Text := '';
end;procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Client.Disconnect;
  CanClose := not Client.Connected;
end;procedure TfrmMain.edMsgKeyPress(Sender: TObject; var Key: Char);
var
  s : String;
begin
  if Key = #13 then
    begin
      s := edMsg.Text + #10#13;
      Key := #0;
      edMsg.Text := '';
      Client.IOHandler.WriteBuffer(s[1], Length(s));
    end;
end;procedure TfrmMain.Timer1Timer(Sender: TObject);
var
  i : integer;
  s : String;
begin
  if not Client.Connected then
    exit;  I := Client.IOHandler.Buffer.Size;
  if I > 0 then
    begin
      SetLength(s, i);
      Client.IOHandler.ReadBuffer(s[1], i);
      memMsgs.Lines.add(Copy(s, 1, Length(s) -2));
    end;
end;procedure TfrmMain.ClientConnected(Sender: TObject);
begin
  btnConnect.Caption := 'Disconnect';
end;procedure TfrmMain.ClientDisconnected(Sender: TObject);
begin
  btnConnect.Caption := 'Connect';
end;end.

Answer 5

unit ChatContextData;interfaceuses
  Classes,
  SyncObjs,
  SysUtils,
  IdContext;type
  TChatContextData = class;  TMsgAvail    = procedure(Sender : TChatContextData) of object;
  TUserNameSet = procedure(Sender : TChatContextData; var UserName : String) of object;  TChatContextData=class(TObject)
  private
    FLock : TCriticalSection;
    FCurMsg: TStringList;
    FOnMsgAvail: TMsgAvail;
    FContext: TIdContext;
    FUserName: String;
    FOnUserNameSet: TUserNameSet;
    function GetCurMsg: String;
    procedure CheckForMsg;
    procedure SetOnMsgAvail(const Value: TMsgAvail);
    function GetContext: TIdContext;
    procedure SetUserName(const Value: String);
    procedure SetOnUserNameSet(const Value: TUserNameSet);
  public
    property CurMsg : String read GetCurMsg;
    function Pop : String;
    constructor Create;
    destructor Destroy; override;
    procedure CheckMsg(AContext: TIdContext);
    property OnMsgAvail : TMsgAvail read FOnMsgAvail write SetOnMsgAvail;
    property Context: TIdContext read GetContext;
    property UserName : String read FUserName write SetUserName;
    property OnUserNameSet : TUserNameSet read FOnUserNameSet write SetOnUserNameSet;
  end;implementation{ TChatContextData }procedure TChatContextData.CheckForMsg;
var
  UN : String;
  msg: String;
begin
  if FCurMsg.Count > 1 then
    begin
      if UserName = '' then
        begin
          UN := Pop;
          if Assigned(FOnUserNameSet) then
            FOnUserNameSet(Self, UN);
          UserName := UN;
          msg := 'Welcome ' + UN + #13#10;
          Context.Connection.IOHandler.WriteBuffer(msg[1], length(msg));
        end
      else
        if Assigned(FOnMsgAvail) then
          FOnMsgAvail(Self);
    end;
end;procedure TChatContextData.CheckMsg(AContext: TIdContext);
var
  S, Swp : String;
  I : Integer;
begin
  FLock.Enter;
  try
    FContext := AContext;
    AContext.Connection.IOHandler.CheckForDisconnect(True, True);
    I := AContext.Connection.IOHandler.Buffer.Size;
    If I >= 1 then
      begin
        Swp := Copy(FCurMsg.Text, 1, Length(FCurMsg.Text) -2);
        SetLength(S, I);
        AContext.Connection.IOHandler.ReadBuffer(S[1], I);
        S := StringReplace(S, #13#10, #10#13, [rfReplaceAll]);
        if (S = #10#13) then
          FCurMsg.Add('')
        else
          FCurMsg.Text := Swp + S;
        CheckForMsg;
      end;
  finally
    FLock.Leave;
  end;
end;constructor TChatContextData.Create;
begin
  inherited;
  FCurMsg := TStringList.Create;
  FLock   := TCriticalSection.Create;
end;destructor TChatContextData.Destroy;
begin
  FCurMsg.Free;
  FLock.Free;
  inherited;
end;function TChatContextData.GetContext: TIdContext;
begin
  Result := FContext;
end;function TChatContextData.GetCurMsg: String;
begin
  FLock.Enter;
  try
    if FCurMsg.Count > 0 then
      begin
        Result := FCurMsg[0];
      end
    else
      Result := '';
  finally
    FLock.Leave;
  end;
end;function TChatContextData.Pop: String;
begin
  FLock.Enter;
  try
    Result := GetCurMsg;
    if UserName <> '' then
      Result := UserName + ': ' + Result;
    if FCurMsg.Count > 0 then
      FCurMsg.Delete(0);
  finally
    FLock.Leave;
  end;
end;procedure TChatContextData.SetOnMsgAvail(const Value: TMsgAvail);
begin
  FOnMsgAvail := Value;
end;procedure TChatContextData.SetOnUserNameSet(const Value: TUserNameSet);
begin
  FOnUserNameSet := Value;
end;procedure TChatContextData.SetUserName(const Value: String);
begin
  FUserName := Value;
end;end.

Answer 6

unit MainForm;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  IdBaseComponent, IdComponent, IdTCPServer, IdContext, StdCtrls, IdScheduler,
  IdSchedulerOfThread, IdSchedulerOfThreadDefault, CheckLst, ComCtrls, ExtCtrls,
  IdDsnCoreResourceStrings, IdStack, IdCoreGlobal, IdSocketHandle, ShellAPI,
  IniFiles, IdAntiFreezeBase, IdAntiFreeze, ChatContextData;type
  TfrmMain = class(TForm)
    Server: TIdTCPServer;
    pnlButtonBar: TPanel;
    pcMain: TPageControl;
    tsSettings: TTabSheet;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    lbIPs: TCheckListBox;
    cbPorts: TComboBox;
    edPort: TEdit;
    tsProcessLog: TTabSheet;
    lbProcesses: TListBox;
    btnStartStop: TButton;
    IdAntiFreeze1: TIdAntiFreeze;
    IdSchedulerOfThreadDefault1: TIdSchedulerOfThreadDefault;
    tsGreeting: TTabSheet;
    Panel3: TPanel;
    lblUserNamePrompt: TLabel;
    edUserPrompt: TEdit;
    memGreeting: TMemo;
    btnTestClient: TButton;
    procedure btnStartStopClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lbProcessesDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ServerStatus(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: String);
    procedure ServerException(AContext: TIdContext; AException: Exception);
    procedure FormActivate(Sender: TObject);
    procedure ServerExecute(AContext: TIdContext);
    procedure ServerConnect(AContext: TIdContext);
    procedure ServerDisconnect(AContext: TIdContext);
    procedure edPortKeyPress(Sender: TObject; var Key: Char);
    procedure btnTestClientClick(Sender: TObject);
  private
    { Private declarations }
    function CheckStartOk : Boolean;    function StartServer : Boolean;
    function StopServer  : Boolean;    procedure PopulateIPAddresses;
    function PortDescription(const PortNumber: integer): string;    procedure LoadDefaultValues;
    procedure SaveDefaultValues;    procedure CheckOptions;
    function GetServerOnline: Boolean;    function InternalServerBeforeStart : Boolean;
    procedure InternalServerAfterStart;    function InternalServerBeforeStop : Boolean;
    procedure InternalServerAfterStop;    procedure Log(Msg : String; Color : TColor = clBlack);
    procedure SetControls;
  public
    { Public declarations }
    procedure WriteMessage(Msg : string);
    procedure MsgAvail(Sender: TChatContextData);    property ServerOnline : Boolean read GetServerOnline;
  end;var
  frmMain : TfrmMain;
  Ini     : TIniFile;
  
implementation{$R *.DFM}procedure TfrmMain.btnStartStopClick(Sender: TObject);
begin
// This procedure should never change.
  if ServerOnline then
    StopServer
  else
    StartServer;
end;function TfrmMain.CheckStartOk: Boolean;
var
  i, c : Integer;
begin
// This section should stay the same, add your new code below
  i := 0;
  for c := 0 to lbIPs.Items.Count -1 do
    begin
      if lbIPs.Checked[c] then
        inc(i);
    end;
  result := i > 0;
  if not result then
    begin
      Log('Can''t start server until you select at least one IP to bind to.', clRed);
      MessageDlg('Can''t start server until you select at least one IP to bind to.', mtError, [mbOK], 0);
    end;
// Add your code after this comment
end;procedure TfrmMain.PopulateIPAddresses;
var
  i : integer;
begin
// Again this section should not change
  with lbIPs do
    begin
      Clear;
      Items := GStack.LocalAddresses;
      Items.Insert(0, '127.0.0.1');
    end;
  try
    cbPorts.Items.Add(RSBindingAny);
    cbPorts.Items.BeginUpdate;
    for i := 0 to IdPorts.Count - 1 do
      cbPorts.Items.Add(PortDescription(Integer(IdPorts[i])));
  finally
    cbPorts.Items.EndUpdate;
  end;
end;function TfrmMain.PortDescription(const PortNumber: integer): string;
begin
// Guess what more code that shouldn't change
  with GStack.WSGetServByPort(PortNumber) do
    try
      if PortNumber = 0 then
        begin
          Result := Format('%d: %s', [PortNumber, RSBindingAny]);
        end
      else
        begin
          Result := '';    {Do not Localize}
          if Count > 0 then
            begin
              Result := Format('%d: %s', [PortNumber, CommaText]);    {Do not Localize}
            end;
        end;
    finally
      Free;
    end;
end;function TfrmMain.StartServer: Boolean;
var
  Binding : TIdSocketHandle;
  i : integer;
  SL : TStringList;
begin
// This code starts the server up and posts back information about
// the server starting up.
// You should place your pre and post startup code in InternalServerBeforeStart
// and InternalServerAfterStart accordingly.
  Result := false;
  if not CheckStartOk then
    exit;  SL := TStringList.Create;  if not StopServer then
    begin
      Log( 'Error stopping server', clRed );
      Result := false;
      exit;
    end;  Server.Bindings.Clear; // bindings cannot be cleared until TServer is inactive
  try
    try
      Server.DefaultPort := StrToInt(edPort.Text);
      for i := 0 to lbIPs.Items.Count - 1 do
        if lbIPs.Checked[i] then
          begin
            Binding := Server.Bindings.Add;
            Binding.IP := lbIPs.Items.Strings[i];
            Binding.Port := StrToInt( edPort.Text );
            Log( 'Server bound to IP ' + Binding.IP + ' on port ' + edPort.Text );
          end;      if InternalServerBeforeStart then
        begin
          Server.Active := true;
          result := Server.Active;          InternalServerAfterStart;
          if ServerOnline then
            begin
              Log( 'Server started', clGreen );
              btnStartStop.Caption := 'Stop Server';
              SetControls;
            end;
        end;
    except
      on E : Exception do
        begin
          Log( 'Server not started', clRed );
          Log( E.Message, clRed );
          Result := false;
        end;
    end;
  finally
    FreeAndNil( SL );
  end;
end;

Answer 7

//结构与常量定义，端口是11110unit uStructrueConst;interfaceuses
  windows,SysUtils,IniFiles,Classes;const
  INI_FILE = '\wsiceinfo.ini';
  PORT_NUM = 11110;
  LISTEN_IP = 'FeeSvrIP';
  ENTER_FLAG ='{0C376EF9-A270-4B00-A6E6-4FCA63848572}{10}';
  LINE_FLAG = '{755AF6D4-606A-40ED-A0D8-3530F6BD89C8}{13}';
  CODELEN=5;               //验证码长度type
  //socket服务类型
  ServerType =(JHLOGIN=1{登陆验证},SYNCRL=2{同步CRL列表},DELCER=3{删除证书},BAKUP=4{备份证书});//获得服务端的ip地址
Function GetServerIpPort(var ServerIp:string;var ServerPort:integer):boolean;implementation//从$\system32\server.ini文件中，读取服务端ip地址
Function GetServerIpPort(var ServerIp:string;var ServerPort:integer):boolean;
var
  windowPath : array[0..255] of char;
  system32Path : string;  inifilename:string;
  myfinifile:TiniFile;
  strlist:tstringlist;
  i:integer;
  pos_1:integer;
begin
  result:=false;  //获取system32路径
  GetWindowsDirectory(windowPath,sizeof(windowPath));
  system32Path:= windowPath+'\system32';
  inifilename:= system32Path+INI_FILE;  //从server.ini中读出ip,port等配置信息
  if FileExists(inifilename) then
  begin
    //获取ip,port信息
//    myfinifile:=TiniFile.create(inifilename);
    try                               //FeeSvrIP
      strlist:=TStringlist.create;
      try
        strlist.LoadFromFile(inifilename);
//        myfinifile.ReadSections(strlist);
        for i:= 0 to strlist.count-1 do
        begin
          if pos(uppercase(LISTEN_IP),UPPERCASE(strlist.Strings[i]))>0 then
          begin
            pos_1:= pos('=',strlist.Strings[i]);
            ServerIp:=trim(copy(strlist.Strings[i],pos_1+1,length(strlist.Strings[i])));
            result:=true;
            break;
          end;
        end;
      finally
        strlist.free;
      end;
      ServerPort:= PORT_NUM;
    finally
//      myfinifile.free;
    end;
  end;
end;
end.