防止程序被多次运行的API函数

下面这个例子找出程序是否在运行,你可作一个处理,如果在运行就退出.  
    
  Declare   Function   FindWindow   Lib   "user32"   Alias   "FindWindowA"   (ByVal   lpClassName   As   String,   ByVal   lpWindowName   As   String)   As   Long  
  Declare   Function   PostMessage   Lib   "user32"   Alias   "PostMessageA"   (ByVal   hwnd   As   Long,   ByVal   wMsg   As   Long,   ByVal   wParam   As   Long,   lParam   As   Any)   As   Long  
  Declare   Function   GetClassName   Lib   "user32"   Alias   "GetClassNameA"   (ByVal   hwnd   As   Long,   ByVal   lpClassName   As   String,   ByVal   nMaxCount   As   Long)   As   Long  
  Declare   Function   ShowWindow   Lib   "user32"   (ByVal   hwnd   As   Long,   ByVal   nCmdShow   As   Long)   As   Long  
  Const   SW_SHOWNORMAL   =   1  
  Const   WM_CLOSE   =   &H10  
  Const   gcClassnameMSWord   =   "OpusApp"  
  Const   gcClassnameMSExcel   =   "XLMAIN"  
  Const   gcClassnameMSIExplorer   =   "IEFrame"  
  Const   gcClassnameMSVBasic   =   "wndclass_desked_gsk"  
  Const   gcClassnameNotePad   =   "Notepad"  
  Const   gcClassnameMyVBApp   =   "ThunderForm"  
  Private   Sub   main()  
          'KPD-Team   1998  
          'URL:   http://www.allapi.net/  
          'E-Mail:   KPDTeam@Allapi.net  
          Dim   WinWnd   As   Long,   Ret   As   String,   RetVal   As   Long,   lpClassName   As   String  
          'Ask   for   a   Window   title  
          Ret   =   InputBox("Enter   the   exact   window   title:"   +   Chr$(13)   +   Chr$(10)   +   "Note:   must   be   an   exact   match")  
          'Search   the   window  
          WinWnd   =   FindWindow(vbNullString,   Ret)  
          If   WinWnd   =   0   Then   MsgBox   "Couldn't   find   the   window   ...":   Exit   Sub  
          'Show   the   window  
          ShowWindow   WinWnd,   SW_SHOWNORMAL  
          'Create   a   buffer  
  '         lpClassName   =   Space(256)  
          'retrieve   the   class   name  
  '         RetVal   =   GetClassName(WinWnd,   lpClassName,   256)  
          'Show   the   classname  
  '         MsgBox   "Classname:   "   +   Left$(lpClassName,   RetVal)  
          'Post   a   message   to   the   window   to   close   itself  
          PostMessage   WinWnd,   WM_CLOSE,   0&,   0&  
  End   Sub  


也可用以下方法:  
  方法一    
    
  Option   Explicit  
  Public   Sub   CheckExist(fm   As   Form)  
  Dim   title   As   String  
  If   App.PrevInstance   Then  
        title   =   App.title  
        Call   MsgBox("這程式已執行",   vbCritical)  
        App.title   =   ""         '如此才不會Avtivate到自己  
        fm.Caption   =   ""  
        AppActivate   title   'activate先前就已行的程式  
        End  
  End   If  
  End   Sub  
    
  Private   Sub   Form_Load()  
  Call   CheckExist(Me)  
  End   Sub    
    
      方法二    
    
  使用Mutual   Exclusion去做  
  呼叫OpenMutex函數,如果所指定的Mutex已經建立,會傳回非0值,便可斷定程式已經執行,若傳回0,變建立一個新的Mutex,以供判定.程式碼如下  
  Dim   hMutex   As   Long  
  Private   Sub   Form_Load()  
  If   OpenMutex(0,   True,   "Honey")   Then  
          MsgBox   "程式已經在執行了",   vbExclamation  
          Unload   Me  
  Else  
          hMutex   =   CreateMutex(ByVal   0&,   False,   "Honey")    
  End   If  
  End   Sub  
    
  Private   Sub   Form_Unload(Cancel   As   Integer)  
  ReleaseMutex   hMutex  
  CloseHandle   hMutex  
  End   Sub  
  值得注意的事CreateMutex的宣告中和API檢視員所不同的是將第一個參數宣告成Any型態  


  sub   Main()  
    
  if   App.PrevInstance   then  
    
        end    
    
  eles   frmMain.show          
    
  end   if