var
g_hAppCritSecMutex: THandle;
dw: Longint;
begin
g_hAppCritSecMutex := CreateMutex(nil, true, PChar(Application.Title + '.OneInstance32.CriticalSection'));
// if GetLastError - лениво писать
g_hAppMutex := CreateMutex(nil, false, PChar(Application.Title + 'OneInstance32.Default'));
dw := WaitForSingleObject(g_hAppMutex, 0);
Result := (dw <> WAIT_TIMEOUT);
ReleaseMutex(g_hAppCritSecMutex); // необязательно вследствие последующего закрытия
CloseHandle(g_hAppCritSecMutex);
end;
initialization
g_hAppMutex := 0;
finalization
if LongBool(g_hAppMutex) then begin
ReleaseMutex(g_hAppMutex); // необязательно
CloseHandle(g_hAppMutex);
end;
end.
Как не допустить запуск второй копии программы XI
Михаил Чумак рекомендует следующий код:
Есть такая штука Atom (см. Help).
program SelfCheck;
uses
Windows,Forms,Unit1 in 'Unit1.pas' {Form1};
const
AtStr='MyProgram';
function CheckThis : boolean;
var
Atom: THandle;
begin
Atom:= GlobalFindAtom(AtStr);
Result:= Atom <> 0;
if not result then GlobalAddAtom(AtStr);
end;
begin
if not CheckThis then begin
// Запуск программмы
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
GlobalDeleteAtom(GlobalFindAtom(AtStr));
// !!!
end
else begin
MessageBox(0,'Нельзя запустить две копии','Моя программа',0);
end;
end.
Элегантно и работает однозначно. Спасибо Славе Шубину.
Как не допустить запуск второй копии программы XII
Nomadic рекомендует следующее:
A: Воспользуйтесь функцией ActivatePrevInstance из библиотеки rxLib. Для завершения второго экземпляра используйте Application.Terminate.
(AS): Другой вариант: X:DELPHI2DEMOSIPCDEMOSipcthrd.pas, функция IsMonitorRunning().
Как правильно завершить некое приложение?
Nomadic рекомендует следующий код:
Если не принудительно, то можно послать на его Instance сообщение WM_QUIT. Если же необходимо принудительно терминировать приложение, то смотрите ниже — под Windows NT процесс можно терминировать через специально предназначенный для этого хэндл. Иначе гарантии нет. Предположим, что процесс создаем мы, ожидая его завершения в течение maxworktime. Тогда —
var
dwResult: Longint; // This example was converted from C source.
begin
// Not tested. Some 'nil' assignments must be applied
// as zero assignments in Pascal. Some vars need to
// be declared (maxworktime, si, pi). AA.
if CreateProcess(nil, CmdStr, nil, nil, FALSE,CREATE_NEW_CONSOLE, nil, nil, si, pi) then begin
CloseHandle(pi.hThread);
dwResult := WaitForSingleObject(pi.hProcess, maxworktime*1000*60);
CloseHandle(pi.hProcess);
if dwResult <> WAIT_OBJECT_0 then begin
pi.hProcess := OpenProcess(PROCESS_TERMINATE, FALSE, pi.dwProcessId);
if pi.hProcess <> nil then begin
TerminateProcess(pi.hProcess, 0);
CloseHandle(pi.hProcess);
end;
end;
end;
end;
Как отчитывать промежутки времени с точностью, большей чем 60 мсек?
Nomadic рекомендует следующий код:
Для начала описываешь процедуру, которая будет вызываться по сообщению от таймера :
procedure FNTimeCallBack(uTimerID, uMessage: UINT;dwUser, dw1, dw2: DWORD); stdcall;
begin
//// Тело процедуры.
end;
а дальше в программе (например по нажатию кнопки) создаешь Таймер и вешаешь на него созданную процедуру
uTimerID:=timeSetEvent(10, 500, @FNTimeCallBack, 100, TIME_PERIODIC);
Подробности смотри в Help. Hу и в конце убиваешь таймер
timeKillEvent(uTimerID);
И все. Точность этого способа до 1 мсек. минимальный интервал времени можно задавать 1 мсек.
Обратите внимание на то, что все CALLBACK-функции, вызываемые Windows, должны использовать соглашение о вызовах stdcall.
Как сделать чтобы при событиях моя программа отпpавляла кому-либо сообщение на мой компьютеp?
Nomadic рекомендует следующий код:
Если только послать, то проще всего, пожалуй…
W32: F1 «NetMessageBufferSend»;
Win16: Почему-то не описан, но руками наковырял…
function NetMessageBufferSend(Zero1, Zero2: Word; WhoTo: PChar; Buffer: PChar; BufSize: Word): Integer; external 'netapi' index 525;
«Кому» может быть '*' == всем.
Что нужно давать WSAAsyncSelect в качестве параметра handle, если тот запускается и используется в dll (init), и никакой формы (у которой можно было бы взять этот handle) в этой dll не создается?
Nomadic рекомендует следующий код:
const WM_ASYNCSELECT = WM_USER+0;
type TNetConnectionsManager = class(tobject)
protected
FWndHandle : HWND;
procedure WndProc(var MsgRec : TMessage);
…
end;
constructor TNetConnectionsManager.Create
begin
inherited Create;
FWndHandle := AllocateHWnd(WndProc);
…
end;
destructor TNetConnectionsManager.Destroy;
begin
…
if FWndHandle<>0 then DeallocateHWnd(FWndHandle);
inherited Destroy;
end;
procedure TNetConnectionsManeger.WndProc(var MsgRec : TMessage);
begin
with MsgRec do
if Msg = WM_ASYNCSELECT then WMAsyncSelect(MsgRec)
else DefWindowProc(FWndHandle, Msg, wParam, lParam);
end;
Hо pекомендую посмотpеть WinSock2, в котоpом можно:
WSAEventSelect(FSocket, FEventHandle, FD_READ or fd_close);
WSAWaitForMultipleEvents(…);
WSAEnumNetworkEvents(FSocket, FEventHandle, lpNetWorkEvents);
То есть, обойтись без окон и без очеpеди сообщений windows, а заодно иметь возможность pаботать и с IPX/SPX, и с netbios.
Вызов других программ
[email protected] пишет:
Доброго времени суток,
Вот посмотрел Ваше произведение Советы по делфи, мне очень понравилось :-)
Правда в вопросе/решении запустить другую программу просто обалдел :-( Я как то долго мучился с этим самым ShellExecute пока не пришёл к следующему:
uses …ToolWin, Windows …
procedure Run(App: String);
var
ErrStr : String;
PMSI: TStartupInfo;
PMPI: TProcessInformation;
begin
try
CreateProcess(nil, @App[1] , nil, nil, False, NORMAL_PRIORITY_CLASS, nil, nil, PMSI, PMPI);
except
ErrStr := 'Fault run process: '''+App+'''';
Application.MessageBox(@ErrStr[1],'Failure process', MB_OK+MB_ICONERROR);
end;
разумеется это одно из самых корявых решений, но всё же работает, как вариант сойдет?
Получение списка запущеных приложений
Igor Nikolaev aKa The Sprite предлагает следующий код:
procedure TForm1.Button1Click(Sender: TObject);
VAR
Wnd : hWnd;
buff: ARRAY [0..127] OF Char;
begin
ListBox1.Clear;
Wnd := GetWindow(Handle, gw_HWndFirst);
WHILE Wnd <> 0 DO BEGIN {Hе показываем:}
IF (Wnd <> Application.Handle) AND {-Собственное окно}
IsWindowVisible(Wnd) AND {-Hевидимые окна}
(GetWindow(Wnd, gw_Owner) = 0) AND {-Дочернии окна}
(GetWindowText(Wnd, buff, sizeof(buff)) <> 0)
THEN BEGIN
GetWindowText(Wnd, buff, sizeof(buff));
ListBox1.Items.Add(StrPas(buff));
END;
Wnd := GetWindow(Wnd, gw_hWndNext);
END;
ListBox1.ItemIndex := 0;
end;
Как мне запустить какую-нибудь программу? А как подождать, пока эта программа не отработает? Как выяснить, работает ли программа или уже завершилась? Как принудительно закрыть выполняющуюся программу?
Nomadic рекомендует следующее:
A: WinExec() или ShellExecute. У второй больше возможностей.
(SO): CreateProcess() в параметре process info возвращает handle запущенного процесса. Вот и делаешь WaitForSingleObject(pi.hProcess, INFINITE);
(AA): (Win16) Delay можно взять из rxLib.
handle := WinExec(…);
