A standalone Delphi application that can also be installed as windows service - windows

In Delphi you can create a standalone Windows VCL Forms application. You can also create a Windows service application.
Is it possible to combine the two in a single application that can run as a standalone application and can also be installed as a Windows service?

Totally possible. The trick is to edit the .dpr to create main form when you want to run as an application and the service form when you want to run as a service. Like this:
if SvComFindCommand('config') then begin
//When run with the /config switch, display the configuration dialog.
Forms.Application.Initialize;
Forms.Application.CreateForm(TfrmConfig, frmConfig);
Forms.Application.Run;
end
else begin
SvCom_NTService.Application.Initialize;
SvCom_NTService.Application.CreateForm(TscmServiceSvc, scmServiceSvc);
SvCom_NTService.Application.Run;
end;
The code above uses SvCom to run the service but exactly the same effect could be achieved using the standard TService.
I wrote an article about that for The Delphi Magazine many years ago. You can read it here: Many Faces Of An Application.

It'll be hard to explain but I will try :)
I've done it in my project like that (Delphi 5):
program TestSvc;
uses SvcMgr,
SvcMain, //the unit for TTestService inherited from TService
...
;
var
IsDesktopMode : Boolean;
function IsServiceRunning : Boolean;
var
Svc: Integer;
SvcMgr: Integer;
ServSt : TServiceStatus;
begin
Result := False;
SvcMgr := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
if SvcMgr = 0 then Exit;
try
Svc := OpenService(SvcMgr, 'TestService', SERVICE_QUERY_STATUS);
if Svc = 0 then Exit;
try
if not QueryServiceStatus(Svc, ServSt) then Exit;
Result := (ServSt.dwCurrentState = SERVICE_RUNNING) or (ServSt.dwCurrentState = SERVICE_START_PENDING);
finally
CloseServiceHandle(Svc);
end;
finally
CloseServiceHandle(SvcMgr);
end;
end;
begin
if (Win32Platform <> VER_PLATFORM_WIN32_NT) or FindCmdLineSwitch('S', ['-', '/'], True) then
IsDesktopMode := True
else begin
IsDesktopMode := not FindCmdLineSwitch('INSTALL', ['-', '/'], True) and
not FindCmdLineSwitch('UNINSTALL', ['-', '/'], True) and
not IsServiceRunning;
end;
if IsDesktopMode then begin //desktop mode
Forms.Application.Initialize;
Forms.Application.Title := 'App. Title';
ShowTrayIcon(Forms.Application.Icon.Handle, NIM_ADD); // This function for create an icon to tray. You can create a popupmenu for the Icon.
while GetMessage(Msg, 0, 0, 0) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
ShowTrayIcon(Forms.Application.Icon.Handle, NIM_DELETE); // for delete the tray Icon
end else begin // Service mode
SvcMgr.Application.Initialize;
SvcMgr.Application.CreateForm(TTestService, TestService);
SvcMgr.Application.Run;
end;
end.

Another almost simpler option is available at http://cc.embarcadero.com/item/19703, you just need to include a unit and change your DPR to something like:
begin
if CiaStartService('SERVICE NAME') then begin
CiaService.CreateForm(TMain, Main);
CiaService.Run;
Exit;
end;
Application.Initialize;
Application.Title := 'SERVICE NAME';
Application.CreateForm(TMain, Main);
Application.Run;
end.
While this example is now quite dated, the technique is simple enough that it still works, even with Delphi XE2. With this in place, your application will continue to operate as a non-service until you use the "/install" parameter (on an elevated command prompt). After which it will operate as a service until you use the "/uninstall" parameter (also on an elevated command prompt).

There is a solution for this problem without writing a single line of code. It depends a little on your application, but generally it is achievable. Try this: http://iain.cx/src/nssm. Don't forget to start all services that you application depends on BEFORE you start your application as a service. Google around for info on how to do that.

