unit Origin;
interface
uses
Windows, SysUtils, SvcMgr,
Sockets, TlHelp32, Classes, Inifiles;
type
TOriginSP = class(TService)
TcpSrv: TTcpServer;
procedure TcpSrvAccept(Sender: TObject; ClientSocket: TCustomIpClient);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceExecute(Sender: TService);
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceStart(Sender: TService; var Started: Boolean);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
var
OriginSP: TOriginSP;
SP_EXE : string;
implementation
var
sIP , sPort : string;
{$R *.DFM}
//const
// SP_EXE = 'D:/HosSP/SP_Server/Bin/SPServer.exe' ;
//-----------------------服务器操作程序--------------------------//
function GetSPEXE : string;
begin
with TIniFile.Create(ExtractFilePath(ParamStr(0))+'SPExe.ini') do
try
try
Result := ReadString('SP','Exe','D:/HosSP/SP_Server/Bin/SPServer.exe');
sIP := ReadString('SP','SrvIP','192.168.0.31');
sPort := ReadString('SP','SrvPort','10110');
except
Result := 'D:/HosSP/SP_Server/Bin/SPServer.exe' ;
sIP := '192.168.0.31' ;
sPort := '10110' ;
end;
finally
Free ;
end;
end;
function IsRun(ExeFile : String) : boolean;
var
lppe:TProcessEntry32;
ssHandle:THandle;
IsFound : Boolean;
begin
try
ssHandle := createtoolhelp32snapshot(TH32CS_SNAPALL,0);
lppe.dwSize := Sizeof(lppe); //初始化结构，不能少
IsFound := Process32First(ssHandle,lppe);
while Isfound do begin
if UpperCase(ExtractFileName(lppe.szExeFile)) = UpperCase(ExtractFilename(SP_EXE)) then begin
Result := true;
exit;
end;
IsFound := Process32Next(ssHandle,lppe);
end;
Result := false;
except
Exit ;
end;
end;
procedure StartSP;
begin
// if not IsRun(SP_EXE) then
SP_EXE := GetSPExe ;
// ShellExecute(0,'open',PChar(SP_EXE),nil,nil,SW_SHOWNORMAL);
WinExec(PChar(SP_EXE),SW_SHOWNORMAL);
end;
procedure StopSP;
var
lppe:TProcessEntry32;
ssHandle:THandle;
hh:hwnd;
IsFound : Boolean;
begin
ssHandle := createtoolhelp32snapshot(TH32CS_SNAPALL,0);
lppe.dwSize := Sizeof(lppe); //初始化结构，不能少，否则不能结束进程
IsFound := Process32First(ssHandle,lppe);
while Isfound do begin
if UpperCase(ExtractFileName(lppe.szExeFile)) = UpperCase(ExtractFilename(SP_EXE)) then begin
try
hh :=OpenProcess(PROCESS_ALL_ACCESS,true,lppe.th32ProcessID);
if TerminateProcess(hh,0) then
WaitForSingleObject(hh, INFINITE);
//IsStart := false;
exit;
finally
CloseHandle(hh);
end;
end;
IsFound := Process32Next(ssHandle,lppe);
end;
end;
procedure ReStartSP;
begin
StopSp;
sleep(1000);
StartSP;
end;
procedure ParseStr(Str : string);
begin
begin
if Str = 'START' then begin
StartSP ;
Exit;
end;
if Str = 'STOP' then begin
StopSP ; Exit;
end;
if Str = 'RESTART' then begin
RestartSP ; exit;
end;
end;
end;
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
OriginSP.Controller(CtrlCode);
end;
function TOriginSP.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TOriginSP.ServiceContinue(Sender: TService; var Continued: Boolean);
begin
SP_EXE := GetSPExe ;
while not Terminated do begin
ServiceThread.ProcessRequests(False);
Sleep(10);
end;
end;
procedure TOriginSP.ServiceExecute(Sender: TService);
begin
try
SP_EXE := GetSPExe ;
TcpSrv.Active := False ;
TcpSrv.LocalHost := sIP ;
TcpSrv.LocalPort := sPort ;
TcpSrv.Active := True ;
while not Terminated do begin
ServiceThread.ProcessRequests(False);
Sleep(10);
end;
TcpSrv.Active := False ;
except
end;
end;
procedure TOriginSP.ServicePause(Sender: TService; var Paused: Boolean);
begin
Paused := True;
end;
procedure TOriginSP.ServiceStart(Sender: TService; var Started: Boolean);
begin
SP_EXE := GetSPExe ;
end;
procedure TOriginSP.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
TcpSrv.Active := False ;
end;
procedure TOriginSP.TcpSrvAccept(Sender: TObject;
ClientSocket: TCustomIpClient);
var
StrCmd : string ;
begin
StrCmd := UpperCase(Trim(ClientSocket.Receiveln())) ;
while StrCmd <> '' do
begin
ParseStr(Strcmd);
StrCmd := UpperCase(Trim(ClientSocket.Receiveln())) ;
end;
end;
end.
上面是全部程序代码，另外，在项目文件是这样的：
program OriginSrv;
uses
SvcMgr,
Origin in 'Origin.pas' {OriginSP: TService};
{$R *.RES}
begin
// Windows 2003 Server requires StartServiceCtrlDispatcher to be
// called before CoRegisterClassObject, which can be called indirectly
// by Application.Initialize. TServiceApplication.DelayInitialize allows
// Application.Initialize to be called from TService.Main (after
// StartServiceCtrlDispatcher has been called).
//
// Delayed initialization of the Application object may affect
// events which then occur prior to initialization, such as
// TService.OnCreate. It is only recommended if the ServiceApplication
// registers a class object with OLE and is intended for use with
// Windows 2003 Server.
//
// Application.DelayInitialize := True;
//
if not Application.DelayInitialize or Application.Installing then
Application.Initialize;
Application.CreateForm(TOriginSP, OriginSP);
Application.Run;
end.
上面的注释好像是说Windows 2003 里好像应该做些其他的什么。
// Application.DelayInitialize := True;
把上面这句的注释去掉也不行。
另，为了这个问题，已经为Windows Server 2003 EnterPrise 打了SP1,在数据保护里面也加上了我要启动的程序。还是不行。
非常之郁闷！！！！！！！！！[
][
][
][
]
