Вот пример накатал... изучай: | Код | program gServ;
uses
Windows, WinSvc, Messages;
{$R *.res}
type
TSysCharSet=set of Char;
TCurrentStatus=(csStopped,csStartPending,csStopPending,csRunning,
csContinuePending,csPausePending,csPaused);
var tID,hThread:DWord;
FStatusHandle:DWord;
Name:string;
OldExitProc:Pointer;
STE:array [0..1] of _Service_Table_Entrya;
Status:TCurrentStatus;
AppStart:Boolean;
function AnsiCompareText(const S1, S2: string): Integer;
begin
Result:=CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(S1), Length(S1), PChar(S2), Length(S2)) - 2;
end;
procedure ReportStatus;
const
LastStatus:TCurrentStatus = csStartPending;
NTServiceStatus: array[TCurrentStatus] of Integer =
(SERVICE_STOPPED,SERVICE_START_PENDING,
SERVICE_STOP_PENDING,SERVICE_RUNNING,
SERVICE_CONTINUE_PENDING,SERVICE_PAUSE_PENDING,SERVICE_PAUSED);
PendingStatus: set of TCurrentStatus = [csStartPending,csStopPending,
csContinuePending,csPausePending];
var
ServiceStatus: TServiceStatus;
begin
with ServiceStatus do
begin
dwWaitHint:=5000;
dwServiceType:=SERVICE_WIN32_OWN_PROCESS;
if Status=csStartPending then dwControlsAccepted:=0 else
dwControlsAccepted:=SERVICE_ACCEPT_SHUTDOWN or SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE;
if (Status in PendingStatus)and(Status=LastStatus) then
Inc(dwCheckPoint) else dwCheckPoint:=0;
dwCurrentState:=NTServiceStatus[Status];
dwWin32ExitCode:=0;
dwServiceSpecificExitCode:=0;
SetServiceStatus(FStatusHandle, ServiceStatus);
end;
end;
function ThreadProc(Param:Pointer):DWord; stdcall;
begin
//главная функции программы - здесь должен быть основной код сервиса.
//Result:=0;
while true do
begin
Sleep(1000);
//Какой-то код;
end;
end;
procedure Handler(CtrlCode: DWord);stdcall;
begin
case CtrlCode of
SERVICE_CONTROL_STOP: begin
Status:=csStopPending;
//Какой-то код;
TerminateThread(hThread,0);
end;
SERVICE_CONTROL_SHUTDOWN: begin
Status:=csStopPending;
//Какой-то код;
TerminateThread(hThread,0);
end;
SERVICE_CONTROL_PAUSE: begin
Status:=csPausePending;
//Какой-то код;
Status:=csPaused;
SuspendThread(hThread);
end;
SERVICE_CONTROL_CONTINUE: begin
ResumeThread(hThread);
Status:=csContinuePending;
//Какой-то код;
Status := csRunning;
end;
SERVICE_CONTROL_INTERROGATE: ReportStatus;
end;
ReportStatus;
end;
procedure ServiceMain(Argc: DWord; Argv: PLPSTR); stdcall;
begin
hThread:=CreateThread(nil,0,@ThreadProc,nil,0,tID);
FStatusHandle:=RegisterServiceCtrlHandler(PChar(Name),@Handler);
Status:=csStartPending;
ReportStatus();
//Какой-то код;
Status:=csRunning;
//Какой-то код;
ReportStatus();
WaitForSingleObject(hThread,INFINITE);
CloseHandle(hThread);
Status:=csStopped;
//Какой-то код;
ReportStatus();
end;
procedure DoneServiceApplication(ex:DWord);stdcall;
begin
ExitProc:=OldExitProc;
end;
function FindCmdLineSwitch(const Switch: string; const Chars: TSysCharSet):Boolean;
var I:Integer;
S:string;
begin
for I:=1 to ParamCount do
begin
S := ParamStr(I);
if ((Chars=[])or(S[1] in Chars))and(AnsiCompareText(Copy(S,2,Maxint),Switch)=0) then
begin
Result:=True;
Exit;
end;
end;
Result:=False;
end;
function FindSwitch(const Switch: string): Boolean;
begin
Result:=FindCmdLineSwitch(Switch,['-', '/']);
end;
function RegisterServices(Install,Start:Boolean):Boolean;
var SvcMgr:DWord;
function InstallService():Boolean;
var Svc:Integer;
Path:string;
lpServiceArgVectors:PChar;
begin
Result:=false;
Path:=ParamStr(0);
Svc:=CreateService(SvcMgr,PChar(Name),'Аааа - Сервис',SERVICE_ALL_ACCESS,
SERVICE_WIN32_OWN_PROCESS, SERVICE_AUTO_START, SERVICE_ERROR_NORMAL,
PChar(Path),'',nil,'',nil,'');
if Svc=0 then exit;
if Start then
begin
lpServiceArgVectors:=nil;
if StartService(Svc,0,PChar(lpServiceArgVectors)) then Result:=true else DeleteService(Svc);
end else Result:=true;
CloseServiceHandle(Svc);
end;
function UninstallService():Boolean;
var Svc:Integer;
ServiceStatus:TServiceStatus;
begin
Result:=false;
Svc:=OpenService(SvcMgr,PChar(Name),SERVICE_ALL_ACCESS);
if Svc=0 then exit;
ControlService(Svc,SERVICE_CONTROL_STOP,ServiceStatus);
if DeleteService(Svc) then Result:=true;
CloseServiceHandle(Svc);
end;
begin
Result:=false;
SvcMgr:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
if SvcMgr=0 then exit;
if Install then Result:=InstallService() else Result:=UninstallService();
CloseServiceHandle(SvcMgr);
end;
begin
AppStart:=true;//Запустить(или нет) сервис после инсталяции
OldExitProc:=ExitProc;
ExitProc:=@DoneServiceApplication;
Name:='GirderX';
if FindSwitch('INSTALL') then RegisterServices(True,AppStart) else
if FindSwitch('UNINSTALL') then RegisterServices(False,AppStart) else
begin
STE[0].lpServiceName:=PChar(Name);
STE[0].lpServiceProc:=@ServiceMain;
STE[1].lpServiceName:=nil;
STE[1].lpServiceProc:=nil;
StartServiceCtrlDispatcher(STE[0]);
end;
end. |
PS: Писать все за тебя я не стал - Лень 
Что бы не ломать дров... почитай: http://www.rsdn.ru/article/baseserv/services_details.xml |