#######Socket的Time_Wait问题，帮顶有分，路过有分，解决了另开贴送分，：）######

Socket的Time_Wait问题，帮顶有分，路过有分，解决了另开贴送分，：）######

把TurboPower的ApdWinsockPort(1个是wsclient，1个是wsServer)封装为一个
控件，然后进行信息的发送和接收。
但是在网络突然断开后，重新连接时候，经常联不上，用netstat查看，显示端口为
time_wait状态，我是用一个timer轮训的（有多个封装后的控件在同时监听多个客户端，以及
信息户动）。
请问，各位达人如何处理，多谢！！

20 个解决方案

#1

ding

#2

ding

#3

不会，可怜，帮你顶

#4

不会，可怜，帮你顶
紧跟农民

#5

可能是你的电脑装了 netbeui 协议的缘故吧。

另，侦听一般只需一个 socket 就可以了。

#6

不懂;
学习

#7

to qinmaofan(采菊南山下【抵制日货】)
netbeui协议和这个有关系吗？请指教？

#8

不大清楚，所以你要自己试一下。

#9

心跳，每隔几秒发送一条信息进行交互，超时则关闭连接

#10

现在是有时候由于网络故障，突然断开后，就联不上了，是
10054错误

#11

Windows的问题，可以参看MSDN的相关内容
TimeWait的端口，过一定的时间就回自动恢复可用，不需处理，你也不能处理些什么，这个Windows机制所需要的

http://lysoft.7u7.net

#12

