程序安装为服务的问题

Question

网上找的下面的代码,如果加上这段代码服务就可以启动了,但是程序的功能也没了,不知道该怎么改一下,可以不管是直接程序启动还是服务都可以启动,谢谢
unit mysrv;// Windows NT Service Demo Program for Delphi 3 
// By Tom Lee , Taiwan , Repubilc of China ( [email protected] )
// JUL 8 1997 
// ver 1.01 
// The service will beep every 10 second . interface
uses SysUtils, Windows, WinSvc; const 
ServiceName = 'TomDemoService'; 
ServiceDisplayName = 'd99 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 
implementationfunction 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; // Write error message to Windows NT Event Log 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); 
if not Result then exit;
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; // Service now running , perform work until shutdown 
while True do 
begin 
// Wait for Terminate 
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, 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
            Sleep(1000)
            else
            break;
            end;
      end;
    end;
  end;
if ssStatus.dwCurrentState = SERVICE_STOPPED then
begin
CloseServiceHandle(schService);
CloseServiceHandle(schSCManager);
exit;
end; // Remove the service
deleteService(schService);
CloseServiceHandle(schService);
CloseServiceHandle(schSCManager);
end;// Main Program Begin 可能是这的问题,但是我也不知道怎么改
begin
if (ParamCount = 1) then
begin 
if ParamStr(1) = '/?' then 
begin 
Writeln('----------------------------------------'); 
Writeln('DEMOSRV usage help'); 
Writeln('----------------------------------------'); 
Writeln('DEMOSRV /install to install the service'); 
Writeln('DEMOSRV /remove to uninstall the service'); 
Writeln('DEMOSRV /? Help'); 
Halt; 
end; if Uppercase(ParamStr(1)) = '/INSTALL' then 
begin 
InstallService; 
Halt; 
end; if Uppercase(ParamStr(1)) = '/REMOVE' then 
begin 
UnInstallService;
Halt; 
end; 
end; // 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; 
end.

Answer 1

如果没记错，如果是Delphi5(没用过Delphi4)~Delphi7可以到Source\VCL目录找到一个ScktSrvr.dpr，打开来看看，该程序是桌面应用与服务应用双栖的。Delphi2007是在Source\Win32\VCL\DB目录(Delphi2006的忘了，估计跟Delphi2007差不多)。

Answer 2

代码那么长，懒的看 提供你思路吧自己写个函数注册服务的函数  function Installing: Boolean;
begin
  Result := FindCmdLineSwitch('INSTALL',['-','\','/'], True) or
            FindCmdLineSwitch('UNINSTALL',['-','\','/'], True);
end;project代码中的 begin..end之间判断该服务有没有被注册以及被启动如果有则      
    SvcMgr.Application.Initialize;  这句话的就代表服务运行的初始化
若达不到上叙两个条件则 
    Forms.Application.Initialize;  
    

Answer 3

是给一个现有的程序加上装为服务的功能,我把网上的找到的代码都加到合适的地方了,可是程序启动不了,服务也启动不了,不知道是哪出错了,因为急着用,现在学已经来不及了,各位能否帮忙看看哪出错了呀?
program Project2;uses
  Forms,SysUtils,   Windows,   WinSvc,
  Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
const   
ServiceName   =   'aTomDemoService';
ServiceDisplayName   =   'ad99   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;   //   Write   error   message   to   Windows   NT   Event   Log   
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);   
if   not   Result   then   exit; 
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;   //   Service   now   running   ,   perform   work   until   shutdown   
while   True   do   
begin   
//   Wait   for   Terminate   
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,   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 
                        Sleep(1000) 
                        else 
                        break; 
                        end; 
            end; 
        end; 
    end; 
if   ssStatus.dwCurrentState   =   SERVICE_STOPPED   then 
begin 
CloseServiceHandle(schService); 
CloseServiceHandle(schSCManager); 
exit; 
end;   //   Remove   the   service 
deleteService(schService); 
CloseServiceHandle(schService); 
CloseServiceHandle(schSCManager); 
end; begin
  if   (ParamCount   =   1)   then
begin
if ParamStr(1) = '/?' then
begin
Writeln('----------------------------------------');
Writeln('DEMOSRV usage help');
Writeln('----------------------------------------');
Writeln('DEMOSRV /install to install the service');
Writeln('DEMOSRV /remove to uninstall the service');
Writeln('DEMOSRV /? Help');
Halt;
end;if   Uppercase(ParamStr(1))   =   '/INSTALL'   then
begin
InstallService;
Halt;   
end;   if   Uppercase(ParamStr(1))   =   '/REMOVE'   then   
begin   
UnInstallService; 
Halt;   
end;
end;   //   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;  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;end.