不知道为什么,服务关闭的时候FORM才显示出来,而且关闭FORM的时候会出错,不知道哪弄错了?
代码是网上找的改的

program Project2;

uses
  Forms,
SysUtils,   Windows,   WinSvc,
  Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
const   
ServiceName   =   '1aTomDemoService';
ServiceDisplayName   =   '1ad99   test   Service';
SERVICE_WIN32_OWN_PROCESS   =   $00000010;
SERVICE_DEMAND_START   =   $00000003;
SERVICE_ERROR_NORMAL   =   $00000001;   
EVENTLOG_ERROR_TYPE   =   $0001;   

//   declare   global   variable   
var   
ServiceStatusHandle:   SERVICE_STATUS_HANDLE;   
ssStatus:   TServiceStatus;   
dwErr:   DWORD;
ServiceTableEntry:   array[0..1]   of   TServiceTableEntry;
hServerStopEvent:   THandle;

// Get error message

function GetLastErrorText: string;
var
dwSize: DWORD;
lpszTemp: LPSTR;
begin
dwSize := 512;
lpszTemp := nil;
try
GetMem(lpszTemp, dwSize);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY,
nil, GetLastError, LANG_NEUTRAL, lpszTemp, dwSize, nil);
finally
Result := StrPas(lpszTemp);
FreeMem(lpszTemp);
end;
end;

function ReportStatusToSCMgr(dwState, dwExitCode, dwWait: DWORD): BOOL;
begin
Result := True;
with ssStatus do
begin
if (dwState = SERVICE_START_PENDING) then
dwControlsAccepted := 0
else
dwControlsAccepted := SERVICE_ACCEPT_STOP;

dwCurrentState := dwState;
dwWin32ExitCode := dwExitCode;
dwWaitHint := dwWait;

if (dwState = SERVICE_RUNNING) or (dwState = SERVICE_STOPPED) then
dwCheckPoint := 0
else
inc(dwCheckPoint);
end;

Result := SetServiceStatus(ServiceStatusHandle, ssStatus);
end;

procedure ServiceStop;
begin
if (hServerStopEvent > 0) then
begin
SetEvent(hServerStopEvent);
end;
end;

procedure ServiceStart;
var
dwWait: DWORD;
begin

// Report Status
if not ReportStatusToSCMgr(SERVICE_START_PENDING, NO_ERROR, 3000) then exit;

// this event when it receives the "stop" control code.
hServerStopEvent := createEvent(nil, TRUE, False, nil);
if hServerStopEvent = 0 then exit;

if not ReportStatusToSCMgr(SERVICE_RUNNING, NO_ERROR, 0) then
begin

CloseHandle(hServerStopEvent);
exit;
end;
Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;

{ Service now running , perform work until shutdown
while True do
begin
// Wait for Terminate
//MessageBeep(1);
dwWait := WaitforSingleObject(hServerStopEvent, 1);
if dwWait = WAIT_OBJECT_0 then
begin
CloseHandle(hServerStopEvent);
exit;
end;
Sleep(1000 * 10);
end;
}
end;

procedure Handler(dwCtrlCode: DWORD); stdcall;
begin
// Handle the requested control code.
case dwCtrlCode of

SERVICE_CONTROL_STOP:
begin
ReportStatusToSCMgr(SERVICE_STOP_PENDING, NO_ERROR, 0);
ServiceStop;
ReportStatusToSCMgr(SERVICE_STOPPED, GetLastError, 0);
exit;
end;

SERVICE_CONTROL_INTERROGATE:
begin
end;

SERVICE_CONTROL_PAUSE:
begin
end;

SERVICE_CONTROL_CONTINUE:
begin
end;

SERVICE_CONTROL_SHUTDOWN:
begin
end;

// invalid control code
else
end;

// update the service status.
ReportStatusToSCMgr(ssStatus.dwCurrentState, NO_ERROR, 0);
end;

procedure ServiceMain;
begin
// Register the handler function with dispatcher;
ServiceStatusHandle := RegisterServiceCtrlHandler(ServiceName, ThandlerFunction(@Handler));
if ServiceStatusHandle = 0 then
begin
ReportStatusToSCMgr(SERVICE_STOPPED, GetLastError, 0);
exit;
end;

ssStatus.dwServiceType := SERVICE_WIN32_OWN_PROCESS;
ssStatus.dwServiceSpecificExitCode := 0;
ssStatus.dwCheckPoint := 1;

// Report current status to SCM (Service Control Manager)
if not ReportStatusToSCMgr(SERVICE_START_PENDING, NO_ERROR, 3000) then
begin
ReportStatusToSCMgr(SERVICE_STOPPED, GetLastError, 0);
exit;
end;

// Start Service
ServiceStart;
end;

procedure InstallService;
var
schService: SC_HANDLE;
schSCManager: SC_HANDLE;
lpszPath: LPSTR;
dwSize: DWORD;
begin
dwSize := 512;
GetMem(lpszPath, dwSize);
if GetModuleFileName(0, lpszPath, dwSize) = 0 then
begin
FreeMem(lpszPath);
exit;
end;
FreeMem(lpszPath);

schSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if (schSCManager > 0) then
begin
schService := createService(schSCManager, ServiceName, ServiceDisplayName,
SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS or   SERVICE_INTERACTIVE_PROCESS , SERVICE_DEMAND_START,
SERVICE_ERROR_NORMAL, pchar(ParamStr(0)), nil, nil, nil, nil, nil);
if (schService > 0) then
begin
CloseServiceHandle(schService);
end;
end;

end;

procedure UnInstallService;
var
schService: SC_HANDLE;
schSCManager: SC_HANDLE;
begin
schSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if (schSCManager > 0) then
begin
schService := OpenService(schSCManager, ServiceName, SERVICE_ALL_ACCESS);
if (schService > 0) then
begin
// Try to stop service at first
if ControlService(schService, SERVICE_CONTROL_STOP, ssStatus) then
begin
Sleep(1000);
while (QueryServiceStatus(schService, ssStatus)) do
begin
if ssStatus.dwCurrentState = SERVICE_STOP_PENDING then
begin
Sleep(1000);
end
else
break;
end;

CloseServiceHandle(schService);
CloseServiceHandle(schSCManager);

exit;
end;

// Remove the service
if (deleteService(schService)) then
Writeln('Service Uninstall Ok.')
else
Writeln('deleteService fail (' + GetLastErrorText + ').');

CloseServiceHandle(schService);
end
else
Writeln('OpenService fail (' + GetLastErrorText + ').');

CloseServiceHandle(schSCManager);
end
else
Writeln('OpenSCManager fail (' + GetLastErrorText + ').');
end;

BEGIN

//   Setup   service   table   which   define   all   services   in   this   process
with   ServiceTableEntry[0]   do
begin
lpServiceName   :=   ServiceName;
lpServiceProc   :=   @ServiceMain;
end;

//   Last   entry   in   the   table   must   have   nil   values   to   designate   the   end   of   the   table
with   ServiceTableEntry[1]   do
begin
lpServiceName   :=   nil;
lpServiceProc   :=   nil;
end;

if   not   StartServiceCtrlDispatcher(ServiceTableEntry[0])   then
begin
Halt;
end;

//   InstallService;
//  ServiceStart;

  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;

end.

[培训]科锐逆向工程师培训第53期2025年7月8日开班！

上传的附件：

• aoshi.rar （187.88kb，5次下载）