It is possible but in that case you cannot use the normal TServiceApplication and TService. You should implement all the service specific code yourself.
We had a similat problem and made two frame applications: one for the sand alone exe and one for the service. Now we can create a single BPL/DLL that is embedded in both containers.
If you want to spend some money: you should look at SvCOM, I think they have a solution to the problem.

Related

I cannot delete a just created textfile

When I create a textfile, next copy it to another directory and then try to delete the original, it won't work, because the programa keeps the file locked.
Before deleting the file, I set the file-attribute to 'normal'like this:
SetFileAttributes((pchar('C:\test')),FILE_ATTRIBUTE_NORMAL);
I cannot find any simple solution to resolve this.
I create the file like this:
bestand:= tstringlist.Create;
try
r:= FindFirst('test.*', faAnyFile, Res);
try
EOFound:= False;
if (r = 0) then
while not EOFound do
begin
bestand.Add(res.Name);
EOFound:= FindNext(Res) <> 0;
end;
finally
FindClose(Res);
end;
finally
bestand.SaveToFile('C:\test');
bestand.Free;
end;
The same problem occurs when only reading the file like this:
AssignFile(Txt,TmpBest);
Reset(Txt);
while not Eof(Txt) do
begin
Readln(Txt, s);
L.Items.add.caption:=s;
end;
CloseFile(Txt);
Later, I set the file attributes to 'Normal' and try to delete the file:
if CopyFile(pchar(file-org), pchar(file-dest), false) then
begin
SetFileAttributes(pchar(file-org),FILE_ATTRIBUTE_NORMAL);
if not DeleteFile(file-org) then
showmessage('delete ' + file-org + ' failed!');
where file-org is file Txt/TmpBest from the description above.
I must say: I am not a Delphi programmer; I write in COBOL, but 'inherited' this Delphi-program from a former collegue and need to add some changes to it.
I found the answer to my own question. I already mentioned that I am not a Delphi-programmer, so I did not notice another left-over statement from before my changes:
FSource := TFileStream.Create(SourceFile, fmOpenRead or fmShareDenyNone);
Removing that statement solved my problem; obviously that statement locked my file until close of the program. Thanks for your trying to help anyway.

Compliererror for certain fields in DExif-Package

I installed the package DEXIF and am able to read some EXIF-Entries. But not computed values as described in the documentation.
The following code shows what works. For the commented lines I get the Error: identifier idents no member "focalLenght" and so on..
How can I get hold on these and more fields?
procedure TForm1.EXIFAnzeigen(filename: string);
var
ImgData: TImgData;
i :integer;
begin
//EDitor leeren
ValueListEditor1.Strings.Clear;
if FileExists(filename) then begin
ImgData:= TImgData.Create();
ImgData.Tracelevel :=1;
try
if uppercase(ExtractFileExt(filename)) = '.JPG' then begin
if ImgData.ProcessFile(filename) then begin
if ImgData.HasEXIF then begin
ValueListEditor1.InsertRow('Camera Make',
ImgData.ExifObj.CameraMake,True);
ValueListEditor1.InsertRow('Camera Modell',
ImgData.ExifObj.CameraModel,True);
ValueListEditor1.InsertRow('Picture DateTime',
FormatDateTime(ISO_DATETIME_FORMAT, ImgData.ExifObj.GetImgDateTime),True);
ValueListEditor1.InsertRow('Width',
inttostr(ImgData.ExifObj.Width),True);
ValueListEditor1.InsertRow('FlashUsed',
intToStr(ImgData.ExifObj.FlashUsed),True);
// ValueListEditor1.InsertRow('FocalLength',
// inttostr(ImgData.ExifObj.FocalLength),True);
// ValueListEditor1.InsertRow('ApertureFNumber',
// ImgData.ExifObj.ApertureFNumber,True);
// ValueListEditor1.InsertRow('ExposureTime',
// ImgData.ExifObj.ExposureTime,True);
// ValueListEditor1.InsertRow('Distance',
// ImgData.ExifObj.Distance,True);
// ValueListEditor1.InsertRow('Process',
// ImgData.ExifObj.Process,True);
end else begin
ValueListEditor1.InsertRow('No EXIF','No Data',True);
end;
end else begin
ValueListEditor1.InsertRow('No EXIF','Processdata',True);
end;
end else begin
ValueListEditor1.Strings.Clear;
end;
finally
ImgData.Free;
end;
end;
end;
The documentation says:
Some of the more common fields are accessible as properties of the
EXIFObj of the ImgData.
and shows an example reading those properties, partly same as you succeed to read with your code.
But the FocalLength, and the others that fail in your code, have to be accessed in another way as the document says:
Other EXIF field can be read by using the property TagValue and
specifying the name of the EXIF property
The following example clarifies:
ValueListEditor1.InsertRow('FocalLength',
inttostr(ImgData.ExifObj.TagValue['FocalLength']),True);

