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:
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.
Comments:
<< Home
Just to clarify, in your code you have a Rem stating the AppAsService.conf and another Rem in the service.start with AppAsService.cfg.
Just so no one, Newbs and people like me, have any issues, the .cfg should .conf.
Of course easily changed in code. conf is good... Linux standard for such config/start up files.
John
Just so no one, Newbs and people like me, have any issues, the .cfg should .conf.
Of course easily changed in code. conf is good... Linux standard for such config/start up files.
John
# posted by 
: 7:22 AM
: 7:22 AM 
Another learning comment if I may,
in your code you have
for I := FAppList.Count - 1 to 0 do
I have never seen/used, as an example,
for I := 10 - 1 to 0.
I think I get compiler error when compiling a regular Delphi app.
Shouldn't this be: (or better)
for I := FAppList.Count - 1 downto 0 do
...
Thanks for the code!
John
in your code you have
for I := FAppList.Count - 1 to 0 do
I have never seen/used, as an example,
for I := 10 - 1 to 0.
I think I get compiler error when compiling a regular Delphi app.
Shouldn't this be: (or better)
for I := FAppList.Count - 1 downto 0 do
...
Thanks for the code!
John
# posted by : 11:07 AM
: 11:07 AM
I am full of questions today! Please forgive me!. But, in the downto referenced above, why use downto? I.E., Why create or run the apps in reverse order?
Does it matter?
When killing the apps when stopping, the they are in normal file order for i.e., I := X to Y.
Laslty, in the Service.Start, if the conf file does not exist or the conf file has no items contained within it, the service may crash with an out of bounds error. I have not seen it as I have not tested what such an error may do to/within a service.
So I added below:
FAppList := TStringList.Create;
the following:
if not FileExists(lPath + lName +'.conf') then
begin
{Add NT logging here for error condition}
exit;
end;
FAppList.LoadFromFile(lPath + lName +'.conf');
if not FAppList.Count > 0 then
begin
{Add NT logging here for error condition}
exit;
end;
John
Does it matter?
When killing the apps when stopping, the they are in normal file order for i.e., I := X to Y.
Laslty, in the Service.Start, if the conf file does not exist or the conf file has no items contained within it, the service may crash with an out of bounds error. I have not seen it as I have not tested what such an error may do to/within a service.
So I added below:
FAppList := TStringList.Create;
the following:
if not FileExists(lPath + lName +'.conf') then
begin
{Add NT logging here for error condition}
exit;
end;
FAppList.LoadFromFile(lPath + lName +'.conf');
if not FAppList.Count > 0 then
begin
{Add NT logging here for error condition}
exit;
end;
John
# posted by : 12:21 PM
: 12:21 PM
Regarding your "downto" question. Try this example:
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
lStr: TStrings;
begin
lStr := TStringList.Create;
for I := 0 to 10 do
begin
lStr.Add(IntToStr(I));
end;
for I := 0 to 10 do
begin
lStr.Delete(I);
end;
lStr.Free;
end;
It gives an Index out of bounds in the lStr.Delete(I), when I is equal to 6. This is caused by the way Delete removes items from the list.
If you use an for...downto loop, the error doesnt raises.
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
lStr: TStrings;
begin
lStr := TStringList.Create;
for I := 0 to 10 do
begin
lStr.Add(IntToStr(I));
end;
for I := 0 to 10 do
begin
lStr.Delete(I);
end;
lStr.Free;
end;
It gives an Index out of bounds in the lStr.Delete(I), when I is equal to 6. This is caused by the way Delete removes items from the list.
If you use an for...downto loop, the error doesnt raises.
Hola Leonardo, es muy interesante tu blog, quisiera que por favor me ayudaras con un proyecto de lazarus ya que vi una respuesta tuya en el foro al respecto del tema (lazreport); podrías hacerlo? mi email es:
palasquesea2005@hotmail.com
Otto
Post a Comment
palasquesea2005@hotmail.com
Otto
# posted by : 4:25 PM
: 4:25 PM << Home
