I have a Small vcl application in delphi that run with admin privileges, this app only receive messages and poke mouse events.
The second application run with normal user priveleges(lower than first), this app cannot send messages to first app.
Im sure that the cause is the level of privileges, higher and low, because if I run both with lower or higher, they communicate with success.
How I can do IPC where I can send message to higher level application from the lowest level application ?
Or it is not possible ?
This is the way that I use to send messages:
The higher app uses this code to handle winapi.messages:
procedure TfrMouseDriver.WMCopyData(var Message: TWMCopyData);
var
S: WideString;
cmd, sX, sY: String;
s2,F: String;
WParam: WideString;
i, z, X, Y: integer;
begin
X := 1;
Y := 1;
if true then
begin
s:= PWideChar(Message.CopyDataStruct.lpData);
s2:= PChar(Message.CopyDataStruct.lpData);
...
And the lowest level application send messages with this way:
procedure TfrPenDriver.btnIPCClick(Sender: TObject);
var
CopyData: CopyDataStruct;
hMouse : HWND;
Msg : WideString;
begin
Msg := 'CM_MOVE:000500:000230';
hMouse := FindWindow(PCHAR('TfrMouseDriver'),nil);
if hMouse > 0 then
begin
CopyData.dwData := 0;
CopyData.lpData := PWideChar(Msg);
CopyData.cbData := (1 + Length(Msg))*SizeOf(WideChar);
Winapi.Windows.SendMessage(hMouse, WM_COPYDATA, 0, LPARAM(#CopyData));
end;
end;
Im looking I way to do IPC between this apps with diferent user levels, where the lowest level need to send to higher level app.
Mailslots for local machine inter-process communication is your best bet due to their simplicity and they are implemented via a driver in Windows, like pipes. This driver is msfs.sys on NT-based systems. You don't need any special privileges enabled either in order to create mailslots, read/write to them etc. and they work with any process type, application level and in any foreign session.
Window handles (HWND) are session-specific and will not work across other user sessions so in this case you run into problems using WM_COPYDATA since it relies on a window handle and as already mentioned, UIPI restrictions on more modern Windows operating systems can be a problem.
Another reason why WM_COPYDATA isn't great is this... Suppose that you're running executable code inside the context of another process (say a system process such as csrss) that isn't an "interactive" process. Maybe you've injected a DLL and want to send an IPC message with WM_COPYDATA... You can expect the process to crash or depending on the criticality of the process, expect a BSOD. This happens because these processes don't appreciate user32.dll API calls such as SendMessage, which WM_COPYDATA as an IPC system, relies on.
Stick to mailslots.
Related
How to block keyboard & mouse separately? I tried with BlockInput, it doesn't work in Windows 10 and also tried with as following:
function KBHookHandler(ACode: Integer; WParam: WParam; LParam: LParam)
: LResult; stdcall;
begin
if ACode < 0 then
// Immediately pass the event to next hook
Result := CallNextHookEx(Hook, ACode, WParam, LParam)
else
// by setting Result to values other than 0 means we drop/erase the event
Result := 1;
end;
function DisableKeyboard : boolean;
begin
if Hook = 0 then
// install the hook
// Hook := SetWindowsHookEx(WH_KEYBOARD, #KBHookHandler, HINSTANCE, 0);
Hook := SetWindowsHookEx(WH_KEYBOARD, #KBHookHandler, 0, 0);
Result := Hook <> 0;
end;
My requirement is block keyboard and mouse separately in Windows 7, Windows 8 & Windows 10.
You posted this same question on Embarcadero's Delphi NativeAPI forum, so I will give you the same answer I posted there.
The only way to block the mouse and keyboard separate is to use separate keyboard and mouse hooks.
BlockInput() works on Windows 10. But it blocks all input, you can't be selective with it.
When hooking other processes than your own, your hook MUST be in a DLL, and you must pass the DLL's hinstance to the 3rd parameter of SetWindowsHookEx():
An error may occur if the hMod parameter is NULL and the dwThreadId parameter is zero or specifies the identifier of a thread created by another process.
By specifying 0 for the hMod, the callback will only work in the calling process, since that is the only process that will have access to the callback. When you set the dwThreadId parameter to 0 to hook multiple threads globally, hMod must point to a DLL that can be injected into other processes.
Also, you may need separate 32bit and 64bit DLLs in order to properly hook 32bit and 64bit processes, respectively. But do make sure that the thread installing the hook has a message loop:
This hook may be called in the context of the thread that installed it. The call is made by sending a message to the thread that installed the hook. Therefore, the thread that installed the hook must have a message loop.
Because hooks run in the context of an application, they must match the "bitness" of the application. If a 32-bit application installs a global hook on 64-bit Windows, the 32-bit hook is injected into each 32-bit process (the usual security boundaries apply). In a 64-bit process, the threads are still marked as "hooked." However, because a 32-bit application must run the hook code, the system executes the hook in the hooking app's context; specifically, on the thread that called SetWindowsHookEx. This means that the hooking application must continue to pump messages or it might block the normal functioning of the 64-bit processes.
If a 64-bit application installs a global hook on 64-bit Windows, the 64-bit hook is injected into each 64-bit process, while all 32-bit processes use a callback to the hooking application.
To hook all applications on the desktop of a 64-bit Windows installation, install a 32-bit global hook and a 64-bit global hook, each from appropriate processes, and be sure to keep pumping messages in the hooking application to avoid blocking normal functioning. If you already have a 32-bit global hooking application and it doesn't need to run in each application's context, you may not need to create a 64-bit version. {quote}
The reason you are not able to lock out the entire system is because you are not hooking the entire system correctly to begin with.
I need to send several virtual keys (VK_RETURN) from my delphi application (myapp.exe) into another application (target.exe).
Eg : Send VK_RETURN twice , from myapp.exe , into target.exe
The OS that I use are Windows 7 64 bit and Windows XP.
I read : How to send an "ENTER" key press to another application? , Send Ctrl+Key to a 3rd Party Application (did not work for me) and other previous asked question.
But still I'm getting confused.
How to set the focus to the target application ?
How to send the virtual keys to the targeted application ?
Simple example : I want to send VK_RETURN twice into notepad.exe or calc.exe (already loaded) or any other program from my delphi application. How to do that ?
The simplest way to do this in Delphi 2010, please...
PS :
I tried SndKey32.pass from http://delphi.about.com/od/adptips2004/a/bltip1104_3.htm
And got error : [DCC Error] SndKey32.pas(420): E2010 Incompatible types: 'Char' and 'AnsiChar'
If (Length(KeyString)=1) then MKey:=vkKeyScan(KeyString[1])
If your target application isn't the foreground window, you need to use PostMessage to send keystrokes to its window handle. You can get that window handle using FindWindow. The code below sends the Enter key to a the text area in a running instance of Notepad (note it uses an additional FindWindowEx to locate the memo area first). It was tested using both Delphi 2007 and Delphi XE4 (32-bit target) on Windows 7 64.
uses Windows;
procedure TForm1.Button1Click(Sender: TObject);
var
NpWnd, NpEdit: HWnd;
begin
NpWnd := FindWindow('Notepad', nil);
if NpWnd <> 0 then
begin
NpEdit := FindWindowEx(NpWnd, 0, 'Edit', nil);
if NpEdit <> 0 then
begin
PostMessage(NpEdit, WM_KEYDOWN, VK_RETURN, 0);
PostMessage(NpEdit, WM_KEYUP, VK_RETURN, 0);
end;
end;
end;
To find the window by title (caption) instead, you can just use the second parameter to FindWindow. This finds a new instance of Notepad with the default 'Untitled' file open:
NpWnd := FindWindow(nil, 'Untitled - Notepad');
Note that this requires as exact match on the window title. An extra space before or after the -, for instance, will cause the match to fail and the window handle to not be retrieved.
You can use both the window class and title if you have multiple instances running. To find the copy of Notepad running with Readme.txt loaded, you would use
NpWnd := FindWindow('Notepad', 'Readme.txt - Notepad');
To find other applications, you'll need to use something like WinSpy or WinSight to find the window class names. (There are others also, such as Winspector or WinDowse (both of which are written in Delphi).)
Your comment mentions Calculator; according to Winspector, the Calculator main window is in a window class called CalcFrame on Windows 7, and the area the numbers are displayed in is a Static window (meaning it doesn't seem to receive keystrokes directly). The buttons are simply called Button, so you'd have to loop through them using EnumChildWindows looking for the individual buttons to identify them in order to obtain their handles.
(How to enumerate child windows is a separate question; you can probably find an example by searching here or via Google. If you can't, post a new, separate question about that and we can try to get you an answer.)
Here's a quick example of sending keys to Calculator after finding it by window class. It doesn't do anything useful, because it needs some time spent to identify different buttons and the keys that each responds to (and the proper combination of messages). This code simply sends 11Numpad+22 to the calculator window (a quick test showed that they were properly received and displayed, and that's about all the time I wanted to spend on the process).
uses Windows;
procedure TForm1.Button1Click(Sender: TObject);
var
NpWnd: HWnd;
begin
NpWnd := FindWindow('CalcFrame', nil);
if NpWnd <> 0 then
begin
PostMessage(NpWnd, WM_KEYDOWN, VK_NUMPAD1, 0);
PostMessage(NpWnd, WM_KEYDOWN, VK_ADD, 0);
PostMessage(NpWnd, WM_KEYDOWN, VK_NUMPAD2, 0);
end;
end;
I have a service application which I will be soon implementing a log file. Before I start writing how it saves the log file, I have another requirement that a small simple form application should be available to view the log in real-time. In other words, if the service writes something to the log, not only should it save it to the file, but the other application should immediately know and display what was logged.
A dirty solution would be for this app to constantly open this file and check for recent changes, and load anything new. But this is very sloppy and heavy. On the other hand, I could write a server/client socket pair and monitor it through there, but it's a bit of an overload I think to use TCP/IP for sending one string. I'm thinking of using the file method, but how would I make this in a way that wouldn't be so heavy? In other words, suppose the log file grows to 1 million lines. I don't want to load the entire file, I just need to check the end of the file for new data. I'm also OK with a delay of up to 5 seconds, but that would contradict the "Real-time".
The only methods of reading/writing a file which I am familiar with consist of keeping file open/locked and reading all contents of the file, and I have no clue how to only read portions from the end of a file, and to protect it from both applications attempting to access it.
What you are asking for is exactly what I do in one of my company's projects.
It has a service that hosts an out-of-process COM object so all of our apps can write messages to a central log file, and then a separate viewer app that uses that same COM object to receive notifications directly from the service whenever the log file changes. The COM object lets the viewer know where the log file is physically located so the viewer can open the file directly when needed.
For each notification that is received, the viewer checks the new file size and then reads only the new bytes that have been written since the last notification (the viewer keeps track of what the previous file size was). In an earlier version, I had the service actually push each individual log entry to the viewer directly, but under heavy load that is a lot of traffic to sift through, so I ended up taking that feature out and let the viewer handle reading the data instead, that way it can read multiple log entries at one time more efficiently.
Both the service and the viewer have the log file open at the same time. When the service creates/opens the log file, it sets the file to read/write access with read-only sharing. When the viewer opens the file, it sets the file to read-only access with read/write sharing (so the service can still write to it).
Needless to say, both service and viewer are run on the same machine so they can access the same local file (no remote files are used). Although the service does have a feature that forwards log entries via TCP/IP to a remote instance of the service running on another machine (then the viewer running on that machine can see them).
Our Open Source TSynLog class matches most of your needs - it's already stable and proven (used in real world applications, including services).
It features mainly fast logging (with a set of levels, not a hierarchy of level), exception interception with stack trace, and custom logging (including serialization of objects as JSON within the log).
You have even some additional features, like customer-side method profiler, and a log viewer.
Log files are locked during generation: you can read them, not modify them.
Works from Delphi 5 up to XE2, fully Open Source and with daily updates.
This may sound like a completely nutty answer but..
I use Gurock Softwares Smart Inspect.. http://www.gurock.com/smartinspect/
its great because you can send pictures, variables whatever and it logs them all, so while you want text atm, its a great for watching your app real time even on remote machines.. it can send it to a local file..
It maybe a useful answer to your problem, or a red herring - its a little unconventional but the additional features it has you may feel worth incorporating later (such as its great for capturing info should something go horribly wrong)
Years ago I wrote a circular buffer binary-file trace logging system, that avoided the problem of an endlessly growing file, while giving me the capabilities that I wanted, such as being able to see a problem if I wanted to, but otherwise, being able to just ignore the trace buffer.
However, if you want a continuous online system, then I would not use files at all.
I used files because I really did want file-like persistence and no listener app to have to be running. I simply wanted the file solution because I wanted the logging to happen whether anybody was around to "listen" right now, or not, but didn't use an endlessly growing text log because I was worried about using up hundreds of megs on log files, and filling up my 250 megabyte hard drive. One hardly has concerns like that in the era of 1 tb hard disks.
As David says, the client server solution is best, and is not complex really.
But you might prefer files, as I did, in my case way back. I only launched my viewer app as a post-mortem tool that I ran AFTER a crash. This was before there was MadExcept or anything like it, so I had some apps that just died, and I wanted to know what had happened.
Before my circular buffer, I would use a debug view tool like sys-internals DebugView and OutputDebugString, but that didn't help me when the crash happened before I launched DebugView.
File-based logging (binary) is one of the few times I allowed myself to create binary files. I normally hate hate hate binary files. But you just try to make a circular buffer without using a fixed length binary record.
Here's a sample unit. If I was writing this now instead of in 1997, I would have not used a "File of record", but hey, there it is.
To extend this unit so it could be used to be the realtime viewer, I would suggest that you simply check the datetime stamp on the binary file and refresh every 1-5 seconds (your choice) but only when the datetime stamp on the binary trace file has changed. Not hard, and not exactly a heavy load on the system.
This unit is used for the logger and for the viewer, it is a class that can read from, and write to, a circular buffer binary file on disk.
unit trace;
{$Q-}
{$I-}
interface
uses Classes;
const
traceBinMsgLength = 255; // binary record message length
traceEOFMARKER = $FFFFFFFF;
type
TTraceRec = record
index: Cardinal;
tickcount: Cardinal;
msg: array[0..traceBinMsgLength] of AnsiChar;
end;
PTraceBinRecord = ^TTraceRec;
TTraceFileOfRecord = file of TTraceRec;
TTraceBinFile = class
FFilename: string;
FFileMode: Integer;
FTraceFileInfo: string;
FStorageSize: Integer;
FLastIndex: Integer;
FHeaderRec: TTraceRec;
FFileRec: TTraceRec;
FAutoIncrementValue: Cardinal;
FBinaryFileOpen: Boolean;
FBinaryFile: TTraceFileOfRecord;
FAddTraceMessageWhenClosing: Boolean;
public
procedure InitializeFile;
procedure CloseFile;
procedure Trace(msg: string);
procedure OpenFile;
procedure LoadTrace(traceStrs: TStrings);
constructor Create;
destructor Destroy; override;
property Filename: string read FFilename write FFilename;
property TraceFileInfo: string read FTraceFileInfo write FTraceFileInfo;
// Default 1000 rows.
// change storageSize to the size you want your circular file to be before
// you create and write it. Remember to set the value to the same number before
// trying to read it back, or you'll have trouble.
property StorageSize: Integer read FStorageSize write FStorageSize;
property AddTraceMessageWhenClosing: Boolean
read FAddTraceMessageWhenClosing write FAddTraceMessageWhenClosing;
end;
implementation
uses SysUtils;
procedure SetMsg(pRec: PTraceBinRecord; msg: ansistring);
var
n: Integer;
begin
n := length(msg);
if (n >= traceBinMsgLength) then
begin
msg := Copy(msg, 1, traceBinMsgLength);
n := traceBinMsgLength;
end;
StrCopy({Dest} pRec^.msg, {Source} PAnsiChar(msg));
pRec^.msg[n] := Chr(0); // ensure nul char termination
end;
function IsBlank(var aRec: TTraceRec): Boolean;
begin
Result := (aRec.msg[0] = Chr(0));
end;
procedure TTraceBinFile.CloseFile;
begin
if FBinaryFileOpen then
begin
if FAddTraceMessageWhenClosing then
begin
Trace('*END*');
end;
System.CloseFile(FBinaryFile);
FBinaryFileOpen := False;
end;
end;
constructor TTraceBinFile.Create;
begin
FLastIndex := 0; // lastIndex=0 means blank file.
FStorageSize := 1000; // default.
end;
destructor TTraceBinFile.Destroy;
begin
CloseFile;
inherited;
end;
procedure TTraceBinFile.InitializeFile;
var
eofRec: TTraceRec;
t: Integer;
begin
Assert(FStorageSize > 0);
Assert(Length(FFilename) > 0);
Assign(FBinaryFile, Filename);
FFileMode := fmOpenReadWrite;
Rewrite(FBinaryFile);
FBinaryFileOpen := True;
FillChar(FHeaderRec, sizeof(TTraceRec), 0);
FillChar(FFileRec, sizeof(TTraceRec), 0);
FillChar(EofRec, sizeof(TTraceRec), 0);
FLastIndex := 0;
FHeaderRec.index := FLastIndex;
FHeaderRec.tickcount := storageSize;
SetMsg(#FHeaderRec, FTraceFileInfo);
Write(FBinaryFile, FHeaderRec);
for t := 1 to storageSize do
begin
Write(FBinaryFile, FFileRec);
end;
SetMsg(#eofRec, 'EOF');
eofRec.index := traceEOFMARKER;
Write(FBinaryFile, eofRec);
end;
procedure TTraceBinFile.Trace(msg: string);
// Write a trace message in circular file.
begin
if (not FBinaryFileOpen) then
exit;
if (FFileMode = fmOpenRead) then
exit; // not open for writing!
Inc(FLastIndex);
if (FLastIndex > FStorageSize) then
FLastIndex := 1; // wrap around to 1 not zero! Very important!
Seek(FBinaryFile, 0);
FHeaderRec.index := FLastIndex;
Write(FBinaryFile, FHeaderRec);
FillChar(FFileRec, sizeof(TTraceRec), 0);
Seek(FBinaryFile, FLastIndex);
Inc(FAutoIncrementValue);
if FAutoIncrementValue = 0 then
FAutoIncrementValue := 1;
FFileRec.index := FAutoIncrementValue;
SetMsg(#FFileRec, msg);
Write(FBinaryFile, FFileRec);
end;
procedure TTraceBinFile.OpenFile;
begin
if FBinaryFileOpen then
begin
System.CloseFile(FBinaryFile);
FBinaryFileOpen := False;
end;
if FileExists(FFilename) then
begin
// System.FileMode :=fmOpenRead;
FFileMode := fmOpenRead;
AssignFile(FBinaryFile, FFilename);
System.Reset(FBinaryFile); // open in current mode
System.Seek(FBinaryFile, 0);
Read(FBinaryFile, FHeaderRec);
FLastIndex := FHeaderRec.index;
FTraceFileInfo := string(FHeaderRec.Msg);
FBinaryFileOpen := True;
end
else
begin
InitializeFile; // Creates the file.
end;
end;
procedure TTraceBinFile.LoadTrace(traceStrs: TStrings);
var
ReadAtIndex: Integer;
Safety: Integer;
procedure NextReadIndex;
begin
Inc(ReadAtIndex);
if (ReadAtIndex > FStorageSize) then
ReadAtIndex := 1; // wrap around to 1 not zero! Very important!
end;
begin
Assert(Assigned(traceStrs));
traceStrs.Clear;
if not FBinaryFileOpen then
begin
OpenFile;
end;
ReadAtIndex := FLastIndex;
NextReadIndex;
Safety := 0; // prevents endless looping.
while True do
begin
if (ReadAtIndex = FLastIndex) or (Safety > FStorageSize) then
break;
Seek(FBinaryFile, ReadAtIndex);
Read(FBinaryFIle, FFileRec);
if FFileRec.msg[0] <> chr(0) then
begin
traceStrs.Add(FFileRec.msg);
end;
Inc(Safety);
NextReadIndex;
end;
end;
end.
Look at this article.
TraceTool 12.4: The Swiss-Army Knife of Trace
My suggestion would be to implement your logging in such a way that the log file "rolls over" on a daily basis. E.g. at midnight, your logging code renames your log file (e.g. MyLogFile.log) to a dated/archive version (e.g. MyLogFile-30082012.log), and starts a new empty "live" log (e.g. again MyLogFile.log).
Then it's simply a question of using something like BareTail to monitor your "live"/daily log file.
I accept this may not be the most network-efficient approach, but it's reasonably simple and meets your "live" requirement.
In a Delphi XE application I am trying to set up a global hook to monitor focus changes. The hook is created in a dll:
focusHook := SetWindowsHookEx( WH_CBT, #FocusHookProc, HInstance, 0 );
// dwThreadId (the last argument) set to 0 should create a global hook
In the same dll I have the hook procedure that posts a message to the host app window:
function FocusHookProc( code : integer; wParam: WPARAM; lParam: LPARAM ) : LResult; stdcall;
begin
if ( code < 0 ) then
begin
result := CallNextHookEx( focusHook, code, wParam, lParam );
exit;
end;
result := 0;
if ( code = HCBT_SETFOCUS ) then
begin
if ( hostHWND <> INVALID_HANDLE_VALUE ) then
PostMessage( hostHWND, cFOCUSMSGID, wParam, lParam );
end;
end;
This works, but the host only receives notifications on focus changes within the application itself. There is a memo and a few TButtons on the main form, and switching focus between them produces the expected message. However, any focus changes outside the application itself are never reported.
I suppose it has something to do with multiple instances of the DLL getting injected into other processes. There is a similar question with an accepted reply here, but it is for C, and I can't quite see how I can do the same in a Delphi dll (e.g. the pragma statements to set up shared memory).
(This is mostly a proof of concept, but I'd still like to get it to work. I need to know what window was active just before my app got activated by way of clicking, alt+tab, activation hotkey etc. The problem is that if the mouse or alt+tab is used, GetForegroundWindow always returns my own app's window handle, no matter how early I put it, such as by hooking the application's main message queue. So the hook seems like the only viable solution, though I don't really like the idea.)
Since the DLL is injected into another process, you're not going to get any breakpoints hit for anything other than the process you're debugging. Also, each instance of the DLL in the other process also get their own global/static data. If hostHWND is a global, it won't be the same value in the other process as it is in this one. In fact it won't even get initialized. You need to use a shared memory block to share values among the processes. Shared mutexes and other synchronization objects may need to be used to ensure any shared memory writes are protected. Finally, if you're using Windows Vista+, only processes with the same access level and below will get the DLL injected. IOW, if you're running the process as the logged-in user, only processed running as the logged-in user will get that DLL injected.
Try using WinEvents instead of the CBT hook: SetWinEventHook looking for EVENT_OBJECT_FOCUS as both min and max event, with the WINEVENT_OUTOFPROC flag, and 0 for idThread and idProcess. This will give you a hook that can listen to focus events from any process in the same desktop, without requiring a separate DLL, and it will work across both 32-bit and 64-bit applications.
There's a couple of caveats: one is that the events are not instantaneous; there's a slight lag as they are essentially posted to your process (which is how the out-of-proc option that avoids requiring a DLL works), but they may well be fast enough for your use. (And you'd have this same issue if you use PostMessage in your DLL hook anyhow!)
Also, you will get more events than actual HWND focus changes: various controls send these focus change events to signal internal focus change - focus moving between items in a list box, for example. You can filter these out by filtering in the callback for only those with idObject=OBJID_WINDOW and idChild=0.
Alternatively, if you listen for EVENT_SYSTEM_FOREGROUND events instead of EVENT_OBJECT_FOCUS (see MSDN for the full list of events), then it seems you should only get top-level window foreground events, which sounds like what you are actually after here.
I am handling from my Application associated extension files from Windows. So when you double click a file from Windows it will execute my program, and I handle the file from there, something like:
procedure TMainForm.FormCreate(Sender: TObject);
var
i: Integer;
begin
for i := 0 to ParamCount -1 do
begin
if SameText(ExtractFileExt(ParamStr(i)), '.ext1') then
begin
// handle my file..
// break if needed
end else
if SameText(ExtractFileExt(ParamStr(i)), '.ext2') then
begin
// handle my file..
// break if needed
end else
end;
end;
That works pretty much how I want it to, but when I was testing I realised it does not consider using only one instance of my program.
So for example, if I selected several Files from Windows and opened them all at the same time, this will create the same number of instances of my program with the number of Files being opened.
What would be a good way to approach this, so that instead of several instances of my program being opened, any additional Files from Windows being opened will simply focus back to the one and only instance, and I handle the Files as normal?
Thanks
UPDATE
I found a good article here: http://www.delphidabbler.com/articles?article=13&part=2 which I think is what I need, and shows how to work with the Windows API as mentioned by rhooligan. I am going to read through it now..
Here is some simple example code that gets the job done. I hope it is self-explanatory.
program StartupProject;
uses
SysUtils,
Messages,
Windows,
Forms,
uMainForm in 'uMainForm.pas' {MainForm};
{$R *.res}
procedure Main;
var
i: Integer;
Arg: string;
Window: HWND;
CopyDataStruct: TCopyDataStruct;
begin
Window := FindWindow(SWindowClassName, nil);
if Window=0 then begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end else begin
FillChar(CopyDataStruct, Sizeof(CopyDataStruct), 0);
for i := 1 to ParamCount do begin
Arg := ParamStr(i);
CopyDataStruct.cbData := (Length(Arg)+1)*SizeOf(Char);
CopyDataStruct.lpData := PChar(Arg);
SendMessage(Window, WM_COPYDATA, 0, NativeInt(#CopyDataStruct));
end;
SetForegroundWindow(Window);
end;
end;
begin
Main;
end.
unit uMainForm;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, StdCtrls;
type
TMainForm = class(TForm)
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure WMCopyData(var Message: TWMCopyData); message WM_COPYDATA;
public
procedure ProcessArgument(const Arg: string);
end;
var
MainForm: TMainForm;
const
SWindowClassName = 'VeryUniqueNameToAvoidUnexpectedCollisions';
implementation
{$R *.dfm}
{ TMainForm }
procedure TMainForm.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.WinClassName := SWindowClassName;
end;
procedure TMainForm.FormCreate(Sender: TObject);
var
i: Integer;
begin
for i := 1 to ParamCount do begin
ProcessArgument(ParamStr(i));
end;
end;
procedure TMainForm.ProcessArgument(const Arg: string);
begin
ListBox1.Items.Add(Arg);
end;
procedure TMainForm.WMCopyData(var Message: TWMCopyData);
var
Arg: string;
begin
SetString(Arg, PChar(Message.CopyDataStruct.lpData), (Message.CopyDataStruct.cbData div SizeOf(Char))-1);
ProcessArgument(Arg);
Application.Restore;
Application.BringToFront;
end;
end.
The logic goes something like this. When you start your application, you iterate through the list of running processes and see if your application is already running. If it is running, you need to activate the window of that instance and then exit.
Everything you need to do this is in the Windows API. I found this sample code on CodeProject.com that deals with processes:
http://www.codeproject.com/KB/system/Win32Process.aspx
On finding and activating a window, the basic approach is to find the window of interest using the window class name then activate it.
http://www.vb6.us/tutorials/activate-window-api
Hopefully this gives you a good starting point.
There are many answers here that show how to implement this. I want to show why NOT to use the FindWindow approach.
I am using FindWindow (something similar with the one shown by David H) and I have seen it failed starting with Win10 - I don't know what they changed in Win10.
I think the gap between the time when the app starts and the time when we set the unique ID via CreateParams is too big so another instance has somehow time to run in this gap/interval.
Imagine two instances started at only 1ms distance (let's say that the user click the EXE file and then presses enter and keeps it pressed by accident for a short while). Both instances will check to see if a window with that unique ID exists, but none of them had the chance to set the flag/unique ID because creating the form is slow and the unique ID is set only when the form is constructed. So, both instances will run.
So, I would recommend the CreateSemaphore solution instead:
https://stackoverflow.com/a/460480/46207
Marjan V already proposed this solution but didn't explained why it is better/safer.
I'd use mutexes. You create one when your program starts.
When the creation fails it means another instance is already running. You then send this instance a message with your command line parameters and close. When your app receives a message with a command line, it can parse the parameters like you are already doing, check to see whether it already has the file(s) open and proceed accordingly.
Processing this app specific message ia also the place to get your app to the front if it isn't already. Please do this politely (SetForegroundWindow) without trying to force your app in front of all others.
function CreateMutexes(const MutexName: String): boolean;
// Creates the two mutexes to see if the program is already 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).
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;
if (CreateMutex(#SecurityAttr, False, PChar(MutexName)) <> 0 )
and (CreateMutex(#SecurityAttr, False, PChar('Global\' + MutexName)) <> 0 ) then
Result := True
else
Result := False;
end;
initialization
if not CreateMutexes('MyAppNameIsRunningMutex') then
//Find and SendMessage to running instance
;
end.
Note: above code is adapted from an example on the InnoSetup site. InnoSetup creates installer applications and uses this approach in the installer to check whether (a previous version of) the application being installed is already running.
Finding the other instance and sending it a message, I'll leave for another question (or you can use the WM_COPYDATA approach from David's answer). Actually, there is a StackOverflow question that deals exactly with this: How to get the process thread that owns a mutex Getting the process/thread that owns the mutex may be a bit of a challenge, but the answers to this question do address ways to get the information from one instance to the other.
Windows has different ways to handle file associations to executable.
The "command line" approach is only the simplest one, but also the most limited one.
It also supports DDE (it still works although officially deprecated) and COM (see http://msdn.microsoft.com/en-us/library/windows/desktop/cc144171(v=vs.85).aspx).
If I recall correctly both DDE and COM will let your application receive the whole list of selected files.
I used window/message approach by myself with addition of events for tracking if the other instance is running:
Try to create event "Global\MyAppCode" (the "Global" namespace is used for handling various user sessions as I needed single instance system-wide; in your case you'll probably prefer "Local" namespace which is set by default)
If CreateEvent returned error and GetLastError = ERROR_ALREADY_EXISTS then the instance is running already.
FindWindow/WM_COPYDATA to transfer data to that instance.
But the drawbacks with messages/windows are more than significant:
You must always keep your window's Caption constant. Otherwise you'll have to list all the windows in the system and loop through them for partial occurrence of some constant part. Moreover the window's caption could be easily changed by a user or 3rd part app so the search would fail.
Method requires a window to be created so no console/service apps, or they must create a window and perform message loop especially for handling the single instance.
I'm not sure FindWindow could find a window that is opened in another user session
For me, WM_COPYDATA is rather awkward method.
So currently I'm a fan of named pipe approach (haven't implemented it yet though).
On launch, app tries to connect to "Global\MyAppPipe". If successed, other instance is running. If failed, it creates this pipe and finishes instance check.
2nd instance writes the required data to pipe and exits.
1st instance receives data and does some stuff.
It works through all user sessions (with namespace "Global") or just a current session; it doesn't depend on strings used by UI (no localization and modification issues); it works with console and service apps (you'll need to implement pipe reading in a separate thread/message loop though).