Monitor Scktsrvr

Monitor Scktsrvr.exe

 

代码
interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uThreadTimer, TlHelp32, ExtCtrls, ComCtrls, StdCtrls;

type
TForm1
= class(TForm)
Memo1: TMemo;
StatusBar1: TStatusBar;
btTurn: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Memo1Change(Sender: TObject);
procedure Memo1DblClick(Sender: TObject);
procedure btTurnClick(Sender: TObject);
private
{ Private declarations }
iCount,jCount: integer;
ThreadTimer: TThreadTimer;
Procedure OnTimer(Sender: TObject);
public
{ Public declarations }
function GetConnectCount:Integer;
procedure TerminateProcessEx;
procedure MonitorProcessEx;
function IsProcessExist:Boolean;
procedure CheckAppStatus;
end;

var
Form1: TForm1;
bMonitor: Boolean;

implementation


{$R *.dfm}

function FindProcessID(ExeName: string): Longword;
function AnsiEndsText(const ASubText, AText: string): Boolean;
var
P: PChar;
L, L2: Integer;
begin
P :
= PChar(AText);
L :
= Length(ASubText);
L2 :
= Length(AText);
Inc(P, L2
- L);
if L > L2 then
Result :
= False
else
Result :
= CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P, L,
PChar(ASubText), L)
= 2;
end;
var
sphandle, sthandle: DWORD;
Found: Bool;
PStruct: TProcessEntry32;
TStruct: TThreadEntry32;
begin
Result :
= 0;
sphandle :
= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
try
PStruct.dwSize :
= Sizeof(PStruct);
TStruct.dwSize :
= Sizeof(TStruct);
Found :
= Process32First(sphandle, PStruct);
while Found do
begin
if AnsiEndsText(ExeName, PStruct.szExefile) then
begin
sthandle :
= CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
try
Found :
= Thread32First(sthandle, TStruct);
while Found do
begin
if TStruct.th32OwnerProcessID = PStruct.th32ProcessID then
begin
Result :
= TStruct.th32OwnerProcessID;
Exit;
end;
Found :
= Thread32Next(sthandle, TStruct);
end;
finally
CloseHandle(sthandle);
end;
end;
Found :
= Process32Next(sphandle, PStruct);
end;
finally
CloseHandle(sphandle);
end;
end;

{ TODO : 在本程序中没有用到 }
function KillProcess(ExeFileName: string): Integer;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
Result :
= 0;
if ExeFileName = '' then
exit;
FSnapshotHandle :
= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize :
= SizeOf(FProcessEntry32);
ContinueLoop :
= Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName))
or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName)))
then
if FProcessEntry32.th32ProcessID <> GetCurrentProcessID then
Result :
= Integer(TerminateProcess(
OpenProcess(PROCESS_TERMINATE,
BOOL(
0),
FProcessEntry32.th32ProcessID),
0));
ContinueLoop :
= Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;

procedure TForm1.TerminateProcessEx;
var
id: Cardinal;
wh: HWND;
ph: THandle;
ExitCode: DWORD;
begin
try
wh :
= FindWindow('TSocketForm','Borland Socket Server');
GetWindowThreadProcessId(wh, id);
ph :
= OpenProcess(PROCESS_TERMINATE, False, id);
GetExitCodeProcess(ph, ExitCode);
TerminateProcess(ph, ExitCode);
if ph <> 0 then
CloseHandle(ph);
except
on e: Exception
do
Memo1.Lines.Add(
'ErrMsg ' + e.Message)
end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
ShowWindow(Application.Handle, SW_HIDE);
SetWindowLong(Application.Handle, GWL_EXSTYLE, getWindowLong(Application.Handle, GWL_EXSTYLE)
or WS_EX_TOOLWINDOW);
ShowWindow(Application.Handle, SW_SHOW);
iCount :
= 0;
jCount :
= 0;
Memo1.Clear;
Memo1.Lines.Add(
'Program Upgrade date: 2009-12-27');
end;

procedure TForm1.OnTimer(Sender: TObject);
var
i,iRet: integer;
begin
StatusBar1.Panels.Items[
0].Text := 'Time: ' + FormatDateTime('YYYY-MM-DD HH:NN:SS',now);
i :
= FindProcessID('scktsrvr.exe');
if i = 0 then
begin
Memo1.Lines.Add(
'Close at ' + FormatDateTime('YYYY-MM-DD HH:NN:SS',now));
winexec(
'scktsrvr.exe Login',SW_NORMAL);
end;
iRet :
= GetConnectCount;
if iRet > 3 then
begin
Inc(iCount);
if iCount > 90 then
begin
TerminateProcessEx;
Memo1.Lines.Add(IntToStr(iRet)
+ ' Force Close at '
+ FormatDateTime('YYYY-MM-DD HH:NN:SS',now));
Sleep(
1000);
end;
end
else
iCount :
= 0;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//ThreadTimer.Terminate;
end;