:(,大家来看看吧，
unit SGX_ControlledU;

interface

uses
  adCpuUsage, Shell32_TLB, ActiveX,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
  OoMisc, AdPort, AdWnPort, StdCtrls, ExtCtrls, TLHelp32, Dialogs, Forms, AdSocket,
  WinSock;


Const
  connVerb = '启用(&A)';
  discVerb = '禁用(&B)';

var
  gCS: TRTLCriticalSection;

type
  TTriggerAvailEvent = procedure(CP: TObject; Count: Word) of object;

  //将被控端信息发送到主控端
  TSendMessage = class(TThread)
  private
    pbConnected: ^Boolean;
    pbExit: ^Boolean;
    pslMessageList: ^TStringList;
    MySocket: ^TApdWinsockPort;
    
    pdtLastTime: ^TDateTime;

    procedure SendInfo;
  protected
    procedure Execute; Override;
  public
  end;

  //检测是否有异常进程
  TCheckBlackThread = Class(TThread)
  private
    pbExit: ^Boolean;
    pslBlackList: ^TStringList;   //黑名单进程列表
    pslThreadList: ^TStringList;  //系统进程列表
    pslTemp: TStringList;
    pShellNet: ^TShell;        
    fbNetCardOpen: Boolean;       //网卡状态
    pszNetName: ^String;          //网络名称
    //禁用/启用本地网卡
    function DisableLocalNetCard(szNetName: String; bDisable: Boolean): Boolean;
    procedure CheckThread;
  protected
    procedure Execute; Override;
  public
  end;

#13

TSGX_Controlled = Class(TComponent)
  private
    fszHostAddr: String;   //上级IP地址
    fszSendSocket: String; //发送数据端口
    fszRevSocket: String;  //接收数据端口
    
    fcDelimiterChar: Char;    //数据分隔符
    fiTimerInterval: Integer; //发送系统信息间隔(毫秒)
    fbSendInfo: Boolean;      //是否发送系统信息

    fbExit: Boolean;        //是否退出
    fbConnected: Boolean;   //Socket是否连接
    fLastDisConnected: TDatetime; //发送端口上次端口时间
    fszNetName: String;     //本地网络名称(默认:本地连接)
    fszLocalID: String;     //计算机编号
    fiTag: Integer;         //Tag属性

    fslInfoList: TStringList;  //消息队列
    fslBlackList: TStringList; //进程黑名单列表
    fszBlackName: String;      //进程黑名单文件名称
    fslThreadList: TStringList;//系统当前进程列表

    fSendMessage: TSendMessage;   //发送消息线程
    fCheckBT: TCheckBlackThread;  //检测系统黑名单线程

    fShellNet: TShell;
    SysTimer: TTimer;             //产生系统信息数据(CPU,MEM等)Time
    SocketTimer: TTimer;          //检查Socket是否连接
    SendSocket: TApdWinsockPort;  //发送数据Socket
    RevSocket: TApdWinsockPort;   //接收数据Socket

    fOnTriggerAvail: TTriggerAvailEvent;

    //Timer生成系统信息
    procedure InfoTimer(Sender: TObject);
    //SocketTimer:检查Socket是否连接
    procedure CheckSocketTimer(Sender: TObject);
    //将系统资源写入消息队列
    function GetSysResInfo: String;
    //将系统进程列表写入消息队列
    function GetSysProcList: String;

    //日志及异常信息记录
    function OpLog(iInfoLevel: Integer;       //严重级别，0，1，2
                   szModuleName: String;      //模块名称
                   szInfo: String): Boolean;  //错误描述): Boolean;


    procedure WsConnect(Sender: TObject);
    procedure WsDisconnect(Sender: TObject);
    procedure WsError(Sender: TObject; ErrCode: Integer);

    procedure RevWsConnect(Sender: TObject);
    procedure RevWsDisconnect(Sender: TObject);
    procedure RevWsError(Sender: TObject; ErrCode: Integer);
    procedure RevTriggerAvail(CP: TObject; Count: Word);

    procedure SetTimerEnable(TimerEnable: Boolean);
    procedure SetSocketTag(iTag: Integer);
  public
    constructor Create( AOwner: TComponent ); override;
    destructor Destroy; override;
    //开始向上级发送信息
    procedure StartSendInfo;
    //停止发送信息
    procedure StopSendInfo;
    //发送控制命令
    function SendCmd(szCmd: String): Boolean;
  published
    property bConnected: Boolean Read fbConnected Default False;
    property szHostAddr: String Read fszHostAddr Write fszHostAddr;
    property szSendSocket: String Read fszSendSocket Write fszSendSocket;
    property szRevSocket: String Read fszRevSocket Write fszRevSocket;
    property DelimiterChar: Char Read fcDelimiterChar Write fcDelimiterChar;
    property iTimerInterval: Integer Read fiTimerInterval Write fiTimerInterval;
    property szBlackName: String Read fszBlackName Write fszBlackName;
    property szNetName: String Read fszNetName Write fszNetName;
    property szLocalID: String Read fszLocalID Write fszLocalID;
    property bSendInfo: Boolean Read fbSendInfo Write SetTimerEnable;
    property iTag: Integer Read fiTag Write SetSocketTag;
    property OnTriggerAvail: TTriggerAvailEvent Read fOnTriggerAvail Write fOnTriggerAvail;
  protected
  end;

  //注册控件
  procedure Register;

#14

implementation

{ TSGX_Controlled }

//SocketTimer:检查Socket是否连接
procedure TSGX_Controlled.CheckSocketTimer(Sender: TObject);
begin
  Try
    
    if Not Self.bConnected then
    begin
       
      Self.SendSocket.Open := False;
      Self.SendSocket.FlushInBuffer;
      Self.SendSocket.FlushOutBuffer;
      Self.SendSocket.Free;

      SendSocket                := TApdWinsockPort.Create(Self);
      SendSocket.DeviceLayer    := dlWinSock;
      SendSocket.WsMode         := WsClient;
      SendSocket.WsTelnet       := False;
      SendSocket.OnWsConnect    := WsConnect;
      SendSocket.OnWsDisconnect := WsDisconnect;
      SendSocket.OnWsError      := WsError;
      SendSocket.WsAddress      := Self.fszHostAddr;
      SendSocket.WsPort         := Self.fszSendSocket;
      
      SendSocket.Open           := True;
      Application.ProcessMessages;
    end;
    
    //if (Now - Self.fLastDisConnected) * 24 * 60  >= 5 then 
    if Not Self.RevSocket.Open then
    begin
       
      RevSocket.FlushInBuffer;
      RevSocket.FlushOutBuffer;
      RevSocket.Free;
      
      RevSocket                 := TApdWinsockPort.Create(Self);
      RevSocket.DeviceLayer     := dlWinSock;
      RevSocket.WsMode          := WsServer;
      RevSocket.WsTelnet        := False;
      RevSocket.OnWsConnect     := RevWsConnect;
      RevSocket.OnWsDisconnect  := RevWsDisConnect;
      RevSocket.OnWsError       := RevWsError;
      RevSocket.OnTriggerAvail  := RevTriggerAvail;

      Self.RevSocket.WsPort := Self.szRevSocket;
      
      Self.RevSocket.Open := True;
      Self.fLastDisConnected := Now;
      Application.ProcessMessages;
    end;
    
  Except On E: Exception do
    OpLog(1,'CheckSocketTimer',E.Message);
  End;
end;

constructor TSGX_Controlled.Create(AOwner: TComponent);
begin
  inherited Create( AOwner );
  InitializeCriticalSection(gCS);

  fcDelimiterChar := #255;
  fiTimerInterval := 1000;
  fbExit := False;
  fbConnected := False;
  fszNetName := '本地连接';
  fbSendInfo := False;

  fslInfoList           := TStringList.Create;
  fslBlackList          := TStringList.Create;
  fslThreadList         := TStringList.Create;

  CoInitialize(Nil);
  fShellNet := TShell.Create(Self);

  SendSocket                := TApdWinsockPort.Create(Self);
  SendSocket.DeviceLayer    := dlWinSock;
  SendSocket.WsMode         := WsClient;
  SendSocket.WsTelnet       := False;
  SendSocket.OnWsConnect    := WsConnect;
  SendSocket.OnWsDisconnect := WsDisconnect;
  SendSocket.OnWsError      := WsError;

  RevSocket                 := TApdWinsockPort.Create(Self);
  RevSocket.DeviceLayer     := dlWinSock;
  RevSocket.WsMode          := WsServer;
  RevSocket.WsTelnet        := False;
  RevSocket.OnWsConnect     := RevWsConnect;
  RevSocket.OnWsDisconnect  := RevWsDisConnect;
  RevSocket.OnWsError       := RevWsError;
  RevSocket.OnTriggerAvail  := RevTriggerAvail;


  SysTimer := TTimer.Create(Self);
  SysTimer.OnTimer  := InfoTimer;

  SocketTimer := TTimer.Create(Self);
  SocketTimer.OnTimer := CheckSocketTimer;

  fSendMessage := Nil;
  fCheckBT := Nil;
end;

destructor TSGX_Controlled.Destroy;
begin
  Try
    SysTimer.Enabled := False;
    SysTimer.Free;

    SocketTimer.Enabled := False;
    SocketTimer.Free;

    SendSocket.Open := False;
    SendSocket.Free;

    RevSocket.Open := False;
    RevSocket.Free;

    fslInfoList.Free;
    fslBlackList.Free;
    fslThreadList.Free;

    fShellNet.Free;

    DeleteCriticalSection(gCS);
  Except On E: Exception do
    OpLog(1,'TSGX_Controlled', E.Message);
  End;

  inherited Destroy;
end;

#15

路过，没看明白！顶！

#16

马甲来了，
function TSGX_Controlled.GetSysProcList: String;
var
  FSnapshotHandle:THandle;
  FProcessEntry32:TProcessEntry32;
  Ret : BOOL;
begin
  Try
    FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
    FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
    Ret := Process32First(FSnapshotHandle,FProcessEntry32);
    Ret := Process32Next(FSnapshotHandle,FProcessEntry32);
    Result := '';
    while Ret do
    begin
      Result := Result + FProcessEntry32.szExeFile + DelimiterChar;
      Ret := Process32Next(FSnapshotHandle,FProcessEntry32);
    end;
    Result := Copy(Result,1,Length(Result) - 1);
    Result := 'Toll' + DelimiterChar +
              'ProList' + DelimiterChar +
              fszLocalID + DelimiterChar +
              //szLocalIP + DelimiterChar +
              Result + DelimiterChar;
    Self.fslInfoList.Add(Result); //写入进程消息
    EnterCriticalSection(gCS);       //进入临界区
    Self.fslThreadList.DelimitedText := Result;
    LeaveCriticalSection(gCS);       //离开临界区
  Finally
    CloseHandle(FSnapshotHandle);
  End;

end;

function TSGX_Controlled.GetSysResInfo: String;
var
  iCpuUsing: Integer;
  MemInfo:MEMORYSTATUS;
begin
  Try
    CollectCpudata;
    iCPUUsing   := Trunc(GetCPUUsage(0) * 100);
    MemInfo.dwLength := SizeOf(MEMORYSTATUS);
    GlobalMemoryStatus(MemInfo);
    //EnterCriticalSection(gCS);       //进入临界区
    Result := 'Toll' + DelimiterChar + 'Res' + DelimiterChar
              + fszLocalID + DelimiterChar
              + IntToStr(iCPUUsing) + DelimiterChar
              + FloatToStr(MemInfo.dwTotalPageFile/1024) + DelimiterChar
              + FloatToStr((MemInfo.dwTotalPageFile - MemInfo.dwAvailPageFile)/1024) + DelimiterChar;
    Self.fslInfoList.Add(Result);       //写入进程消息
    //LeaveCriticalSection(gCS);       //离开临界区
  Except
    On E:Exception do
    begin
    end;
  End;

end;

//Timer生成系统信息
procedure TSGX_Controlled.InfoTimer(Sender: TObject);
begin
  Try
    GetSysResInfo;
    GetSysProcList;
  Except
  End;
end;

function TSGX_Controlled.OpLog(iInfoLevel: Integer; szModuleName,
  szInfo: String): Boolean;
var
  szTemp: String;       //错误信息
  szDelimer: String;    //分割信息(e.g: *********************)
  fsLogFile: TextFile;
  LogFileName: String;
begin
  szDelimer := '*********************************************' + #13#10;
  szModuleName := 'SGX_Controlled--' + szModuleName;
  if Not DirectoryExists(ExtractFilePath(application.ExeName) + 'SGX_Log\' ) then
  begin
    CreateDir(ExtractFilePath(application.ExeName) + 'SGX_Log\' );
  end;
  LogFileName := ExtractFilePath(application.ExeName) + 'SGX_Log\' + FormatDateTime('YYYYMMDD',Now) + '.log';;
  AssignFile(fsLogFile,LogFileName);
  if not FileExists(LogFileName) then
    ReWrite(fsLogFile)
  else
    Append(fsLogFile);
  //启动加载
  if iInfoLevel = -1 then
  begin
    begin
      szTemp := ' ********用户登陆@' + DateTimeToStr(Now) + '********' + #13#10;
      WriteLn(fsLogFile,szDelimer);
      WriteLn(fsLogFile,szTemp);
      WriteLn(fsLogFile,szDelimer);
    end;
  end;
  //程序退出
  if iInfoLevel = -2 then
  begin
    begin
      szTemp := ' ********用户退出@' + DateTimeToStr(Now) + '********' + #13#10;
      WriteLn(fsLogFile,szDelimer);
      WriteLn(fsLogFile,szTemp);
      WriteLn(fsLogFile,szDelimer);
    end;
  end;
  //其他信息
  if (iInfoLevel >= 0) then
  begin
    szTemp := '';
    szDelimer := '************************************************************' + #13#10;
    szTemp := '[' + IntToStr(iInfoLevel) + ']' + ' ';
    szTemp := szTemp + TimeToStr(Time) + ' ';
    szTemp := szTemp + szModuleName+'->';
    szTemp := szTemp + szInfo + #13#10;
    WriteLn(fsLogFile,szDelimer);
    WriteLn(fsLogFile,szTemp);
  end;
  CloseFile(fsLogFile);

end;

procedure TSGX_Controlled.RevTriggerAvail(CP: TObject; Count: Word);
begin
  if Assigned(Self.fOnTriggerAvail) then
    fOnTriggerAvail(CP,Count);
end;

procedure TSGX_Controlled.RevWsConnect(Sender: TObject);
begin

end;

procedure TSGX_Controlled.RevWsDisconnect(Sender: TObject);
begin

end;

procedure TSGX_Controlled.RevWsError(Sender: TObject; ErrCode: Integer);
begin
  Try
    if Not RevSocket.Open then
      Exit;
    OpLog(1,'RevWsError',IntToStr(ErrCode));
    if ErrCode = 10055 then
    begin
      RevSocket.FlushInBuffer;
    end
    else
    begin
      RevSocket.Open := False;
      //Sleep(1);
      //RevSocket.Open := True;
    end;
    ErrCode := 0;
  Except On E: Exception do
    OpLog(1,'RevWsError',E.Message);
  End;
end;

function TSGX_Controlled.SendCmd(szCmd: String): Boolean;
begin
  Try
    Self.fslInfoList.Add(szCmd);
  Except
  End;
end;

#17

procedure TSGX_Controlled.SetSocketTag(iTag: Integer);
begin
  Self.RevSocket.Tag := iTag;
  Self.SendSocket.Tag := iTag;
end;

procedure TSGX_Controlled.SetTimerEnable(TimerEnable: Boolean);
begin
  Self.SysTimer.Enabled := TimerEnable;
  Self.fbSendInfo := TimerEnable;
end;

procedure TSGX_Controlled.StartSendInfo;
begin
  fslInfoList.Delimiter   := Self.fcDelimiterChar;
  fslThreadList.Delimiter := Self.fcDelimiterChar;
  
  if Trim(Self.fszBlackName) <> '' then
  if FileExists(Self.fszBlackName) then
    fslBlackList.LoadFromFile(Self.fszBlackName);

  SendSocket.WsAddress      := Self.fszHostAddr;
  SendSocket.WsPort         := Self.fszSendSocket;
  SendSocket.Open           := True;

  RevSocket.WsPort          := Self.fszRevSocket;
  RevSocket.Open            := True;

  SysTimer.Interval := Self.fiTimerInterval;
  SysTimer.Enabled  := Self.fbSendInfo;


  fSendMessage := TSendMessage.Create(True);
  fSendMessage.FreeOnTerminate := True;
  fSendMessage.pbConnected     := @fbConnected;
  fSendMessage.pbExit          := @fbExit;
  fSendMessage.pslMessageList  := @Self.fslInfoList;
  fSendMessage.MySocket        := @Self.SendSocket;
  fSendMessage.pdtLastTime     := @Self.fLastDisConnected;
  fSendMessage.Resume;

  fCheckBT := TCheckBlackThread.Create(True);
  fCheckBT.FreeOnTerminate := True;
  fCheckBT.pslBlackList    := @fslBlackList;
  fCheckBT.pslThreadList   := @fslThreadList;
  fCheckBT.pbExit          := @fbExit;
  fCheckBT.pShellNet       := @fShellNet;
  fCheckBT.fbNetCardOpen   := True;
  fCheckBT.pszNetName      := @fszNetName;
  fCheckBT.Resume;
  
  SocketTimer.Interval := 10000;
  SocketTimer.Enabled := True;
end;

procedure TSGX_Controlled.StopSendInfo;
begin
  Self.fbExit := True;
  Sleep(200);
end;

procedure TSGX_Controlled.WsConnect(Sender: TObject);
begin
  Try
    Self.fbConnected := True;
  Except
  End;
end;

procedure TSGX_Controlled.WsDisconnect(Sender: TObject);
begin
  Try
    Self.fbConnected := False;
    Self.fLastDisConnected := Now;
  Except
  End; 
end;

procedure TSGX_Controlled.WsError(Sender: TObject; ErrCode: Integer);
begin
  Try
    OpLog(1,'WsError',IntToStr(ErrCode));
    //Self.fLastDisConnected := Now;
    if ErrCode = 10055 then
    begin
      SendSocket.FlushOutBuffer;
    end
    else if ErrCode = 10054 then
    begin
      Self.fbConnected := False;
    end
    else
    begin
      //此前不需要设置SendSocket.Open=False,如果设置反而造成系统占用率过高
      SendSocket.Open := True;
    end;
    ErrCode := 0;
  Except
  End;
end;

{ TSendMessage }

procedure TSendMessage.Execute;
begin
  Try
    While Not Self.pbExit^ do
    begin
      {
      Synchronize(SendInfo);
      Sleep(1);
      }
      SendInfo;
      Sleep(1);
    end;
  Except On E: Exception do
    begin
      MySocket^.FlushOutBuffer;
    end;
  End;
end;

procedure TSendMessage.SendInfo;
var
  szTemp: String;
begin  
    Try
      //如果连接畅通,发送数据
      if Self.pbConnected^ then
      begin
        if Self.pslMessageList^.Count > 0 then
        begin
          szTemp := Self.pslMessageList^.Strings[0];
          Self.MySocket.PutString(szTemp);
          Self.pslMessageList^.Delete(0);
          Sleep(1);
        end
        else
        begin
          //Application.ProcessMessages;
          Sleep(1);
        end;
      end
      else
      begin
        if Self.pslMessageList^.Count > 0 then
        begin
          Self.pslMessageList^.Delete(0);
          Sleep(1);
        end
        else
        begin
          Sleep(1);
        end;
      end; //end of else
      begin
        MySocket.FlushOutBuffer;
      end;
    Except  
    end;
end;

#18

我是路过的

#19

{ TCheckBlackThread }

procedure TCheckBlackThread.CheckThread;
var
  i: Integer;
  bHasBlack: Boolean;
begin
  Try
    bHasBlack := False;
    EnterCriticalSection(gCS);       //进入临界区
      pslTemp.Delimiter := Self.pslThreadList^.Delimiter;
      pslTemp.DelimitedText := Self.pslThreadList^.DelimitedText;
    LeaveCriticalSection(gCS);       //进入临界区
    for i := Self.pslTemp.Count - 1 downto 4 do
    begin
      if Self.pslTemp.Count = 0 then
        Exit;
      //如果存在黑名单上的进程,则禁用网卡
      if Self.pslBlackList^.IndexOf(Self.pslTemp.Strings[i]) >= 0 then
      begin
        bHasBlack := True;
        if fbNetCardOpen then
        begin
          fbNetCardOpen := False;                          
          DisableLocalNetCard(Self.pszNetName^,True);
          Break;
        end
        else
        begin
          fbNetCardOpen := False;
          Break;
        end;
      end;
      Sleep(1);
    end;

    if bHasBlack then
      Exit;
    //如果没有黑进程,并且网卡当前是关闭,则启用网卡
    if (Not bHasBlack) and (Not fbNetCardOpen) then
    begin
      fbNetCardOpen := True;
      DisableLocalNetCard(Self.pszNetName^,False);
    end;            
    Sleep(1);
  Except
  End;  
end;

function TCheckBlackThread.DisableLocalNetCard(szNetName: String;
  bDisable: Boolean): Boolean;
var
  cpFolder: Folder;
  nwFolder: Folder;
  nVerbs: FolderItemVerbs;
  i,j,k: integer;
begin
  result := false;
  cpFolder := pShellNet^.NameSpace(3);
  if cpFolder <> nil then
  begin
    for i := 0 to cpFolder.items.Count-1 do
    begin
      if cpFolder.Items.Item(i).Name = '网络和拨号连接' then
      begin
        nwFolder := cpFolder.items.item(i).GetFolder as Folder;
        if nwFolder <> nil then
        begin
          for j := 0 to nwFolder.items.Count-1 do
          begin
            if nwFolder.Items.Item(j).Name = szNetName then
            begin
              nVerbs := nwFolder.Items.Item(j).Verbs;
              for k := 0 to  nVerbs.Count-1 do
              begin
                if bDisable then
                begin
                  if nVerbs.Item(k).Name = DiscVerb then
                  begin
                    nVerbs.Item(k).DoIt;
                    Result := True;
                    Exit;
                  end;
                end
                else
                begin
                  if nVerbs.Item(k).Name = ConnVerb then
                  begin
                    nVerbs.Item(k).DoIt;
                    Result := True;
                    Exit;
                  end;
                end;
              end;
            end;
          end;
        end;
      end;
    end;

  end;
  
end;

//Com对象需要CoInitialize(0)和CoUninitialize
procedure TCheckBlackThread.Execute;
begin
  Try
    pslTemp := TStringList.Create;
    
    Try
      CoInitialize(Nil);
      While Not Self.pbExit^ do
      begin
        CheckThread;
        Sleep(1);
      end;
      CoUninitialize;
    Except On E: Exception do
      begin
        CoUninitialize;
      end;
    End;
  Finally
    pslTemp.Free;
  End;
end;

procedure Register;
begin
  RegisterComponents('SGX', [TSGX_Controlled])
end;

#20

还没有解决啊，那位老大帮帮看看把。多谢！

#21

• 蓝桥杯 送分啦(奇葩题，还真是送分的)