Restart Delphi Application Programmatically - delphi

It should not be possible to run multiple instances of my application. Therefore the project source contains:
CreateMutex (nil, False, PChar (ID));
if (GetLastError = ERROR_ALREADY_EXISTS) then
Halt;
Now I want to restart my application programmatically. The usual way would be:
AppName := PChar(Application.ExeName) ;
ShellExecute(Handle,'open', AppName, nil, nil, SW_SHOWNORMAL) ;
Application.Terminate;
But this won't work in my case because of the mutex. Even if I release the mutex before starting the second instace it won't work because shutdown takes some time and two instance cannot run in parallel (because of common resources and other effects).
Is there a way to restart an application with such characteristics? (If possible without an additional executable)
Thanks in advance.

Perhaps you should think outside the box. Instead of futzing with the mutex / instance logic, you could simply create another executable that waits for your app to close then starts it again. As an added bonus, you can later use this mechanism to, for example, update some of your main app's binaries. It's also much easier to run it elevated instead of maintaining different integrity levels inside the same app, etc.

Why can't you just release the mutex before attempting to restart? If by some chance another instance gets going before the one you explicitly invoke with the restart that doesn't matter, you'll still have your app up and running again with whatever changes effected that required the restart. I don't think you need any of the complexity of the other solutions.

Include in your ShellExecute some parameter, for example, /WaitForShutDown and create one more mutex. In your program, before the initialization, for example, in its .dpr file, insert something like:
if (Pos('/WaitForShutDown', CmdLine) <> 0) then
WaitForSingleObject(ShutDownMutexHandle, INFINITE);
Also, in your program, after all the finalizations and releasing your common resources, include something like
ReleaseMutex(ShutDownMutexHandle);

EDIT...
OK. Now I belive that I know where is your problem...
You have problems with program units finalization!
Try to add at program section as first unit my bottom RestartMutex unit.
program MyProgramName;
uses
Mutex,
Forms,
...
;
unit RestartMutex;
interface
var
Restart: boolean = false;
implementation
uses
windows,
ShellApi;
var
MutexHandle: cardinal;
AppName: PChar;
const
ID = 'MyProgram';
initialization
MutexHandle := CreateMutex (nil, False, PChar (ID));
if (GetLastError = ERROR_ALREADY_EXISTS) then
Halt;
finalization
ReleaseMutex(MutexHandle);
if Restart then
begin
AppName := PChar('MyProgramName.exe') ;
ShellExecute(0,'open', AppName, nil, nil, SW_SHOWNORMAL) ;
end:
end.
When you want to restart application just set variable Restart to true and than terminate an application.
So, because is RestartMutex added as first in program section, this will couse that finalisation of unit RestartMutex will hepped nearly at the end of closing an application and all other units will do finalization before unit RestartMutex, that mean the Application can start safe again!

You could pass a command line argument like "restart" and run a Sleep() before you try to acquire the Mutex or try to acquire the mutex in a loop that sleeps a while.
Also you could set up communication between both processes, but that might be overkill.

hi take a look a the following article by Zarko Gajic - there you will get some ideas, sample code and even a whole component to use.
hth,
reinhard

Your ReleaseMutex is probably failing since you're passing 'False' for 'bInitialOwner' while calling CreateMutex. Either have the initial ownership of the mutex, or call CloseHandle instead of 'ReleaseMutex' passing your mutex handle.

checkout this way:
Simply runs a new application and kills the currernt one;
http://www.delphitricks.com/source-code/windows/restart_the_own_program.html

