Function InitInstance : Boolean;
begin
MutHandle:= OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
if MutHandle = 0 then begin
{ Объект Mutex еще не создан, означая, что еще не создано }
{ другое приложение. }
ShowWindow(Application.Handle, SW_ShowNormal);
Application.ShowMainForm:=True;
DoFirstInstance;
result:= True;
end else begin
BroadcastFocusMessage;
result:= False;
end;
end;
initialization
begin
UniqueAppStr:= Application.Exexname;
MessageID:= RegisterWindowMessage(UniqueAppStr);
ShowWindow(Application.Handle, SW_Hide);
Application.ShowMainForm:=FALSE;
end;
finalization
begin
if WProc <> Nil then
{ Приводим приложение в исходное состояние }
SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));
end;
end.
VAR MutexHandle:THandle;
Var UniqueKey: string;
FUNCTION IsNextInstance:BOOLEAN;
BEGIN
Result:=FALSE;
MutexHandle:=0;
MutexHandle:=CREATEMUTEX(NIL,true, uniquekey);
IF MutexHandle<>0 THEN BEGIN
IF GetLastError=ERROR_ALREADY_EXISTS THEN BEGIN
Result:=TRUE;
CLOSEHANDLE(MutexHandle);
MutexHandle:=0;
END;
END;
END;
begin
CmdShow:=SW_HIDE;
MessageId:=RegisterWindowMessage(zAppName);
Application.Initialize;
IF IsNextInstance THEN PostMessage(HWND_BROADCAST, MessageId,0,0)
ELSE BEGIN
Application.ShowMainForm:=FALSE;
Application.CreateForm(TMainForm, MainForm);
MainForm.StartTimer.Enabled:=TRUE;
Application.Run;
END;
IF MutexHandle<>0 THEN CLOSEHANDLE(MutexHandle);
end.
В MainForm вам необходимо вставить обработчик внутреннего сообщения
PROCEDURE TMainForm.OnAppMessage(VAR M:TMSG; VAR Ret:BOOLEAN);
BEGIN
IF M.Message=MessageId THEN BEGIN
Ret:=TRUE;
// Поместить окно наверх !!!!!!!!
END;
END;
INITIALIZATION
ShowWindow(Application.Handle, SW_Hide);
END.
Каким образом, программным путем, можно узнать о завершении запущенной программы?
uses Wintypes,WinProcs,Toolhelp,Classes,Forms;
Function WinExecAndWait(Path: string; Visibility: word): word;
var
InstanceID: THandle;
PathLen: integer;
begin
{ Преобразуем строку в тип PChar }
PathLen:= Length(Path);
Move(Path[1],Path[0],PathLen);
Path[PathLen]:= #00;
{ Пытаемся запустить приложение }
InstanceID:= WinExec(@Path,Visibility);
if InstanceID < 32 then { значение меньше 32 указывает на ошибку приложения }
WinExecAndWait:= InstanceID
else begin
Repeat
Application.ProcessMessages;
until Application.Terminated or (GetModuleUsage(InstanceID) = 0);
WinExecAndWait:= 32;
end;
end;
function WinExecAndWait32(FileName: String; Visibility: integer):integer;
var
zAppName:array[0..512] of char;
zCurDir:array[0..255] of char;
WorkDir:String;
StartupInfo:TStartupInfo;
ProcessInfo:TProcessInformation;
begin
StrPCopy(zAppName,FileName);
GetDir(0,WorkDir);
StrPCopy(zCurDir,WorkDir);
FillChar(StartupInfo,Sizeof(StartupInfo),#0);
StartupInfo.cb:= Sizeof(StartupInfo);
StartupInfo.dwFlags:= STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow:= Visibility;
if not CreateProcess(nil,
zAppName, { указатель командной строки }
nil, { указатель на процесс атрибутов безопасности }
nil, { указатель на поток атрибутов безопасности }
false, { флаг родительского обработчика }
CREATE_NEW_CONSOLE or { флаг создания }
NORMAL_PRIORITY_CLASS,
nil, { указатель на новую среду процесса }
nil, { указатель на имя текущей директории }
StartupInfo, { указатель на STARTUPINFO }
ProcessInfo) then result := –1 { указатель на process_inf }
else begin
WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess,Result);
end;
end;
Получение имени модуля
Вот мое решение. Я использовал его во многих программах и смело рекомендую его вам.
procedure TForm1.Button1Click(Sender: TObject);
var
szFileName: array[0..49] of char;
szModuleName: array[0..19] of char;
iSize : integer;
begin
StrPCopy(szModuleName, 'NameOfModule');
iSize:= GetModuleFileName(GetModuleHandle(szModuleName), szFileName, SizeOf(szFileName));
if iSize > 0 then ShowMessage('Имя модуля с полным путем: ' + StrPas(szFileName))
else ShowMessage('Имя модуля не встречено');
end;
Извлечение из EXE-файла иконки и рисование ее в TImage.
Каким образом извлечь иконку из EXE– и DLL-файлов (ExtractAssociatedIcon) и отобразить ее на компоненте Timage или небольшой области на форме?
uses ShellApi;