I'm using this simple code:
procedure TForm1.Button1Click(Sender: TObject);
var servicios: IFMXImageManagerService;
i:integer;
begin
i:=servicios.GetCount;
showmessage(inttostr(i));
end;
And I get an iOS message with: "Access Violation at address 0000000104BB0460, accessing address 00000000000000000".
All that I try with IFMXImageManagerService fires that violation message.
Please, anyone know why?
Thanks!
You are not initializing servicios to point at anything meaningful, so of course calling any methods on it, like servicios.GetCount(), will fail.
You need to use TPlatformServices.GetPlatformService() or TPlatformServices.SupportsPlatformService() to initialize servicios. This is explained in Embarcadero's documentation:
FireMonkey Platform Services
To use a platform service, you must:
Add a reference to the unit where your service is declared, such as FMX.Platform, to your unit.
Call TPlatformServices.SupportsPlatformService with the target platform service as a parameter to determine whether or not the specified platform service is supported at run time.
If SupportsPlatformService returns True, use TPlatformServices.GetPlatformService to access the actual platform service, and cast the returned service appropriately. You can alternatively use SupportsPlatformService to obtain the service as well.
Try this:
uses
..., FMX.Platform, FMX.MediaLibrary;
procedure TForm1.Button1Click(Sender: TObject);
var
servicios: IFMXImageManagerService;
i: integer;
begin
if TPlatformServices.Current.SupportsPlatformService(IFMXImageManagerService, IInterface(servicios)) then
begin
i := servicios.GetCount;
ShowMessage(IntToStr(i));
end else
ShowMessage('Image Manager not supported');
end;
Related
I use the following code to change region data in the Registry.
procedure TForm1.Button1Click(Sender: TObject);
var
reg: TRegistry;
begin
reg:=TRegistry.Create;
try
reg.RootKey:=HKEY_CURRENT_USER;
reg.OpenKey('\Control Panel\International\',true);
reg.WriteString('iCountry','1');
reg.WriteString('iCurrDigits','2');
reg.WriteString('iCurrency','0');
reg.WriteString('iDate','1');
reg.WriteString('iDigits','2');
reg.WriteString('iLZero','0');
reg.WriteString('iMeasure','1');
reg.WriteString('iNegCurr','0');
reg.WriteString('iNegNumber','1');
reg.WriteString('iTimePrefix','0');
reg.WriteString('iTLZero','1');
reg.WriteString('Locale','00000409');
reg.WriteString('LocaleName','en-US');
reg.WriteString('sCountry','United States');
reg.WriteString('sDate','/');
reg.WriteString('sDecimal','.');
reg.WriteString('iNegCurr','0');
reg.WriteString('sShortDate','dd/MM/yyyy'); reg.CloseKey;
finally
reg.free;
end;
end;
but this requires restarting the machine before the changes take effect. Can it be done without rebooting?
After changing the Registry, broadcast a system-wide WM_SETTINGCHANGE message by calling SendMessageTimeout() with its hWnd set to HWND_BROADCAST:
Applications should send WM_SETTINGCHANGE to all top-level windows when they make changes to system parameters.
...
wParam
... When the system sends this message as a result of a change in locale settings, this parameter is zero.
When an application sends this message, this parameter must be NULL.
...
lParam
... When the system sends this message as a result of a change in locale settings, this parameter points to the string "intl".
For example:
procedure TForm1.Button1Click(Sender: TObject);
var
reg: TRegistry;
begin
reg := TRegistry.Create;
try
reg.RootKey := HKEY_CURRENT_USER;
reg.Access := KEY_SET_VALUE;
if reg.OpenKey('\Control Panel\International\', true) then
try
reg.WriteString('iCountry','1');
reg.WriteString('iCurrDigits','2');
reg.WriteString('iCurrency','0');
reg.WriteString('iDate','1');
reg.WriteString('iDigits','2');
reg.WriteString('iLZero','0');
reg.WriteString('iMeasure','1');
reg.WriteString('iNegCurr','0');
reg.WriteString('iNegNumber','1');
reg.WriteString('iTimePrefix','0');
reg.WriteString('iTLZero','1');
reg.WriteString('Locale','00000409');
reg.WriteString('LocaleName','en-US');
reg.WriteString('sCountry','United States');
reg.WriteString('sDate','/');
reg.WriteString('sDecimal','.');
reg.WriteString('iNegCurr','0');
reg.WriteString('sShortDate','dd/MM/yyyy');
finally
reg.CloseKey;
SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0, LPARAM(PChar('intl')), SMTO_NORMAL, 100, PDWORD(nil)^);
end;
finally
reg.free;
end;
end;
And before you ask, yes it is safe to use nil in the last parameter in this manner:
Passing nil to a variable parameter
Prior to XE2, Delphi's Windows unit declares the last parameter of SendMessageTimeout() as:
var lpdwResult: DWORD
But the Win32 API defines the parameter as:
_Out_opt_ PDWORD_PTR lpdwResult
Which allows a NULL pointer to be passed in. The above nil trick is the only way for Delphi code to pass a NULL value to a var parameter. The machine code generated by the compiler will be correct - it will simply pass a value of 0 to the parameter, it will not actually try access memory address $00000000.
In XE2, the Windows unit was changed to declare the last parameter as:
lpdwResult: PDWORD_PTR
To match the Win32 API definition.
So, if you ever upgrade your code to XE2 or later, simply replace PDWORD(nil)^ with nil instead. Or, you can account for it now and not worry about it later:
SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0, LPARAM(PChar('intl')), SMTO_NORMAL, 100, {$IF RTLVersion >= 23}nil{$ELSE}PDWORD(nil)^{$IFEND});
I am looking at the FMX built in logging support via the Log class which uses the IFMXLoggingService to write events. I have found info for the log file location in iOS and Android but unable to find anything on Windows (8.1).
Does anyone know which specific log file this service writes to? and is this able to be changed in code or otherwise?
Thanks
If you look at the sources you will find the implementation at FMX.Platform.Win.TPlatformWin.Log:
procedure TPlatformWin.Log(const Fmt: string; const Params: array of const);
begin
OutputDebugString(PChar(Format(Fmt, Params)));
end;
OutputDebugString() does not send messages to any log file at all. It logs to the debugger's built-in event log, when the app is running inside the debugger. When the app is running outside of the debugger, third-party tools like SysInternal DebugView can capture these messages.
If you want to use a custom logger, write a class that implements the IFMXLoggingService interface and register it with FMX at runtime:
type
TMyLoggingService = class(TInterfacedObject, IFMXLoggingService)
public
procedure Log(const Format: string; const Params: array of const);
end;
procedure TMyLoggingService.Log(const Format: string; const Params: array of const);
begin
// do whatever you want...
end;
var
MyLoggingService : IFMXLoggingService;
begin
MyLoggingService := TMyLoggingService.Create;
// if a service is already registered, remove it first
if TPlatformServices.Current.SupportsPlatformService( IFMXLoggingService ) then
TPlatformServices.Current.RemovePlatformService( IFMXLoggingService );
// now register my service
TPlatformServices.Current.AddPlatformService( IFMXLoggingService, MyLoggingService );
end;
This is mentioned in Embarcadero's documentation:
You can use TPlatformServices.AddPlatformService and TPlatformServices.RemovePlatformService to register and unregister platform services, respectively.
For example, you can unregister one of the built-in platform services and replace it with a new implementation of the platform service that is tailored to fit your needs.
I'm trying to make a Delphi application to work with AlwaysOn solution. I found on Google that I have to use MultiSubnetFailover=True in the connection string.
Application is compiled in Delphi XE3 and uses TADOConnection.
If I use Provider=SQLOLEDB in the connection string, application starts but it looks like MultiSubnetFailover=True has no effect.
If I use Provider=SQLNCLI11 (I found on Google that OLEDB doesn't support AlwaysOn solution and I have to use SQL Native client) I get invalid attribute when trying to open the connection.
The connection string is:
Provider=SQLOLEDB.1;Password="password here";Persist Security Info=True;User ID=sa;Initial Catalog="DB here";Data Source="SQL Instance here";MultiSubnetFailover=True
Do I have to upgrade to a newer version on Delphi to use this failover solution or is something that I'm missing in the connection string?
I am currently using XE2 with SQL Server AlwaysOn. If you read the documentation you will see that AlwaysOn resilience events will cause your database connection to fail and you need to initiate a new one.
If a SqlClient application is connected to an AlwaysOn database that
fails over, the original connection is broken and the application must
open a new connection to continue work after the failover.
I've dealt with this via the simple expedient of overriding the TAdoQuery component with my own version which retries the connection after getting a connection failure. This may not be the proper way to do this but it certainly works. What it does is override the methods invoked for opening (if the query returns a result set) or executes the SQL (otherwise) and if there is a failure due to connection loss error tries again (but only once). I have heavily tested this against AlwaysOn switch overs and it works reliably for our configuration. It will also react to any other connection loss events and hence deals with some other causes of queries failing. If you are using a component other than TAdoQuery you would need to create similar overrides for that component.
It is possible this can be dealt with in other ways but I stopped looking for alternatives once I found something that worked. You may want to tidy up the uses statement as it clearly includes some stuff that isn't needed. (Just looking at this code makes me want to go away and refactor the code duplication as well)
unit sptADOQuery;
interface
uses
Windows, Messages, SysUtils, Classes, Db, ADODB;
type
TsptADOQuery = class(TADOQuery)
protected
procedure SetActive(Value: Boolean); override;
public
function ExecSQL: Integer; // static override
published
end;
procedure Register;
implementation
uses ComObj;
procedure Register;
begin
RegisterComponents('dbGo', [TsptADOQuery]);
end;
procedure TsptADOQuery.SetActive(Value: Boolean);
begin
try
inherited SetActive(Value);
except
on e: EOleException do
begin
if (EOleException(e).ErrorCode = HRESULT($80004005)) then
begin
if Assigned(Connection) then
begin
Connection.Close;
Connection.Open;
end;
inherited SetActive(Value); // try again
end
else raise;
end
else raise;
end;
end;
function TsptADOQuery.ExecSQL: Integer;
begin
try
Result := inherited ExecSQL;
except
on e: EOleException do
begin
if (EOleException(e).ErrorCode = HRESULT($80004005)) then
begin
if Assigned(Connection) then
begin
Connection.Close;
Connection.Open;
end;
Result := inherited ExecSQL; // try again
end
else raise;
end
else raise;
end;
end;
end.
We have a service (written in C#) running to check somethings every 10 minutes and if something new happened, then send an email to someone special.
We also have other Delphi program and want to pass a parameter to the service to act on and send email immediately (I mean regardless than 10 minutes interval).
How to do that while service is running ?
note: There is no way to migrate to C# we have to do that in Delphi.
There's also a possibility to use ControlService API to send the service a user-defined control code. (The service has to be written to respond to that specific control code.)
You need to use some form of inter process communication (IPC). There are many possibilities. Most commonly used for such a scenario are named pipes and TCP/sockets.
There are some good answers here already... and here's mine:
You could use a text file or the windows registry to flag for action. This way your Delphi service can react upon start-up should the trigger have occured while your service was not running. Any information/parameters you wish to convey can be included in the registry-key value or as file data.
Win Registry Method:
If you use a registry-key make sure that both apps can read and write to the same key.
In your Delphi Service implement the RegNotifyChangeKeyValue WinAPI which will notify when the key is added/altered. Here's an idea how you can implement the listner in Delphi: Monitoring Registry Changes
File Method:
To be notified about file changes you do not need to poll for changes. Below is code for a solution based on the FindFirstChangeNotification WinAPI. Your Delphi Service can implement the TFileWatch class. You will also need a unit with the class TDirectoryWatch class by Angus Johnson.
unit FileWatch;
interface
uses Classes,
SysUtils,
DirWatch; //by Angus Johnson: http://www.angusj.com/delphi/dirwatch.html
type TFileNotifyEventType = (feCreated, feModified, feDeleted);
TFileNotifyEvent = procedure(Sender: TObject; FileEventType : TFileNotifyEventType) of object;
TFileWatch = class(TComponent)
private
FDirWatch : TDirectoryWatch;
FFileToWatch : string;
FFileAge : integer; //if -1 then file does not exist
FFileExists : boolean;
procedure OnFolderChangeEvent(Sender: TObject);
protected
public
OnFileNotifyEvent : TFileNotifyEvent;
property Filename : string read FFileToWatch;
constructor Create(aOwner: TComponent; FileToWatch : string);
destructor Destroy();
end;
implementation
{ TFileWatch }
constructor TFileWatch.Create(aOwner: TComponent; FileToWatch: string);
begin
inherited Create(aOwner);
FDirWatch := TDirectoryWatch.Create(Self);
FDirWatch.Directory := ExtractFilePath(FileToWatch);
FDirWatch.OnChange := OnFolderChangeEvent;
FDirWatch.NotifyFilters := [nfFilename, nfLastWrite];
FDirWatch.Active := true;
FFileToWatch := FileToWatch;
FFileAge := FileAge(FFileToWatch);
FFileExists := FFileAge > -1;
end;
destructor TFileWatch.Destroy;
begin
FDirWatch.Free;
inherited Destroy;
end;
procedure TFileWatch.OnFolderChangeEvent(Sender: TObject);
var MyFileAge : integer;
MyFileExists : boolean;
FileEventType : TFileNotifyEventType;
begin
//Check to see if the event has been fired by our file in question
MyFileAge := FileAge(FFileToWatch);
if MyFileAge = FFileAge then
exit; //Nothing has happened, exit.
//Figure out if the file has been created, modified or deleted
MyFileExists := MyFileAge > -1;
if MyFileExists and not FFileExists then
FileEventType := feCreated
else if not MyFileExists and FFileExists then
FileEventType := feDeleted
else
FileEventType := feModified;
FFileAge := MyFileAge;
FFileExists := MyFileExists;
if Assigned(OnFileNotifyEvent) then
OnFileNotifyEvent(Self, FileEventType);
end;
end.
I often communicate via a database. I'd store a certain value with process X, and process Y reads it.
The nice thing about that design is that the two applications don't need to know eachother. They can easily run on different machines, and you can have multiple readers and writers, so you can easily scale things up. You also get encryption and compressed connections for free if you need it, and all sorts of complicated multi user stuff is taken care of.
I would suggest adding a WCF Service to (hosted by) your Windows service exposing the required function.
I am developing application which intend to be cross platform. I used to use Windows Messages but now I am dropping it out. I replaced messages with callbacks but regardless I can use different technologies I am not aware of different possibilites when not using windows messages.
Well I have main exe aplication and some dll plugins. I have some objects and threads in dll and I would like to notify main application about some changes that DLL made to data structure.
As I said I am currently working with some callbacks. To provide compatibility with different languages (C++, VB, C#) I have non-object type of callback. I am not sure if other languages supports callback of object.
So my questions are:
What are the alternatives (cross-platform) to windows messages? Can callbacks replace messages?
Do other languages support callback of object?
I guess other languages have different technologies as alternative to messages?
You can certainly use callback functions instead of messages. You can't use callback methods because only Delphi and C++ Builder understand how to invoke Delphi method pointers. However, you can use callback objects with any language that supports COM. Here's an example for a plug-in to notify the application that the data structure has changed:
Define an interface.
type
IDataStructureChanged = interface
['{GUID}']
procedure Call; stdcall;
end;
You could add some parameters to the method so the plug-in can tell how the data structure changed, or pass some value indicating which plug-in is making the notification.
Implement it in the application.
type
TDataStructureChangedListener = class(TInterfacedObject, IDataStructureChanged)
private
FForm: TForm;
procedure Call; stdcall;
public
constructor Create(Form: TForm);
end;
When you instantiate that class, you can pass it a reference to your program's main form, or whatever other information your program will need to be able to take action when a plug-in eventually calls the Call method. Implement Call to make your application do whatever it needs to do when a data structure changes.
Pass a reference to each of the plug-ins when you initialize them.
ChangeListener := TDataStructureChangedListener.Create(Self);
for i := 0 to Pred(PlugIns.Count) do
PlugIns[i].Init(ChangeListener);
The plug-in should store a reference to the listener object, and when the data structure changes, it can call the Call method to notify your application.
What I've described here is what's generally known as an event sink. You can have more than one in your program. If there are multiple events to handle, you could have a separate interface for each kind of event, or you could group them all into a single interface and have a different method for each event. You could have a different sink object for each plug-in, or you could give each plug-in a reference to the same sink object, and then pass a plug-in-ID parameter.
I would definately use callbacks. The main app could give a callback function to the DLL to call when needed, and then the callback function itself can send window messages to the app if it needs to.
I agree with Remy, (!). A straightforward callback allows the handler to implement any kind of further communication it chooses - it might post a message, it may push a parameter onto a queue, whatever it wants. If you want to be cross-platform, you are going to have to resort to passing in, and out, simple types. It's usual to pass in a 'user context' pointer when callbacks are set up. The callback passes this pointer into the handler. This allows callers to pass in a context object as a pointer/int and to recover it in the handler, (by casting the pointer/int back to an object). The handler can then call methods on the context, no matter whether it's Delphi, C++ etc.
So my questions are:
What are the alternatives (cross-platform) to windows messages? Can callbacks replace messages?
Yes you can replace messages with callbacks.
Do other languages support callback of object?
You shouldn't use object methods as callbacks. Common practice in portable code is use of handles (notify calling convention):
DLL source:
type
THandle = LongWord;
{$IF SizeOf(THandle) < SizeOf(Pointer))}
{$MESSAGE Error 'Invallid handle type'}
{$ENDIF}
TCallback = procedure(const aHandle: THandle); cdecl;
var
gCallback: record
Routine: TCallback;
Obj: TObject;
Info: string
end;
function Object2Handle(const aObj: TObject): THandle;
begin
Result:= THandle(Pointer(aObj))
end;
function Handle2Object(const aHandle: THandle; out aObj: TObject): Boolean;
begin
if gCallback.Obj <> nil then
if aHandle = Object2Handle(gCallback.Obj) then
begin
aObj:= gCallback.Obj;
Result:= true;
Exit // WARRNING: program flow disorder
end;
aObj:= nil;
Result:= false
end;
procedure DoCallback();
begin
if Assigned(gCallback.Routine) then
gCallback.Routine(Object2Handle(gCallback.Obj))
end;
procedure SetupCallback(const aCallback: TCallback); cdecl;
begin
gCallback.Routine:= aCallback;
end;
procedure DoSomething(const aHandle: THandle; out aInfo: string); cdecl;
var
O: TObject;
begin
if Handle2Object(aHandle, O) then
aInfo:= Format('%s class object %s', [O.ClassName(), gCallback.Info])
end;
procedure Test();
begin
gCallback.Obj:= TStream.Create();
try
gCallback.Info:= 'created';
DoCallback();
finally
FreeAndNil(gCallback.Obj)
end;
gCallback.Obj:= TMemoryStream.Create();
try
gCallback.Info:= 'will be freed';
DoCallback();
finally
FreeAndNil(gCallback.Obj)
end
end;
exports
SetupCallback,
DoSomething,
Test;
Executable source:
procedure Cb(const aHandle: THandle); cdecl;
const
STUPID: THandle = 1;
EQUALLY_STUPID = $DEAD;
var
S: string;
begin
DoSomething(STUPID, S);
DoSomething(aHandle, S);
DoSomething(EQUALLY_STUPID, S)
end;
begin
SetupCallback(#Cb);
Test()
end.
Edited: You can't shoot yourself in you leg now.
I guess other languages have different technologies as alternative to messages?
OS have a few message alternatives. However not many truly portable.
You can also use:
sockets,
(IMO too big in this case?) ready messaging system (my favorite 0MQ)