Using the CRT unit in PASCAL is causing problems

I want to use the CRT unit in some Pascal code, just for the "clrscr" function but it's causing issues. The code compiles fine, but then some text is out of place and symbols appear where they shouldn't.
Here is the code:
program fuel(input, output);
var
i,vnumber:integer;
f,f2:text;
volfuel,dist,totalfuel,totaldist:double;
ch:char;
s,z:string;
begin
assign(f,'fuel.txt');
assign(f2,'report.txt');
{$i-}
reset(f);
rewrite(f2);
{$i+}
if ioresult<>0 then halt;
totalfuel:=0;
totaldist:=0;
s:='~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~';
writeln(s);
writeln(f2,s);
z:='Vehicle No.'+#9+'Fuel Consumption (MPG)';
writeln(z);
writeln(f2,z);
writeln(s);
writeln(f2,s);
while not eof(f) do
begin
read(f,vnumber);
read(f,ch);
read(f,volfuel);
read(f,ch);
read(f,dist);
readln(f);
totalfuel:=totalfuel+volfuel;
totaldist:=totaldist+dist;
writeln(vnumber,#9,(dist/volfuel):15:2);
writeln(f2,vnumber,#9,(dist/volfuel):15:2);
end;
writeln(s);
writeln(f2,s);
z:='~~~~~~~~~~~~~~~~~~~~SUMMARY~~~~~~~~~~~~~~~~~~~~~~~~';
writeln(z);
writeln(f2,z);
writeln(s);
writeln(f2,s);
writeln('Total Gallons = ',totalfuel:10:2);
writeln(f2,'Total Gallons = ',totalfuel:10:2);
writeln('Mean Petrol Consumption = ',totaldist/totalfuel:10:2);
writeln(f2,'Mean Petrol Consumption = ',totaldist/totalfuel:10:2);
close(f);
close(f2);
readln;
end.
As soon as I add "uses crt;" that's when I get problems. It's not just happened with this Pascal program either, I few I have done and then wanted to add "clrscr" or some colour, I can't as when I add CRT, it causes spacing/formatting problems.
Any help would be great!
If your OS is Windows, then it is probably the tab (#9) usage. Crt takes over I/O and might interpret them. But Crt on Windows should generally work fine. Detail your problems some more.

Delphi TDBXTransaction 'Invalid transaction Object'

1st off I am new to Delphi so this may be a "mundane detail" that's being over looked. [sorry in advance]
I am getting an 'Invalid Transaction Object' error when I attempt to run a transaction through a datasnap server connected to an Oracle 11g DB.
Due to the system details and the companies business plan we have elected not to use ClientDataSets to handle our transactions. Instead we are attempting to make the Snap server very generic and only handle data access by receiving queries and returning native types.
With that being said here is some sample code that is giving me fits:
function TSnapMethods.TransUpdate: boolean;
var
dbx: TDBXTransaction;
params:TParams;
begin
SqlCon.Open;
dbx := SQLCon.DBXConnection.BeginTransaction(TDBXIsolations.ReadCommitted);
try
params:= TParams.Create(self);
with Params.AddParameter do
begin
name:= 'param';
DataType:= ftWideString;
ParamType:= ptInput;
asString:= 'Bugsville';
end;
with Params.AddParameter do
begin
name:= 'var';
DataType:= ftWideString;
ParamType:= ptInput;
asString:= 'ZZZTOP';
end;
sqlcon.Execute('Update Name set City=:param Where Abrv=:var',params);
SQLcon.CommitFreeAndNil(dbx);//Breaks here...
result:= true;
except
Sqlcon.RollbackFreeAndNil(dbx);//Breaks here also...
result:= false;
end;
end;
By calling SQLCon.DBXConnection.BeginTransaction(), you're bypassing the setting up of internal TTransactionItem which is checked when the transaction is committed when you call SQLcon.CommitFreeAndNil() on the SQLConnection object. Notice that you're starting the transaction on the DBXConnection object but not committing it likewise.
Replace
SQLCon.DBXConnection.BeginTransaction()
with
SQLCon.BeginTransaction()
From another source I got this helpful information:
http://codeverge.com/embarcadero.delphi.ide/record-not-found-or-changed-by-another/1061559
For start transaction:
transaction:=Datamodule.SqlConection.BeginTransaction(TDBXIsolations.ReadCommitted);
For commit:
DataModule1.SqlConection.CommitFreeAndNil(Transacao);
To rollback:
DataModule1.SqlConection.RollbackIncompleteFreeAndNil(Transacao)
And use
RollbackIncompleteFreeAndNil
instead
RollbackIncompleteFreeAndNil
like referenced by:
http://docwiki.embarcadero.com/Libraries/Tokyo/en/Data.SqlExpr.TSQLConnection.RollbackIncompleteFreeAndNil
Please try this and report the results.

How to refresh dbgrid without close and open dataset in delphi?

I need to refresh dbgrid constantly, in real time. Close and open dataset works fine, but blink the dbgrid. What can I do to avoid this?
I'd like a solution like Ajax, that update only the necessary.
Thanks
Have you tried to use Disable- & EnableControls?
DataSet.DisableControls;
try
DataSet.Close;
DataSet.Open;
finally
DataSet.EnableControls;
end;
Furthermore, it should be possible to just call DataSet.Refresh instead of closing and opening to get the same result.
I use this in my app
DataSet.MergeChangeLog;
DataSet.ApplyUpdates(-1);
DataSet.Refresh;
The above code is in an action named actRefreshData, in the ActionManager
When I need to use I just call it like
actRefreshData.Execute;
Hope this helps.
Hint: you can add a Timer and automate this
Look here:
type THackDataSet=class(TDataSet); // a nice "hack" so we can access
//protected members
THackDBGrid=class(TDBGrid);
procedure {tdmdb.}refreshgrid(grid : tdbgrid);
var row, recno : integer;
ds : tdataset;
b : tbookmark;
begin
Row := THackDBGrid(grid).Row;// or THackDataSet(ds).ActiveRecord
ds := grid.datasource.dataset;
RecNo := ds.RecNo;
b := ds.GetBookmark;
try
ds.close;
ds.Open;
finally
if (b<>nil) and ds.BookMarkValid(b) then
try
// ds.GotoBookMark(b);
ds.CheckBrowseMode;
THackDataSet(ds).DoBeforeScroll;
THackDataSet(ds).InternalGotoBookmark(b);
if THackDataSet(ds).ActiveRecord <> Row - 1 then
THackDataSet(ds).MoveBy(Row - THackDataSet(ds).ActiveRecord - 1);
ds.Resync([rmExact{, rmCenter}]);
THackDataSet(ds).DoAfterScroll;
finally
ds.FreeBookMark(b);
end
else if (recno<ds.RecordCount) and (recno<>ds.RecNo) then
begin
ds.First;
ds.MoveBy(Max(0, recno-1));
end;
end;
end;

Resources