Эта программа может работать в двух режимах: как консольное приложение и как сервис. Функциональная часть удалена, для ее включения необходимо реализовать класс TCoreКлючи: нет ключей - консольное приложение -s - сервис -r - запуск установленного сервиса -i - установка приложения как сервис (ручной запуск сервиса) -a - автоматический запуск сервиса (совместно с -i) -u - удаление сервиса И так реализация: test.dpr | Код |
program testconsoleservice;
uses
Windows,
ParamsUnit in 'ParamsUnit.pas',
ConsoleUnit in 'ConsoleUnit.pas',
ServiceUnit in 'ServiceUnit.pas',
CoreUnit in 'CoreUnit.pas';
begin
InitParams;
if GetParamCount = 0 then
begin
StartConsole;
Exit
end;
if ParamPresent('-s') then
begin
StartingService;
Exit
end;
if ParamPresent('-r') then
begin
RunService;
Exit
end;
if ParamPresent('-i') then
begin
InstallService(ParamPresent('-a'));
Exit
end;
if ParamPresent('-u') then
begin
UninstallService;
Exit
end
end.
|
ParamsUnit.pas | Код |
unit ParamsUnit;
interface
uses
Windows;
procedure InitParams;
function GetParamCount: Integer; stdcall;
function GetParam(AIndex: Integer): PChar; stdcall;
function ParamPresent(AParam: PChar): BOOL; stdcall;
implementation
var
FParams: array [0..1023] of Char;
procedure InitParams;
var
i, j: Integer;
f: Boolean;
begin
lstrcpy(@FParams, GetCommandLine);
f := false;
for i := 0 to 1023 do
if (FParams[i] <> '-') or f then
begin
if FParams[i] = '"' then
f := not f;
FParams[i] := #0;
end else
Break;
for i := i to 1023 do
if FParams[i] <> #0 then
begin
if FParams[i] = '-' then
for j := i - 1 downto 0 do
if FParams[j] = ' ' then
FParams[j] := #0 else
Break;
end else
Exit
end;
function GetParamCount: Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to 1023 do
if FParams[i] = '-' then
Result := Result + 1
end;
function GetParam(AIndex: Integer): PChar;
var
i, ind: Integer;
begin
Result := nil;
ind := 0;
for i := 0 to 1023 do
if FParams[i] = '-' then
begin
if ind = AIndex then
begin
Result := @FParams[i];
Exit
end;
ind := ind + 1
end
end;
function ParamPresent(AParam: PChar): BOOL;
var
i: Integer;
begin
Result := false;
for i := 0 to 1023 do
if FParams[i] = '-' then
begin
Result := lstrcmp(AParam, @FParams[i]) = 0;
if Result then
Exit
end
end;
end.
|
ConsoleUnit.pas | Код |
unit ConsoleUnit;
interface
uses
Windows;
procedure StartConsole;
implementation
uses
CoreUnit;
function CtrlHandler(fdwCtrlType: DWORD): BOOL; stdcall;
begin
Result := true;
case fdwCtrlType of
CTRL_C_EVENT,
CTRL_BREAK_EVENT,
CTRL_CLOSE_EVENT,
CTRL_LOGOFF_EVENT,
CTRL_SHUTDOWN_EVENT: Core.Terminate
else
Result := false
end
end;
procedure StartConsole;
begin
if not AllocConsole then
begin
// LogError
Exit
end;
if not SetConsoleCtrlHandler(@CtrlHandler, true) then
begin
FreeConsole;
// LogError
Exit
end;
Core := TCore.Create;
if Core.Init then
Core.Run;
Core.Free;
FreeConsole
end;
end.
|
ServiceUnit.pas | Код |
unit ServiceUnit;
interface
uses
Windows, WinSvc;
procedure StartingService;
procedure RunService;
procedure InstallService(AAuto: Boolean);
procedure UninstallService;
implementation
uses
CoreUnit;
const
szServiceName: array [0..18] of Char = 'testconsoleservice';
szServiceDisplayName: array [0..19] of Char = 'Тест Сервис Консоль';
var
DispatchTable: array [0..1] of SERVICE_TABLE_ENTRY;
ServiceStatus: SERVICE_STATUS;
ServiceStatusHandle: SERVICE_STATUS_HANDLE;
procedure ServiceCtrlHandler(fdwControl: DWORD);
begin
case fdwControl of
SERVICE_CONTROL_STOP: begin
ServiceStatus.dwWin32ExitCode := 0;
ServiceStatus.dwCurrentState := SERVICE_STOPPED;
ServiceStatus.dwCheckPoint := 0;
ServiceStatus.dwWaitHint := 0;
Core.Terminate;
if not SetServiceStatus(ServiceStatusHandle, ServiceStatus) then
begin
// LogError
Exit
end;
end;
SERVICE_CONTROL_INTERROGATE: ;
end
end;
procedure ServiceMain(dwArgc: DWORD; lpszArgv: LPTSTR);
begin
ServiceStatus.dwServiceType := SERVICE_WIN32;
ServiceStatus.dwCurrentState := SERVICE_START_PENDING;
ServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP;
ServiceStatus.dwWin32ExitCode := 0;
ServiceStatus.dwServiceSpecificExitCode := 0;
ServiceStatus.dwCheckPoint := 0;
ServiceStatus.dwWaitHint := 0;
ServiceStatusHandle := RegisterServiceCtrlHandler(@szServiceName,
@ServiceCtrlHandler);
if ServiceStatusHandle = 0 then
begin
// LogError
Exit
end;
Core := TCore.Create;
if not Core.Init then
begin
ServiceStatus.dwCurrentState := SERVICE_STOPPED;
ServiceStatus.dwCheckPoint := 0;
ServiceStatus.dwWaitHint := 0;
ServiceStatus.dwWin32ExitCode := 0;
ServiceStatus.dwServiceSpecificExitCode := 0;
SetServiceStatus(ServiceStatusHandle, ServiceStatus);
// LogError
Core.Free;
Exit
end;
ServiceStatus.dwCurrentState := SERVICE_RUNNING;
ServiceStatus.dwCheckPoint := 0;
ServiceStatus.dwWaitHint := 0;
if not SetServiceStatus(ServiceStatusHandle, ServiceStatus) then
begin
// LogError
Core.Free;
Exit
end;
Core.Run;
Core.Free
end;
procedure StartingService;
begin
DispatchTable[0].lpServiceName := @szServiceName;
DispatchTable[0].lpServiceProc := @ServiceMain;
DispatchTable[1].lpServiceName := nil;
DispatchTable[1].lpServiceProc := nil;
StartServiceCtrlDispatcher(DispatchTable[0])
end;
procedure RunService;
var
scm: SC_HANDLE;
srv: SC_HANDLE;
p: PChar;
begin
scm := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if scm = 0 then
begin
// LogError
Exit
end;
srv := OpenService(scm, @szServiceName, SERVICE_ALL_ACCESS);
if srv = 0 then
begin
// LogError
Exit
end;
p := nil;
if not StartService(srv, 0, p) then
begin
CloseServiceHandle(srv);
// LogError
Exit
end;
CloseServiceHandle(srv)
end;
procedure InstallService(AAuto: Boolean);
var
scm: SC_HANDLE;
srv: SC_HANDLE;
st: Cardinal;
fn, sc: array [0..1023] of Char;
begin
GetModuleFileName(0, @fn, 1024);
lstrcpy(sc, '"');
lstrcat(sc, @fn);
lstrcat(sc, '" -s');
scm := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if scm = 0 then
begin
// LogError
Exit
end;
st := SERVICE_DEMAND_START;
if AAuto then
st := SERVICE_AUTO_START;
srv := CreateService(scm, @szServiceName, @szServiceDisplayName,
SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS, st, SERVICE_ERROR_NORMAL,
@sc, nil , nil, nil, nil, nil);
if srv = 0 then
begin
// LogError
Exit
end;
CloseServiceHandle(srv)
end;
procedure UninstallService;
var
scm: SC_HANDLE;
srv: SC_HANDLE;
begin
scm := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if scm = 0 then
begin
// LogError
Exit
end;
srv := OpenService(scm, @szServiceName, SERVICE_ALL_ACCESS);
if srv = 0 then
begin
// LogError
Exit
end;
if not DeleteService(srv) then
begin
CloseServiceHandle(srv);
// LogError
Exit
end;
CloseServiceHandle(srv)
end;
end.
|
CoreUnit.pas | Код |
unit CoreUnit;
interface
uses
Windows;
type
TCore = class
private
public
constructor Create;
destructor Destroy; override;
function Init: BOOL;
procedure Run;
procedure Terminate;
end;
var
Core: TCore;
implementation
{ TCore }
constructor TCore.Create;
begin
inherited Create
end;
destructor TCore.Destroy;
begin
inherited Destroy
end;
function TCore.Init: BOOL;
begin
end;
procedure TCore.Run;
begin
end;
procedure TCore.Terminate;
begin
end;
end.
|
--------------------
Хорошую информацию трудно добыть. Сделать с ней что-нибудь - еще труднее. /L. Skywalker/
Что же я сделал не так? /Король Лир/
Я делаю это для твоего же блага! /Любой родитель и палач/
PKUNZIP.ZIP /неизвестный/ |
Пример программы работающей в двух режимах, как сервис и как консольное приложение 
Загрузка ...
