i'm try to building a DataSnap Rest Application running as a windows service, but the wizard just have "Stand-alone VCL application", "Stand-alone console application" and "ISAPI dynamic link library"(i'm using Delphi XE2 enterprise). Someone can help me. Thanks.
It would be more convenient if the DataSnap REST wizard had the option to create a Windows Service (how else would you run an application server?), but you can work around it with a little fiddling.
The first time I ran in to this, I created a regular DataSnap REST server as a VCL application and a regular Windows service and copied the relevant portions from the REST server to the service. Just make sure the output directory for the service is the same as the directory for the VCL application.
The service's .dpr might look like this:
program Service;
uses
Vcl.SvcMgr,
Web.WebReq,
IdHTTPWebBrokerBridge,
WebModuleUnit1 in '..\GUI\WebModuleUnit1.pas' {WebModule1: TWebModule},
ServerMethodsUnit1 in '..\GUI\ServerMethodsUnit1.pas' {ServerMethods1: TDSServerModule},
ServerContainerUnit1 in '..\GUI\ServerContainerUnit1.pas' {ServerContainer1: TDataModule},
Unit1 in 'Unit1.pas' {Service1: TService};
{$R *.RES}
begin
if not Application.DelayInitialize or Application.Installing then
Application.Initialize;
if WebRequestHandler <> nil then
WebRequestHandler.WebModuleClass := WebModuleClass;
Application.CreateForm(TService1, Service1);
Application.Run;
end.
The service's main unit might look like this:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs,
IdHTTPWebBrokerBridge, Web.HTTPApp;
type
TService1 = class(TService)
procedure ServiceCreate(Sender: TObject);
procedure ServiceExecute(Sender: TService);
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
private
FServer: TIdHTTPWebBrokerBridge;
procedure TerminateThreads;
public
function GetServiceController: TServiceController; override;
end;
var
Service1: TService1;
implementation
{$R *.DFM}
uses
//Datasnap.DSService; // XE2
Datasnap.DSSession; // XE3
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Service1.Controller(CtrlCode);
end;
{ TService1}
function TService1.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TService1.ServiceCreate(Sender: TObject);
begin
FServer := TIdHTTPWebBrokerBridge.Create(Self);
end;
procedure TService1.ServiceExecute(Sender: TService);
begin
while not Terminated do
begin
Sleep(1000);
ServiceThread.ProcessRequests(False);
end;
end;
procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
if not FServer.Active then
begin
FServer.Bindings.Clear;
FServer.DefaultPort := 8080;
FServer.Active := True;
end;
end;
procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
TerminateThreads;
FServer.Active := False;
FServer.Bindings.Clear;
ServiceThread.Terminate;
end;
procedure TService1.TerminateThreads;
begin
if TDSSessionManager.Instance <> nil then
TDSSessionManager.Instance.TerminateAllSessions;
end;
end.
Related
I'm using Delphi 10.3 Community Edition. I'm trying to drag and drop files from a Windows folder onto my application but the Windows message handler is not called when I drag and drop a file on the form.
This is what I have at the moment:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
protected
procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
ShellApi;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Disable drag accept files
DragAcceptFiles(Self.Handle, true);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Enable drag accept files
DragAcceptFiles(Self.Handle, true);
end;
procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
begin
// Show a message
ShowMessage('File dropped');
// Set the message result
Msg.Result := 0;
inherited;
end;
end.
Like I said, when I drag and drop a file on the form, I can see that the file is accepted when dragged onto the form but when I drop the file, the WMDropFiles procedure is not called.
I also tried enabling the DragAcceptFiles in the CreateWnd procedure. But it still does not work.
...
public
procedure CreateWnd; override;
procedure DestroyWnd; override;
...
procedure TForm1.CreateWnd;
begin
inherited;
DragAcceptFiles(Handle, True);
end;
procedure TForm1.DestroyWnd;
begin
DragAcceptFiles(Handle, False);
inherited;
end;
I even tried running the Delpi IDE as Administrator.
Could it be a limitation of the Community Edition or am I missing something?
Addendum
I've now added a button to send a message WM_DROPFILES.
procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(Self.Handle, WM_DROPFILES, Integer(self), 0);
end;
When I click the button, the WMDropFiles procedure is called. So then it works.
Ok, very interesting. I found this article:
How to Enable Drag and Drop for an Elevated MFC Application on Vista/Windows 7
So I added the following to my form create procedure:
procedure TForm1.FormCreate(Sender: TObject);
begin
// Enable drag accept files
DragAcceptFiles(Form1.Handle, true);
ChangeWindowMessageFilter (WM_DROPFILES, MSGFLT_ADD);
ChangeWindowMessageFilter (WM_COPYDATA, MSGFLT_ADD);
ChangeWindowMessageFilter ($0049, MSGFLT_ADD);
end;
And now it is working!
I changed the topic to include text "TListView" because I actually want to drop files on a TListView. Since I've solved the problem with dropping files on a form, I still had an issue with dropping files on a TListView.
So to drop the files on a TListView, you have to change the Handle to the listview's handle:
// Enable drag accept files
DragAcceptFiles(MyListview.Handle, true);
and
// Disable drag accept files
DragAcceptFiles(MyListview.Handle, false);
But that alone is not enough. You then need a Application events handler to catch the messages and handle them accordingly. So I just added a TApplicationEvents component to the form and added the following to the OnMessage event:
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
// If it is a drop files message and it is for the listview
if ((Msg.message = WM_DROPFILES)and (Msg.hwnd = MyListView.Handle)) then
begin
// Handle your dropped data here
end;
end;
I want load a image that will be the background of a maximized Form that stays in a dll.
The dll is called from a Vcl Form Application but have a trouble where not is possible load the background image on Form, the dll always crashes.
Thank you by you help.
===========================================================================
Executable
unit Unit2;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm2 = class(TForm)
btn1: TButton;
procedure btn1Click(Sender: TObject);
end;
var
Form2: TForm2;
implementation {$R *.dfm}
procedure LoadDLL;
type
TShowformPtr = procedure; stdcall;
var
HDLL: THandle;
Recv: TShowformPtr;
begin
HDLL := LoadLibrary('lib.dll');
if HDLL <> 0 then
begin
#Recv := GetProcAddress(HDLL, 'Recv');
if #Recv <> nil then
Recv;
end;
//FreeLibrary(HDLL);
end;
procedure TForm2.btn1Click(Sender: TObject);
begin
LoadDLL;
end;
end.
Dll
Main:
library Project2;
uses
SysUtils, Classes, Unit1, Unit2;
{$R *.res}
procedure Recv; stdcall;
begin
showform;
end;
exports
Recv;
begin
end.
Unit1 (Form):
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
img1: TImage;
pnl1: TPanel;
procedure FormShow(Sender: TObject);
private
{ Private declarations }
procedure CreateParams(var Params: TCreateParams); override;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.WndParent:= Application.Handle;
Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST or WS_EX_TRANSPARENT;
Params.ExStyle := WS_EX_TRANSPARENT or WS_EX_TOPMOST;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
brush.Style := bsclear;
img1.Picture.LoadFromFile(IncludeTrailingBackslash(GetCurrentDir) + 'background.bmp');
SetWindowPos(Form1.handle, HWND_TOPMOST, Form1.Left, Form1.Top, Form1.Width,
Form1.Height, 0);
ShowWindow(Application.handle, SW_HIDE);
pnl1.Top := (self.Height div 2) - (pnl1.Height div 2);
pnl1.Left := (self.Width div 2) - (pnl1.Width div 2);
end;
end.
Unit2:
unit Unit2;
interface
Uses
windows,
Unit1,
SysUtils;
procedure showform;
implementation
procedure showform;
begin
Form1 := TForm1.Create(Form1);
sleep(100);
Form1.Show;
Form1.Pnl1.Visible := True;
end;
end.
Your question has a lot of problems, so I would try to answer it as best I can, considering the lack of details.
You are using forms so you are building a VCL application. You need to let the IDE assign the VCL framework to your project.
This line is terribly wrong:
Form1 := TForm1.Create(Form1);
In rare circumstances show a from own itself. I would go and say that most probably this is why your application crashes. See this for details about forms in DLLs.
If you cannot properly debug your application put a beep before that line and one after (make a delay between them).
I think your question should be rather called "how to debug a Delphi project".
What you need to do is to get the exact line on which the program crashes. This will give you an insight of why the error/crash (by the way, you never shown the exact error message) appears.
Go check HadShi (recommended) or EurekaLog (buggy) or Smartinspect (I never tried it. Price is similar to the other two). Make sure that you are running in debug mode, the Integrated debugger is on (see IDE options) and that the debug information is present in your EXE/DLL.
PS: you can still debug your app without have one of the three loggers shown above. Just configure your project properly to run in Debug mode!
To debug the DLL see the 'Run->Parameters' menu. Define there a host application that will load your DLL. If the error is the DLL, the debugger will take control and put the cursor to the line of code that generated the crash.
I don't know what the final purpose/what is that you want to achieve. Because of this I must warn you that you might need to take into consideration these questions:
Do you need to use ShareMM?
Why are you building this as a DLL? Can't the application be written as a single EXE? Or two EXEs that communicate with each other?
I have an application set up in the following manner in Delphi XE5:
main.exe: calls a function in sub.dll using the export delayed directive
function MyFunction: boolean; external 'sub.dll' delayed;
sub.dll: contains a FireDAC query object which runs a simple SELECT query.
Upon opening the query, with the delayed directive the application does not terminate when the main form is closed (process main.exe remains in task manager). Process explorer shows a thread remaining for sub.dll. The main.exe process terminates correctly when I do not specify the delayed directive. What am I missing? I feel like I'm not freeing an object but I can't figure out what it is.
Simplified code:
Main.exe:
program Main;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
function MyFunction: boolean; external 'Sub.dll' delayed;
begin
try
MyFunction;
except
on E: Exception do begin
Writeln(E.ClassName, ': ', E.Message);
readln;
end;
end;
end.
Sub.dll
library Sub;
uses
System.SysUtils,
System.Classes,
DBConn in 'DBConn.pas';
{$R *.res}
function MyFunction: boolean; export;
var Conn: TConn;
begin
Conn := TConn.Create;
Conn.Destroy;
Result := True;
end;
exports
MyFunction;
begin
end.
DBConn.pas
unit DBConn;
interface
uses
FireDAC.Stan.Intf, FireDAC.Stan.Option,
FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
FireDAC.Phys, FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Stan.Param,
FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, FireDAC.VCLUI.Wait,
FireDAC.Comp.UI, FireDAC.Phys.ODBCBase, FireDAC.Phys.ASA, Data.DB,
FireDAC.Comp.DataSet, FireDAC.Comp.Client;
type
TConn = class
FDConnection: TFDConnection;
FDQuery: TFDQuery;
constructor Create;
destructor Destroy; override;
end;
var
Conn: TConn;
{ TConn }
implementation
constructor TConn.Create;
begin
FDConnection := TFDConnection.Create(nil);
//Set database connection parameters
with FDConnection do begin
close; Params.Clear;
Params.Add('DriverID=ASA');
Params.Add('Database=');
Params.Add('Server=');
Params.Add('USER_NAME=');
Params.Add('PASSWORD=');
open;
end;
FDQuery := TFDQuery.Create(nil);
with FDQuery do begin
Connection := FDConnection;
close; unprepare; SQL.Clear;
SQL.Add('Select first LAST_NAME');
SQL.Add('From USERS');
SQL.Add('Order By LAST_NAME');
prepare; open; //this causes the deadlock
writeln(Output, FieldByName('LAST_NAME').AsString);
end;
end;
destructor TConn.Destroy;
begin
FDConnection.Close;
FDConnection.Free;
inherited;
end;
end.
This is a FireDAC limitation. See http://docwiki.embarcadero.com/RADStudio/XE8/en/DLL_Development_(FireDAC)#FireDAC_DLL_Unloading
VCL will reliably work in Dll only if your main Exe and Dll are compiled in the same version of Delphi with runtime packages enabled for them.
Hi i have created windows services in Delphi. I have installed and started the Services. Every thing working fine. Even i can check it in Task Manager.My service is Running.
But the code which i included inside the OnExecute method is not working.
My whole Code:
unit MyService;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs,
Vcl.ExtCtrls,Jira;
type
TJiraTestlink = class(TService)
procedure ServiceExecute(Sender: TService);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
var
JiraTestlink: TJiraTestlink;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
JiraTestlink.Controller(CtrlCode);
end;
function TJiraTestlink.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TJiraTestlink.ServiceExecute(Sender: TService);
const
SecBetweenRuns = 10;
var
Count: Integer;
begin
Count := 0;
while not Terminated do
begin
Inc(Count);
if Count >= SecBetweenRuns then
begin
Count := 0;
{ place your service code here }
{ this is where the action happens }
ShowMessage(DateTimeToStr(Now));
end;
Sleep(1000);
ServiceThread.ProcessRequests(False);
end;
end;
end.
I am not sure where i did mistake. Any help will be appreciated. Thanks.
Since Vista, services are isolated and run in session 0, a non-interactive session. Interactive processes run in different sessions, starting from session 1 for the first logged on user.
This means that you cannot use your service to show UI. Calls to ShowMessage cannot work, by design, in a service.
You will need to find some other way to debug your service. For instance logging messages to a text file. Or OutputDebugString and a viewer like SysInternals DebugView which is capable of catching these debug strings from different sessions.
I have a Delphi 6 application that works with the Skype API. I want to know when the Skype client has shut down even though my software did not launch it (so I don't have a process handle for it). This way I can know if the user shut down the Skype client I can get the process ID for the Skype client fairly easily, so is there a Windows API call or other technique that accepts a process ID where I can get a notification when the process (Skype client) has terminated?
If not, is there a WinApi call that I can use to poll Windows to see if the process ID is still valid, or does Windows reuse process IDs so there's a chance that I could end up with a process ID belonging to a recently launched process that is not the Skype client, which would invalidate my polling efforts?
Call OpenProcess to get a process handle. The SYNCHRONIZE access right will probably be enough. Then wait on the handle. Something like:
HANDLE hProcess = OpenProcess(SYNCHRONIZE, FALSE, pid);
WaitForSingleObject(hProcess, INFINITE);
CloseHandle(hProcess);
You can use the __InstanceDeletionEvent WMI intrinsic event to monitor the Win32_Process class and the filter by the ProcessId property, this event run in async mode in your code.
Check this sample code (Written in delphi XE2, but must work in delphi 6 without problems)
Note : You must import the Microsoft WMI Scripting V1.2 Library before to use it.
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, WbemScripting_TLB;
type
TWmiAsyncEvent = class
private
FWQL : string;
FSink : TSWbemSink;
FLocator : ISWbemLocator;
FServices : ISWbemServices;
procedure EventReceived(ASender: TObject; const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);
public
procedure Start;
constructor Create(Pid : DWORD);
Destructor Destroy;override;
end;
TFrmDemo = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
AsyncEvent : TWmiAsyncEvent;
public
{ Public declarations }
end;
var
FrmDemo: TFrmDemo;
implementation
{$R *.dfm}
uses
ActiveX;
{ TWmiAsyncEvent }
constructor TWmiAsyncEvent.Create(Pid: DWORD);
begin
inherited Create;
CoInitializeEx(nil, COINIT_MULTITHREADED);
FLocator := CoSWbemLocator.Create;
FServices := FLocator.ConnectServer('.', 'root\CIMV2', '', '', '', '', wbemConnectFlagUseMaxWait, nil);
FSink := TSWbemSink.Create(nil);
FSink.OnObjectReady := EventReceived;
//construct the WQL sentence with the pid to monitor
FWQL:=Format('Select * From __InstanceDeletionEvent Within 1 Where TargetInstance ISA "Win32_Process" And TargetInstance.ProcessId=%d',[Pid]);
end;
destructor TWmiAsyncEvent.Destroy;
begin
if FSink<>nil then
FSink.Cancel;
FLocator :=nil;
FServices :=nil;
FSink :=nil;
CoUninitialize;
inherited;
end;
procedure TWmiAsyncEvent.EventReceived(ASender: TObject;
const objWbemObject: ISWbemObject;
const objWbemAsyncContext: ISWbemNamedValueSet);
var
PropVal: OLEVariant;
begin
PropVal := objWbemObject;
//do something when the event is received.
ShowMessage(Format('The Application %s Pid %d was finished',[String(PropVal.TargetInstance.Name), Integer(PropVal.TargetInstance.ProcessId)]));
end;
procedure TWmiAsyncEvent.Start;
begin
FServices.ExecNotificationQueryAsync(FSink.DefaultInterface,FWQL,'WQL', 0, nil, nil);
end;
procedure TFrmDemo.FormCreate(Sender: TObject);
begin
//here you must pass the pid of the process
AsyncEvent:=TWmiAsyncEvent.Create(1852);
AsyncEvent.Start;
end;
procedure TFrmDemo.FormDestroy(Sender: TObject);
begin
AsyncEvent.Free;
end;
end.
For more info you can check this article Delphi and WMI Events
Windows does reuse process IDs, so do not rely on that by itself.
You can use EnumProcesses() to know which processes are currently running, then grab their filenames and process IDs, etc. See this example on MSDN.