1,593
社区成员
发帖
与我相关
我的任务
分享#######Socket的Time_Wait问题，帮顶有分，路过有分，解决了另开贴送分，：）######
Socket的Time_Wait问题，帮顶有分，路过有分，解决了另开贴送分，：）######
把TurboPower的ApdWinsockPort(1个是wsclient，1个是wsServer)封装为一个
控件，然后进行信息的发送和接收。
但是在网络突然断开后，重新连接时候，经常联不上，用netstat查看，显示端口为
time_wait状态，我是用一个timer轮训的（有多个封装后的控件在同时监听多个客户端，以及
信息户动）。
请问，各位达人如何处理，多谢！！
把TurboPower的ApdWinsockPort(1个是wsclient，1个是wsServer)封装为一个
控件，然后进行信息的发送和接收。
但是在网络突然断开后，重新连接时候，经常联不上，用netstat查看，显示端口为
time_wait状态，我是用一个timer轮训的（有多个封装后的控件在同时监听多个客户端，以及
信息户动）。
请问，各位达人如何处理，多谢！！
...全文
请发表友善的回复…
发表回复
fansnaf 2005-06-20
- 打赏
- 举报
还没有解决啊，那位老大帮帮看看把。多谢！
fansI1I 2005-06-07
- 打赏
- 举报
{ 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;
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;
wlbfeihu 2005-06-07
- 打赏
- 举报
我是路过的
fansI1I 2005-06-07
- 打赏
- 举报
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;
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;
fansI1I 2005-06-07
- 打赏
- 举报
马甲来了，
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;
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;
solestar 2005-06-07
- 打赏
- 举报
路过，没看明白！顶！
fansnaf 2005-06-07
- 打赏
- 举报
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;
{ 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;
fansnaf 2005-06-07
- 打赏
- 举报
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;
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;
fansnaf 2005-06-07
- 打赏
- 举报
:(,大家来看看吧，
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;
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;
ly_liuyang 2005-06-07
- 打赏
- 举报
Windows的问题，可以参看MSDN的相关内容
TimeWait的端口，过一定的时间就回自动恢复可用，不需处理，你也不能处理些什么，这个Windows机制所需要的
http://lysoft.7u7.net
TimeWait的端口，过一定的时间就回自动恢复可用，不需处理，你也不能处理些什么，这个Windows机制所需要的
http://lysoft.7u7.net
fansnaf 2005-06-07
- 打赏
- 举报
现在是有时候由于网络故障，突然断开后，就联不上了，是
10054错误
10054错误
flyinwuhan 2005-06-06
- 打赏
- 举报
心跳，每隔几秒发送一条信息进行交互，超时则关闭连接
qinmaofan 2005-06-06
- 打赏
- 举报
不大清楚，所以你要自己试一下。
fansnaf 2005-06-06
- 打赏
- 举报
to qinmaofan(采菊南山下【抵制日货】)
netbeui协议和这个有关系吗？请指教？
netbeui协议和这个有关系吗？请指教？
zysmiracle 2005-06-06
- 打赏
- 举报
不懂;
学习
学习
qinmaofan 2005-06-06
- 打赏
- 举报
可能是你的电脑装了 netbeui 协议的缘故吧。
另，侦听一般只需一个 socket 就可以了。
另，侦听一般只需一个 socket 就可以了。
xinqingbucuo 2005-06-04
- 打赏
- 举报
不会，可怜，帮你顶
紧跟农民
紧跟农民
cjf1009 2005-06-03
- 打赏
- 举报
不会，可怜，帮你顶
fansnaf 2005-06-03
- 打赏
- 举报
ding
fansnaf 2005-06-02
- 打赏
- 举报
ding
