Tuesday, December 09, 2008

 

Launch application as a service


Sometimes you need an application to start before the user logs in to Windows, just as Services do. If you have the source code, this is not a problem, but what if you don't have access to it?.

With this small Delphi program you can launch a list of applications as windows services very easily.

How to use it?

After creating the service with the code below, you'll have to create the file AppAsService.conf containing the list of applications you want to start using this structure: [program];[parameters].

Sample AppAsService.conf file:

c:\program files\filesharer\filesharer.exe;autostart
c:\myprograms\utils\clock.exe

This is the code:

program AppAsService;

uses
SvcMgr,
main in 'main.pas' {Service1: TService};

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TService1, Service1);
Application.Run;
end.



unit main;

interface

uses
Windows, Messages, SysUtils, Classes, SvcMgr, ShellApi, TlHelp32;

type
TService1 = class(TService)
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
private
FAppList: TStringList;
function pKill(ExeFileName: string): Boolean;
public
function GetServiceController: TServiceController; override;
end;

var
Service1: TService1;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Service1.Controller(CtrlCode);
end;

function TService1.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
(*
AppAsService.conf example: ;
c:\program files\Mozilla Firefox\firefox.exe;http:\\www.google.com
*)

var
lPath: string;
lName: string;
I: Integer;
lApp: PChar;
lParams: PChar;
begin
lPath := ExtractFilePath(ParamStr(0));
lName := ExtractFileName(ParamStr(0));
lName := Copy(lName, 0, Pos('.', lName) - 1);

FAppList := TStringList.Create;
FAppList.LoadFromFile(lPath + lName +'.conf');
for I := FAppList.Count - 1 downto 0 do
begin
lApp := PChar(Copy(FAppList[I], 0, Pos(';', FAppList[I]) - 1));
if not FileExists(lApp) then
FAppList.Delete(I)
else
begin
(* ShellExecute the app *)
lParams := PChar(Copy(FAppList[I], Pos(';', FAppList[I]) + 1, Length(FAppList[I])));
ShellExecute(0, 'open', lApp, lParams, PChar(ExtractFilePath(lApp)), SW_NORMAL);
(* Replace FApplist[I] by the AppName *)
FAppList[I] := ExtractFileName(lApp);
end;
end;
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
var
I: Integer;
lProcess: Cardinal;
lProcHandle: Cardinal;
lExitCode: Cardinal;
begin
for I := 0 to FAppList.Count - 1 do
pKill(FAppList[I]);
FAppList.Free;
end;


function TService1.pKill(ExeFileName: string): Boolean;
const
PROCESS_TERMINATE=$0001;
var
ContinueLoop: BOOL;FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
result := False;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);
while integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName))
or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then
Result := TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0),
FProcessEntry32.th32ProcessID), 0);
ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;

end.

This page is powered by Blogger. Isn't yours?