(beating the sleep idea)
if you want to make sure the original process is really terminated/closed before you create the mutex, then one idea is to pass the PID to the new process (command line is the easiest, any other IPC method works as well), then use OpenProcess(SYNCHRONIZE, false, pid) and WaitForSingleObject (I'd use a loop with a timeout (100 ms is a good value) and act accordingly if the original process takes too long to close)
What I ended up doing, beside the above, was to also create a RestartSelf procedure in the same unit with the mutex, and do the logic there, in order to keep the single instance and restart logic in the same place (the parameter being hardcoded, you don't want hardcoded stuff to be scattered around your application(s).

Related

XQuery query to delete marked documents sometimes runs indefinitely

I have an XQuery query intended to wipe test documents from the database before each test that is run. Essentially it looks for a certain element to be present as a top level element in a document (called 'forTestOnly') and if it finds it it deletes the document. This query is run before each test in order to ensure the tests don't interfere with one another (we have about 200 tests using this). The exact XQuery is as such:
xquery version "1.0-ml";
import module namespace dls = "http://marklogic.com/xdmp/dls" at "/MarkLogic/dls.xqy";
let $deleteNonManagedDocs := for $testDoc in /*[forTestOnly]
let $testDocUri := fn:base-uri($testDoc)
where fn:not(dls:document-is-managed($testDocUri))
return xdmp:document-delete($testDocUri)
let $deleteManagedDocs := for $testDoc in cts:search(/*[forTestOnly], dls:documents-query())
let $testDocUri := fn:base-uri($testDoc)
return dls:document-delete($testDocUri, fn:false(), fn:false())
return ($deleteManagedDocs, $deleteNonManagedDocs)
While it seems to work fine most of the time, it recently has begun to sporadically spiral out of control. At some point during the test execution it begins to run for a near indefinite amount of time (I usually stop it after 600-700 seconds), most of the time it takes less than a second though. The database used for testing is not large (it has a few basic seed documents but nothing compared to a production database), and typically each test only creates a handful of documents with the 'forTestOnly' (if not less).
The query seems simple enough, and although running it 200 times in relatively quick succession would understandably put a strain on the database I can't imagine it would cause this kind of lagging (the tests are Grails integration tests and the entire execution takes a little over two minutes). Any ideas why the long run time?
As a side note I have verified that when the tests stall it is indeed after the XQuery has begun to run and not before in some sort of test wiring/execution.
Any help is greatly appreciated.
The query might look simple, but it isn't necessarily simple to evaluate. Those dls function calls could be doing anything, so it's tricky to estimate the complexity. The use of DLS also means that we don't know how much version history has to be deleted to delete each document.
One possibility is that you've discovered a bug. It might already be fixed, which is a good reason why you should always report the full version of the software you're using. The answer may be as simple as upgrading to pick up the fix.
Another possibility is that your test suite ends up running all of this work in a single high-level evaluation, so everything's in memory until the end. That could use enough memory to drive the server into swap. That would explain the recent "spiral out of control" behavior. Check the OS and see what it says.
Next, set the group file-log-level=Debug and check ErrorLog.txt while one of these slow events is happening. If you see XDMP-DEADLOCK messages, you may have a problem where two or more copies of this delete query are running at the same time. MarkLogic has automatic deadlock detection and resolution, but it's faster to avoid the deadlock in the first place.
Some logging might also help determine where the time is spent. Something like:
let $deleteNonManagedDocs := for $testDoc in /*[forTestOnly]
let $testDocUri := fn:base-uri($testDoc)
where fn:not(dls:document-is-managed($testDocUri))
return (
xdmp:log(text { 'unmanaged', $testDocUri }),
xdmp:document-delete($testDocUri))
let $deleteManagedDocs := for $testDoc in cts:search(/*[forTestOnly], dls:documents-query())
let $testDocUri := fn:base-uri($testDoc)
let $_ := xdmp:log(text { 'managed', $testDocUri })
return dls:document-delete($testDocUri, fn:false(), fn:false())
return ()
Finally you should also be able to simplify the query a bit. Since you're deleting everything, you can just ignore DLS.
xdmp:document-delete(
cts:uris(
(), (),
cts:element-query(xs:QName('forTestOnly'), cts:and-query(())))
This would be even simpler and more efficient if you set a collection on every test document: xdmp:collection-delete('test-docs').

Ada compiler: warning variable <X> is assigned but never read

I have the following very simple piece of code in Ada which is giving me grief. I trimmed down the code to the minimum to show the problem, the only thing you need to know is that Some_Task is a task type:
task body TB is
Task1 : Some_Task_Ref;
begin
Task1 := new Some_Task;
loop
Put_Line("Main loop is running, whatever...");
delay 5.0;
end loop;
end TB;
From what I understand about task activation in Ada this should be sufficient: I'm creating a task of type "Some_Task" and I don't have to do anything with it, it will execute it's main loop without any intervention. It's not like in java where you have to call a "start" method on the task object.
But if I'm correct, why is the compiler refusing to build, giving me the error:
warning variable "Task1" is assigned but never read
Why should I be forced to "read" Task1? It's a task, all it needs to do is run... what am I missing?
Note: this seems to happen only when I use GNAT in "Gnat mode" (switch -gnatg). Unfortunately I need this mode for some advanced pragmas, but it seems it introduces some "overzelous" checks like the one causing the problem above. How can I deactivate that check?
It's a warning, not an error, and does not prevent building an executable (unless you've turned on "treat warnings as errors"). It's a hint from the compiler that you may have made a mistake in creating a variable that is never used. You can tell the compiler that you don't indend to use Task1 by declaring it as a constant, like this:
Task1 : constant Some_Task_Ref := new Some_Task;
Just to answer this question, since the answer was posted in a comment, which cannot be marked as an answer.
As Holt said (all props to him) this can be fixed by using:
pragma Warnings (Off, Some_Task_Ref) ;

Reading from serial port iis erratic without user input

Using Delphi 7 I am reading from a serial port.
The read is always preceded by a write which triggers the h/w to measure from a sensor and write something for me to read (and there is always something to read).
I have two possibilities: manually enter a command and click a button to write that to the serial port (read model or f/w version, etc) or click a button to loop reading measurements until a stop button is pressed. These both use the same internal functions, so the code looks something like this:
WriteSerial('?model');
SerialData := ReadSerial(); // returns string
WriteSerial('?fw');
SerialData := ReadSerial();
and
while stopButtonNotPressed do
begin
WriteSerial('?data');
SerialData := ReadSerial();
Memo1.Lines.Add(SerialData );
end;
The first variant (manually entering a command & pressing a button) is always successful, no matter how quickly or slowly I enter commands (hold down button for repeat), where are the second goes
pass
fail
pass
pass
fail
pass
pass
fail
... add infinitum
adding calls to sleep produces nothing, but trying to debug, I found that if I add a modal dialog box MsgDialog, 'Please close this dialog...', mtInfo, [mrOK]); to the loop, then it no longer fails.
Now, it doesn't look like timing (else surely adding Sleep(2000); to the loop would make it pass & does not, so why does pressing a button on the main form or the modal dialog cause it to succeed?
Btw, the h/w user guide says nothing of CTS / RTS, and the sole code example provide also does not.
Note: if I manually enter ?data repeatedly it never fails ...
Any ideas?
Your serial devices need time to react, so obviously you need a break for the device to catch up. When you use the keyboard to push the button you're providing the brake it needs because the keyboard repeat isn't all that fast.
As you say Sleep(2000) should provide plenty of "break", but there are two other potential problems you'll need to take care of:
Serial communication isn't necessary buffered: Sleep(2000) might be too long!
The serial library you're using might be using windows messages to process incoming bytes. Sleep() inhibits the message pump, so no more messages flow towords your application
Try "sleeping" using something like this:
procedure BusyWait(ms: Cardinal);
var StopAt: TDateTime;
begin
StopAt := Now + EncodeTime(0, 0, ms div 1000, ms mod 1000);
while StopAt > Now do
begin
Application.ProcessMessages;
Sleep(50); // per MichaƂ Niklas's suggestion, to keep the CPU from reaching 100%
end;
end;
This routine will wait, but it'll keep the message pump going, allowing your serial library to receive messages. If that's the problem...
Maybe adding Application.ProcessMessages() before Sleep() will help.

How to redirect registry access of a dll loaded by my program

I have got a dll that I load in my program which reads and writes its settings to the registry (hkcu). My program changes these settings prior to loading the dll so it uses the settings my program wants it to use which works fine.
Unfortunately I need to run several instances of my program with different settings for the dll. Now the approach I have used so far no longer works reliably because it is possible for one instance of the program to overwrite the settings that another instance just wrote before the dll has a chance to read them.
I haven't got the source of the dll in question and I cannot ask the programmer who wrote it to change it.
One idea I had, was to hook registry access functions and redirect them to a different branch of the registry which is specific to the instance of my program (e.g. use the process id as part of the path). I think this should work but maybe you have got a different / more elegant.
In case it matters: I am using Delphi 2007 for my program, the dll is probably written in C or C++.
As an alternative to API hooking, perhaps you could use RegOverridePredefKey API.
Instead of hooking the registry access for the dll, you can use an inter-process lock mechanism for writing the values to the registry for your own app. The idea being that the lock acquired by instance1 isn't released until its dll "instance" has read the values, so that when instance2 starts it won't acquire the lock until instance1 has finished. You'd need a locking mechanism that works between processes for this to work. For example mutexes.
To create mutexes:
procedure CreateMutexes(const MutexName: string);
//Creates the two mutexes checked for by the installer/uninstaller to see if
//the program is still running.
//One of the mutexes is created in the global name space (which makes it
//possible to access the mutex across user sessions in Windows XP); the other
//is created in the session name space (because versions of Windows NT prior
//to 4.0 TSE don't have a global name space and don't support the 'Global\'
//prefix).
const
SECURITY_DESCRIPTOR_REVISION = 1; // Win32 constant not defined in Delphi 3
var
SecurityDesc: TSecurityDescriptor;
SecurityAttr: TSecurityAttributes;
begin
// By default on Windows NT, created mutexes are accessible only by the user
// running the process. We need our mutexes to be accessible to all users, so
// that the mutex detection can work across user sessions in Windows XP. To
// do this we use a security descriptor with a null DACL.
InitializeSecurityDescriptor(#SecurityDesc, SECURITY_DESCRIPTOR_REVISION);
SetSecurityDescriptorDacl(#SecurityDesc, True, nil, False);
SecurityAttr.nLength := SizeOf(SecurityAttr);
SecurityAttr.lpSecurityDescriptor := #SecurityDesc;
SecurityAttr.bInheritHandle := False;
CreateMutex(#SecurityAttr, False, PChar(MutexName));
CreateMutex(#SecurityAttr, False, PChar('Global\' + MutexName));
end;
To release a mutex, you'd use the ReleaseMutex API and to acquire a created mutex, you'd use the OpenMutex API.
For CreateMutex see: http://msdn.microsoft.com/en-us/library/ms682411(VS.85).aspx
For OpenMutex see: http://msdn.microsoft.com/en-us/library/ms684315(v=VS.85).aspx
For ReleaseMutex see: http://msdn.microsoft.com/en-us/library/ms685066(v=VS.85).aspx
dirty method: open the dll in a hexeditor and change/alter the registry-path from the original hive to any other you want to use or have your proper settings.

Find out what process registered a global hotkey? (Windows API)

As far as I've been able to find out, Windows doesn't offer an API function to tell what application has registered a global hotkey (via RegisterHotkey). I can only find out that a hotkey is registered if RegisterHotkey returns false, but not who "owns" the hotkey.
In the absence of a direct API, could there be a roundabout way? Windows maintains the handle associated with each registred hotkey - it's a little maddening that there should be no way of getting at this information.
Example of something that likely wouldn't work: send (simulate) a registered hotkey, then intercept the hotkey message Windows will send to the process that registered it. First, I don't think intercepting the message would reveal the destination window handle. Second, even if it were possible, it would be a bad thing to do, since sending hotkeys would trigger all sorts of potentially unwanted activity from various programs.
It's nothing critical, but I've seen frequent requests for such functionality, and have myself been a victim of applications that register hotkeys without even disclosing it anywhere in the UI or docs.
(Working in Delphi, and no more than an apprentice at WinAPI, please be kind.)
One possible way is to use the Visual Studio tool Spy++.
Give this a try:
Run the tool (for me, it's at C:\Program Files (x86)\Microsoft Visual Studio\2017\Community\Common7\Tools\spyxx_amd64.exe or you can download it). Note: there is spyxx.exe (32-bit version) and spyxx_amd64.exe (64-bit version) - if you don't see anything in 64-bit use the 32-bit version (ie.catches messages only in same architecture)
In the menu bar, select Spy -> Log messages... (or hit Ctrl + M)
Check All Windows in System in the Additional Windows frame
Switch to the Messages tab
Click the Clear All button
Select WM_HOTKEY in the listbox, or check Keyboard in Message Groups (if you're OK with more potential noise)
Click the OK button
Press the hotkey in question (Win + R, for example)
Select the WM_HOTKEY line in the Messages (All Windows) window, right click, and select Properties... in the context menu
In the Message Properties dialog, click the Window Handle link (this will be the handle for the window that received the message)
Click the Synchronize button on the Window Properties dialog. This will show the window in the main Spy++ window treeview (if it's windows itself or some popup application it shows nothing).
On the Window Properties dialog, select the Process tab
Click the Process ID link. This will show you the process (In my Win + R case: EXPLORER)
Your question piqued my interest, so I've done a bit of digging and while, unfortunately I don't have a proper answer for you, I thought I'd share what I have.
I found this example of creating keyboard hook (in Delphi) written in 1998, but is compilable in Delphi 2007 with a couple of tweaks.
It's a DLL with a call to SetWindowsHookEx that passes through a callback function, which can then intercept key strokes: In this case, it's tinkering with them for fun, changing left cursor to right, etc. A simple app then calls the DLL and reports back its results based on a TTimer event. If you're interested I can post the Delphi 2007 based code.
It's well documented and commented and you potentially could use it as a basis of working out where a key press is going. If you could get the handle of the application that sent the key strokes, you could track it back that way. With that handle you'd be able to get the information you need quite easily.
Other apps have tried determining hotkeys by going through their Shortcuts since they can contain a Shortcut key, which is just another term for hotkey. However most applications don't tend to set this property so it might not return much. If you are interested in that route, Delphi has access to IShellLink COM interface which you could use to load a shortcut up from and get its hotkey:
uses ShlObj, ComObj, ShellAPI, ActiveX, CommCtrl;
procedure GetShellLinkHotKey;
var
LinkFile : WideString;
SL: IShellLink;
PF: IPersistFile;
HotKey : Word;
HotKeyMod: Byte;
HotKeyText : string;
begin
LinkFile := 'C:\Temp\Temp.lnk';
OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, SL));
// The IShellLink implementer must also support the IPersistFile
// interface. Get an interface pointer to it.
PF := SL as IPersistFile;
// Load file into IPersistFile object
OleCheck(PF.Load(PWideChar(LinkFile), STGM_READ));
// Resolve the link by calling the Resolve interface function.
OleCheck(SL.Resolve(0, SLR_ANY_MATCH or SLR_NO_UI));
// Get hotkey info
OleCheck(SL.GetHotKey(HotKey));
// Extract the HotKey and Modifier properties.
HotKeyText := '';
HotKeyMod := Hi(HotKey);
if (HotKeyMod and HOTKEYF_ALT) = HOTKEYF_ALT then
HotKeyText := 'ALT+';
if (HotKeyMod and HOTKEYF_CONTROL) = HOTKEYF_CONTROL then
HotKeyText := HotKeyText + 'CTRL+';
if (HotKeyMod and HOTKEYF_SHIFT) = HOTKEYF_SHIFT then
HotKeyText := HotKeyText + 'SHIFT+';
if (HotKeyMod and HOTKEYF_EXT) = HOTKEYF_EXT then
HotKeyText := HotKeyText + 'Extended+';
HotKeyText := HotKeyText + Char(Lo(HotKey));
if (HotKeyText = '') or (HotKeyText = #0) then
HotKeyText := 'None';
ShowMessage('Shortcut Key - ' + HotKeyText);
end;
If you've got access to Safari Books Online, there is a good section about working with shortcuts / shell links in the Borland Delphi 6 Developer's Guide by Steve Teixeira and Xavier Pacheco. My example above is a butchered version from there and this site.
Hope that helps!
After some research, it appears that you'd need to get access to the internal structure that MS uses to store the hotkeys. ReactOS has a clean room implementation that implements the GetHotKey call by iterating an internal list and extracting the hotkey that matches the parameters to the call.
Depending on how close ReactOS' implementation is to the MS implementation, you may be able to poke around in memory to find the structure, but that's over my head...
BOOL FASTCALL
GetHotKey (UINT fsModifiers,
UINT vk,
struct _ETHREAD **Thread,
HWND *hWnd,
int *id)
{
PHOT_KEY_ITEM HotKeyItem;
LIST_FOR_EACH(HotKeyItem, &gHotkeyList, HOT_KEY_ITEM, ListEntry)
{
if (HotKeyItem->fsModifiers == fsModifiers &&
HotKeyItem->vk == vk)
{
if (Thread != NULL)
*Thread = HotKeyItem->Thread;
if (hWnd != NULL)
*hWnd = HotKeyItem->hWnd;
if (id != NULL)
*id = HotKeyItem->id;
return TRUE;
}
}
return FALSE;
}
I presume this thread on sysinternals was asked by someone related to this question, but I thought I'd link to it anyway to keep the two together. The thread looks very intriguing, but I suspect that some deep dive spelunking would need to happen to figure this out without access to the MS internals.
Off the top of my head, you might try enumerating all windows with EnumWindows, then in the callback, send WM_GETHOTKEY to each window.
Edit: Apparrently I was wrong about that. MSDN has more information:
WM_HOTKEY is unrelated to the WM_GETHOTKEY and WM_SETHOTKEY hot keys. The WM_HOTKEY message is sent for generic hot keys while the WM_SETHOTKEY and WM_GETHOTKEY messages relate to window activation hot keys.
Note: Here is a program purporting to have the functionality you are looking for. You could try decompiling it.
Another thread mentions a global NT level keyboard hook:
Re-assign/override hotkey (Win + L) to lock windows
maybe you can get the handle of the process that called the hook that way, which you can then resolve to the process name
(disclaimer: I had it in my bookmarks, haven't really tried/tested)
I know you can intercept the stream of messages in any window within your own process - what we used to call subclassing in VB6. (Though I do not remember the function, perhaps SetWindowLong?) I am unsure if you can do this for windows outside your own process. But for the sake of this post lets assume you find a way to do that. Then you can simply intercept the messages for all top level windows, monitor for the WM_HOTKEY message. You wouldn't be able to know all the keys right off the bat, but as they were pressed you could easily figure out what application was using them. If you persisted your results to disk and reloaded each time your monitor application was run you could increase the performance of your application over time.
This doesn't exactly answer the part of the question that is about the Windows API, but it answers the part of the question that is about a list of global hotkeys and the applications that "own" them.
The free Hotkey Explorer at http://hkcmdr.anymania.com/ shows a list of all global hotkeys and the applications that own them. This just has helped me figure out why an application-specific shortcut key stopped working and how to fix it (by reconfiguring the registered global hotkey in the app that had it registered), within a few seconds.

Resources