爲什麽在VisualBasic6中用API CreateMutex 不能正確建立一個互斥量?（真的是API高手就來吧）

Question

请看这里：
http://www.zjonline.com.cn/vbbible/software/program/vb/ccw/htmapi73.htm

Answer 1

To jixian(极限)
不支持多线程?我能搞得到啊.
就算如此,我用于进程之间的同步也可以吧?

Answer 2

进程间同步，我有个新贴子：
http://www.csdn.net/Expert/topic/516/516072.shtm
至于要多线程同步，在VB里想用四个核心对象Mutex, event, crital section来同步，基本上不可能，这是由VB6的线程模式决定的。
但是可以用COM的单元线程加上点技巧，来达到多线程同步。
怎么做，有时间，我会再发个贴子。

Answer 3

PS:
To jixian(极限)
不支持多线程?不能说VB完全不支持，做个不需要同步和多线程还是很简单的。Option ExplicitDeclare Sub ExitThread Lib "KERNEL32" ( _
    ByVal dwExitCode As Long)
    
Declare Sub CloseHandle Lib "KERNEL32" ( _
    ByVal h As Long)
    
Declare Function GetExitCodeThread Lib "KERNEL32" ( _
    ByVal hThread As Long, _
    ByRef lpExitCode As Long) As LongDeclare Function CreateThread Lib "KERNEL32" ( _
    ByRef lpThreadAttributes As Any, _
    ByVal dwStackSize As Long, _
    ByVal lpStartAddress As Long, _
    ByRef lpParameter As Any, _
    ByVal dwCreationFlags As Long, _
    ByRef lpThreadId As Long) As LongDeclare Sub Sleep Lib "KERNEL32" (ByVal dwMilliseconds As Long)Declare Function GetTickCount Lib "KERNEL32" () As LongConst STILL_ACTIVE = 259
Const pNull As Long = 0Private fRunning As Boolean
Private cCalc As Long
Private cAPI As Long
Private datBasic As Date
Private hThread As Long
Private idThread As LongSub StartThread(ByVal i As Long)
    ' Signal that thread is starting
    fRunning = True
    ' Create new thread
    hThread = CreateThread(ByVal pNull, 0, AddressOf ThreadProc, _
                           ByVal i, 0, idThread)
    If hThread = 0 Then MsgBox "Can't start thread"
End SubFunction StopThread() As Long
    ' Signal thread to stop
    fRunning = False
    ' Make sure thread is dead before returning exit code
    Do
        Call GetExitCodeThread(hThread, StopThread)
    Loop While StopThread = STILL_ACTIVE
    CloseHandle hThread
    hThread = 0
End FunctionFunction ThreadRunning() As Boolean
    ThreadRunning = fRunning
End FunctionFunction CalcCount() As Long
    CalcCount = cCalc
End FunctionFunction APICount() As Long
    APICount = cAPI
End FunctionFunction BasicTime() As Date
    BasicTime = datBasic
End FunctionSub ThreadProc(ByVal i As Long)
    ' Use parameter
    cCalc = i
    Do While fRunning
        ' Calculate something
        cCalc = cCalc + 1
        ' Use an API call
        cAPI = GetTickCount
        ' Use a Basic function
        datBasic = Now
        ' Switch immediately to another thread
        Sleep 1
    Loop
    ' Return a value
    ExitThread cCalc
End Sub

Answer 4

我手头的资料告诉我互拆体是可行的，具体资料如下：
VB声明：Public Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (lpMutexAttributes As SECURITY_ATTRIBUTES, ByVal bInitialOwner As Long, ByVal lpName As String) As Long
说明：创建一个互拆体
在VB里使用：没有问题。
参数：Long，如执行成功，就返回互斥体对象的句柄；零表示出错。会设置GetLastError。即使返回的是一个有效句柄，但倘若指定的名字已经存在，GetLastError也会设为ERROR_ALREADY_EXISTS 
参数表 
参数 类型及说明 
lpMutexAttributes SECURITY_ATTRIBUTES，指定一个SECURITY_ATTRIBUTES结构，或传递零值（将参数声明为ByVal As Long，并传递零值），表示使用不允许继承的默认描述符 
bInitialOwner Long，如创建进程希望立即拥有互斥体，则设为TRUE。一个互斥体同时只能由一个线程拥有 
lpName String，指定互斥体对象的名字。用vbNullString创建一个未命名的互斥体对象。如已经存在拥有这个名字的一个事件，则打开现有的已命名互斥体。这个名字可能不与现有的事件、信号机、可等待计时器或文件映射相符 
注解 
一旦不再需要，注意必须用CloseHandle函数将互斥体句柄关闭。从属于它的所有句柄都被关闭后，就会删除对象
进程中止前，一定要释放互斥体，如不慎未采取这个措施，就会将这个互斥体标记为废弃，并自动释放所有权。共享这个互斥体的其他应用程序也许仍然能够用它，但会接收到一个废弃状态信息，指出上一个所有进程未能正常关闭。这种状况是否会造成影响取决于涉及到的具体应用程序
 
在美国人Den Appleman编写的《VISUAL BASIC 5.0 WIN32 API 开发人员指南》一书中可找到详细的资料

Answer 5

不是这个问题啊...我要用的是 GetLastError我主要是GetLastError来判断是否已经建立一个互斥量,而不需要用WaitSingleObject等待互斥释放信号.虽说用途有点偏,是建立同一个互斥量然后判断是否已经建立了一个实例(避免运行两个相同实例,我不用PrevInstance)我知道有个办法,就是用 WaitSingleObject 用一个断时间然后得到一个 TIMEOUT,但是我还是坚持想用 GetLastError 来判断.VC中是可行的,代码如下:CreateMutex(NULL,false,"MyInstance");
if(GetLastError()==ERROR_ALREADY_EXIST){
 AfxMessageBox("Mutex Already Exists !")
}

Answer 6

咦不对,我本来就是这样的hMutexHandle = CreateMutex(0,false,"MyInstance")
if GetLastError() = ERROR_ALREADY_EXISTS Then
  MsgBox (" Mutex Already Exists")
  End
End if但是没有得到那个错误

Answer 7

Private Declare Function CreateMutex Lib "Kernel32" Alias "CreateMutexA" (lpMutexAttributes As SECURITY_ATTRIBUTES, ByVal bInitialOwner As Long, ByVal lpName As String) As Long
Private Declare Function WaitForSingleObject Lib "Kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPrivate Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End TypePrivate Const ERROR_ALREADY_EXISTS = 183&Public Function IsCanRunning(Optional ByVal bWait As Boolean = False) As Boolean    Dim sa As SECURITY_ATTRIBUTES
    Dim lR As Long
    
    sa.bInheritHandle = True '默认的安全值
    sa.lpSecurityDescriptor = 0
    sa.nLength = Len(sa)
    
    lR = CreateMutex(sa, True, App.Title)
    
    If (Err.LastDllError = ERROR_ALREADY_EXISTS) Then
        If bWait And lR <> 0 Then
            WaitForSingleObject lR, &HFFFFFFFF
            IsCanRunning = True
        Else
            IsCanRunning = False
        End If
    Else
        IsCanRunning = True
    End If
    
End Function

Answer 8

哎，怎么就是用API的GetLastError不行呢？
好加分。

Answer 9

不过，VB的底层很多支持代码都不是线程安全的，就是说有很大一部分代码不可重入。
但是，VB还是为此做了不少努力。所以如果你的多线程程序出错，也不一定是你的代码
有错，很可能错在VB。