Private Function IsRun(ByVal filename As String) As Boolean
On Error GoTo myerr
Dim mytempfile As String
mytempfile = App.Path + "\mytemp.bak"
FileCopy filename, mytempfile
Kill filename
IsRun = False
FileCopy mytempfile, filename
Kill mytempfile
Exit Function
myerr:
Select Case Err.Number
Case 75
Kill mytempfile
IsRun = True
Exit Function
Case Else
MsgBox Err.Description
End Select
End Function
'调用
Private Sub Command1_Click()
MsgBox IsRun("d:\mc\Duba_CodeBlue.EXE")
End Sub
如果是你自己的程序可以使用
If App.PrevInstance Then End
如果是其它程序可以使用
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Function IsRunning(ByVal lwinHwnd As Long) As Boolean
'-----------------------------------------------------------
'功能:
' 判断一个应用是否已经运行
'参数:
' lwinHwnd.....该应用的句柄
'返回值:
' IsRunning....如果此应用已经运行返回True;否则返回False
'-----------------------------------------------------------
Dim lhProgram As Long '被检测的程序进程句柄
lhProgram = OpenProcess(0, False, lwinHwnd)
If Not lhProgram = 0 Then
IsRunning = True
Else
IsRunning = False
End If
Private Function IsRun(ByVal filename As String) As Boolean
On Error GoTo myerr
Open filename For Input Lock Read Write As #1
Close #1
IsRun = False
Exit Function
myerr:
Select Case Err.Number
Case 70
IsRun = True
Exit Function
End Select
End Function
'调用
Private Sub Command1_Click()
MsgBox IsRun("d:\mc\ttest.exe")
End Sub