не дать программе загружаться если она уже загружена

[CheburekV]

с-ма такая: программа по опред. событиям с-мы загружается и вообщем до опред. момента работает, но может произоити такая ситуация, что она может загрузиться в память несколько раз, что вообще-то не желатнльно. Вопрос: как см. тему?

[gjghjc]

Код: Выделить всё

Private Sub Form_Load()
If App.PrevInstance = True Then End
End Sub

[CheburekV]

gjghjc
Спасибо, выручил!

[JohnK]

Хе! Этот код не всегда срабатывает!

[Amed]

Этот код легко обойти, если запустить это же приложение из другого места.

Более корректно действовать с помощью Mutex (но это не единственный способ). В поиск по форуму.

[CheburekV]

Поздно вы мне это сообщили программа уже написана и используется по назначению...

[Twister]

Вот алгоритм нормального решения:

При запуске первого экземпляра прогой создается объект - это может быть окно, маппинг или мутекс. Лучше брать мутекс. А при запуске второго экземпляра проверяется существование этого объекта и если он имеет место быть, то прога завершает свою работу.

p.s. Если не знаешь что такое мутекс, то используй в качестве объекта синхронизации невидимую форму с каким-нибудь замысловатым Caption-ом, который на 100% ни где больше не встретится. Потом переберай все окна верхнего уровня (EnumWindows)...

[CheburekV]

Сначало так:

Код: Выделить всё

Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)

Function FindProcess(ByVal MyProcess As String) As Boolean
    Dim hSnapShot As Long, uProcess As PROCESSENTRY32
    hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
    uProcess.dwSize = Len(uProcess)
    r = Process32First(hSnapShot, uProcess)
    Do While r
        If MyProcess = Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0)) Then
            FindProcess = True
        Else
            FindProcess = False
        End If
        r = Process32Next(hSnapShot, uProcess)
    Loop
    CloseHandle hSnapShot
End Function


а потом так:

Код: Выделить всё

Private Sub Form_Load()
     If FindProcess("myprogramm.exe") = False then end
End Sub

что б совсем железно было.
Кстати вопрос на сколько этот код будет рабочим?

[Twister]

Код: Выделить всё

If FindProcess("myrogramm.exe") = 0 then end

Но программа по любому найдет сама себя и функция не возвратит 0...
Нужно искать еще один процесс с таким же именем и только тогда завершать работу.
ЗЫ. А если имя проги будет достаточно распространенным и ты найдешь другой, не твой процесс?..