запрещаем запуск нескольких копий программ. (только под windows и в gui режиме.)

у всех возникал вопрос, сделать так, чтоб программа не запускалась повторно.
это можно сделать многими способами, но мы будем делать самым простым.
а делается это с помощью функции FindWindow.
declare function FindWindow (byval as LPCSTR, byval as LPCSTR) as HWND
описание функции
http://vsokovikov.narod.ru/New_MSDN_API/Window/fn_findwindow.htm
ну а теперь пример.

Код:


' простое окно
#include "windows.bi"

declare function WinMain ( byval hInst as HINSTANCE, _
byval hPrevInst as HINSTANCE, _
  byval szCmdLine as LPSTR, _
  byval iCmdShow as integer ) as integer

' начало программы
#define ClassName "SimpleWinClass" ' Имя нашего класса окна
#define AppName "Our First Window" ' Имя нашего окна
dim hModule as HINSTANCE ' Хэндл нашей программы
dim CommandLine as LPSTR 'Указатель на командную строку
hModule = GetModuleHandle( NULL ) ' Взять хэндл программы
CommandLine = GetCommandLine() ' Взять командную строку.

if FindWindow(ClassName,AppName) then ' ищем программу по названию главного окна и его класса
MessageBox(0,"программа уже запущена",AppName,0)
    end if

end WinMain( hModule,NULL,CommandLine, SW_SHOWNORMAL ) ' вызвать основную функцию
' здесь заканчивается программа

' процедура окна
function  WndProc _
(byval hwnd as HWND, _ ' хэндл окна
byval uMsg as UINT, _ ' сообщение
byval wParam as WPARAM, _ ' дополнительный  параметр сообщений
byval lParam as LPARAM) as LRESULT ' дополнительный параметр сообщений
function = 0
select case uMsg  'начинаем обработку сообщений
case WM_DESTROY ' если окно разрушено
PostQuitMessage(0) ' выходим из программы

end select
function = DefWindowProc(hWnd,uMsg,wParam,lParam) ' Дефаултная функция обработки окна
end function


'функция WinMain
function WinMain _
(byval hInst as HINSTANCE, _ ' хэндл программы
byval hPrevInst as HINSTANCE, _ 'в win32 всегда 0
byval szCmdLine as LPSTR, _  'указатель на командную строку
byval iCmdShow as integer ) as integer  ' состояние окна при первом появлении

dim wc as WNDCLASSEX ' структура параметров окна
dim wMsg as MSG  ' структура сообщений
dim hWnd as HWND ' хэндл окна

 'структура класса окна wc

wc.cbSize = SIZEOF( WNDCLASSEX )  ' размер структуры WNDCLASSEX
wc.style = CS_HREDRAW or CS_VREDRAW  ' Стиль окна
wc.lpfnWndProc = @WndProc ' Адрес процедуры окна WndProc
wc.cbClsExtra = NULL  ' резервирование  дополнительных байт за концом структуры
wc.cbWndExtra = NULL
wc.hInstance = hInst  ' хэндл модуля
wc.hbrBackground = cast(HGDIOBJ, COLOR_WINDOW+1) ' Цвет фона
wc.lpszMenuName = NULL ' Хэндл меню
wc.lpszClassName = @ClassName ' класс окна
wc.hIcon = LoadIcon( NULL,IDI_APPLICATION ) ' Хэндл иконки
wc.hIconSm = wc.hIcon 'Хэндл маленькой иконки
wc.hCursor = LoadCursor( NULL,IDC_ARROW) ' Хэндл курсора


' регистрация нашего класса окна
if(RegisterClassEx(@wc) = FALSE) then
MessageBox(0,"Не могу зарегистрировать класс окна","Ошибка",0)
end 1
end if

' Создадим окно
hwnd = CreateWindowEx _
(NULL, _ ' дополнительные стили
@ClassName, _ ' указатель на строку с именем класса окна
@AppName, _ ' указатель на строку с именем окна
WS_OVERLAPPEDWINDOW, _ ' стиль окна
CW_USEDEFAULT, _ ' X
CW_USEDEFAULT, _ ' Y
CW_USEDEFAULT, _ ' ширина окна
CW_USEDEFAULT, _ ' высота окна
NULL, _ ' хэндл родительского окна
NULL, _ ' хэндл меню
hInst, _ ' хэндл модуля
NULL) ' указатель на структуру данных

ShowWindow( hwnd,iCmdShow) ' отобразить наше окно на десктопе
UpdateWindow( hwnd) ' обновить клиентскую область

while( GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE )  'цикл сообщений
TranslateMessage( @wMsg )
DispatchMessage( @wMsg )
wend
function = wMsg.wParam
end function


Ок! Спасибо!

Только мне это не нравится. В смысле поиск окна. Это какой-то шибко извращённый способ.
Я особо не ковырялся с сабжем. И было это давно. Но кажется, что был какой-то другой способ, более прикольный.
Может быть искать не окно, а проверить список запущеных процессов?

Всем привет!
Соглашусь с Эриком, немного ненадежный способ. А если у приложения вообще нет окна? Не создавать же его специально только для этого! А если заголовок окна должен изменяться (что у более-менее серьезных прог случается частенько!)? Имхо гораздо надежнее - и ничуть не сложнее такой способ:

Код:


if CreateSemaphore(NULL, 0, 1, "MyUniqueSemaphoreName") = NULL and GetLastError() = ERROR_ALREADY_EXISTS then
   ' копия процесса уже была запущена
   exit
end if


Вместо "MyUniqueSemaphoreName" подставляем любую строку, которая будет служить именем объкта "семафор" и будет идентифицировать наш процесс. Имя должно быть уникальным для системы (то есть если какой-то другой процесс создаст семафор с точно таким же именем, то ваша прога просто не запустится).
Проявите фантазию! В имени нельзя использовать слеш (\), и, к тому же, оно чувствительно к регистру.

О! Точно! А я всё пытался вспомнить... Мой респект!
Уже в мутексы даже посмотрел.. Симафорчики видел, но прошел мимо. Хе-хе.
Вот это действительно хорошее решение. Тем более сделано спецально для задачи по сабжу.

о, молодцы! а я пример с поиском окна, слизал с небезызвестных фроловых. теперь про симофоры узнал. я про них слышал, но невникал. надо будет почитать.

Фроловы конечно хорошие вещи писали, но они тоже люди.
Есть вообще странные вещи. А людей почему-то очень клинит с этими окнами.

Например для получения хэндла консольного окна, вместо простой GetConsoleWindow() мудрят с пполучением заголовка GetConsoleTitle, а потом поиска окна. И это делается ради его закрытия, хотя куда проще, вызвать сразу FreeConsole.

Вообщем тут всё не однозначно.

У меня почему то не работает айпишка CreateSemaphore
При таком коде выскакивает мессадж. Пробовал и просто без указателей писать строку, все равно результат один. Может я что в коде не так написал? Запускал под Windows 7

#Include "windows.bi"
CreateSemaphore(0, 0, 1, StrPtr("FILE"))
if CreateSemaphore(0, 0, 1, StrPtr("FILE")) = 0 and GetLastError() = ERROR_ALREADY_EXISTS then
' копия процесса уже была запущена
End 1
end If
MessageBox(0,"","",0)

Шорт Побэры!
Нужна проверка на неравенство нулю результата работы функции!!! А я у DiG. GeRR слизал написанное выше, и не могу понять, че она не работает

#Include "windows.bi"
if CreateSemaphore(0, 0, 1, "FILE")<>0 and GetLastError() = ERROR_ALREADY_EXISTS then
End 1
end If
MessageBox(0,"","",0)