procedure TForm1.Memo1Change(Sender: TObject);
begin
if Memo1.Lines.Count > 100 then
Memo1.Lines.Delete(
0);
end;

procedure TForm1.Memo1DblClick(Sender: TObject);
var
iRet: Integer;
begin
Memo1.Clear;
iRet :
= GetConnectCount;
Memo1.Lines.Add(IntToStr(iRet));
end;

function TForm1.GetConnectCount: Integer;
var
hMain,hPage,hTab,hStatusBar: THandle;
s:
string;
buf:
array [0..255] of char;
begin
Result :
= 0;
FillChar(buf,
256,#0);
hMain :
= FindWindow('TSocketForm','Borland Socket Server');
if hMain <> 0 then
hPage :
= FindWindowEx(hMain,0,'TPageControl',0);
if hPage <> 0 then
hTab :
= FindWindowEx(hPage,0,'TTabSheet',0);
if hTab <> 0 then
hStatusBar :
= FindWindowEx(hTab,0,'TStatusBar',0);
if hStatusBar <> 0 then
SendMessage(hStatusBar,WM_GETTEXT,
255,Integer(@buf[0]));
S :
= buf;
if s <> '' then
Result :
= StrToInt(copy(S,1,1));
end;

procedure TForm1.CheckAppStatus;
var
i,iRet: integer;
begin
StatusBar1.Panels.Items[
0].Text := 'Time: ' + FormatDateTime('YYYY-MM-DD HH:NN:SS',now);
i :
= FindProcessID('scktsrvr.exe');
if i = 0 then
Memo1.Lines.Add(
'Close at ' + FormatDateTime('YYYY-MM-DD HH:NN:SS',now));
//
iRet :
= GetConnectCount;
if iRet > 3 then
begin
Inc(iCount);
if iCount > 90 then
begin
TerminateProcessEx;
Memo1.Lines.Add(IntToStr(iRet)
+ ' Force Close1 at '
+ FormatDateTime('YYYY-MM-DD HH:NN:SS',now));
end;
end
else
iCount :
= 0;
//
if iRet > 8 then
begin //如果超过10个连接并且持续3秒,结束程序
Inc(jCount);
if jCount > 1 then
begin
TerminateProcessEx;
Memo1.Lines.Add(IntToStr(iRet)
+ ' Force Close2 at '
+ FormatDateTime('YYYY-MM-DD HH:NN:SS',now));
end;
end
else
jCount :
= 0;
end;

function TForm1.IsProcessExist: Boolean;
begin
Result :
= FindProcessID('scktsrvr.exe') <> 0;
end;

procedure TForm1.MonitorProcessEx;
var
StartupInfo:TStartupInfo;
ProcessInfo:TProcessInformation;
I_AppRunning: Cardinal;
FullFileName: String;
begin
if not FileExists('scktsrvr.exe') then
begin
ShowMessage(
'File:scktsrvr.exe not exist');
Exit;
end;
//FullFileName := StrCat(PChar(IncludeTrailingPathDelimiter(GetCurrentDir)), 'scktsrvr.exe');
FillChar(StartupInfo,Sizeof(StartupInfo),
0);
StartupInfo.cb :
= Sizeof(StartupInfo);
StartupInfo.dwFlags :
= STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow :
= SW_SHOWNORMAL;
{$define 0}
{$ifdef 1}
CreateProcess(
nil,
'scktsrvr.exe Login',
nil,
nil,
false,
0,//CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
nil,
nil,
StartupInfo,
ProcessInfo);
{$else}
CreateProcess(
nil,//PChar('scktsrvr.exe'),//nil,
PChar(
'scktsrvr.exe Login'),
nil,
nil,
false,
0,//CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
nil,
nil,
StartupInfo,
ProcessInfo);
{$endif}
repeat
I_AppRunning :
= WaitForSingleObject(ProcessInfo.hProcess,1000);
CheckAppStatus;
if not bMonitor then Break;
Application.ProcessMessages;
until (I_AppRunning <> WAIT_TIMEOUT);
if not bMonitor then Exit;
if ProcessInfo.hProcess <> 0 then CloseHandle(ProcessInfo.hProcess);
if ProcessInfo.hThread <> 0 then CloseHandle(ProcessInfo.hThread);
MonitorProcessEx;
end;

procedure TForm1.btTurnClick(Sender: TObject);
begin
bMonitor :
= not bMonitor;
if bMonitor then
begin
btTurn.Caption :
= 'Stop';
if IsProcessExist then TerminateProcessEx;
Sleep(
20);
MonitorProcessEx;
end
else
begin
btTurn.Caption :
= 'Run';
end;
end;

end.

 

 

posted @ 2010-12-25 14:22  Jekhn  阅读(320)  评论(0编辑  收藏  举报