threadcheck.cls

VB圣经

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ThreadCheck"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'
' You are entitled to license free distribution of any application
'   that uses this file if you own a copy of the book, or if you
'   have obtained the file from a source approved by the author. You
'   may redistribute this file only with express written permission
'   of the author.
'
' This file depends on:
'   References:
'     VBoostTypes6.olb (VBoost Object Types (6.0))
'   Files:
'     None
'   Minimal VBoost conditionals:
'     None
'   Conditional Compilation Values:
'     None
'
' This file is discussed in Chapter 13.
'***************************************************************
Option Explicit

Private Declare Function FindAtom Lib "kernel32" Alias "FindAtomA" (ByVal AtomName As String) As Integer
Private Declare Function AddAtom Lib "kernel32" Alias "AddAtomA" (ByVal AtomName As String) As Integer
Private Declare Function DeleteAtom Lib "kernel32" (ByVal AtomName As Integer) As Integer
Private m_Atom As Integer
    
Private Sub Class_Initialize()
Dim strAtom As String
    strAtom = AtomString
    If FindAtom(strAtom) = 0 Then
        m_Atom = AddAtom(strAtom)
    Else
        'This class is designed to determine if this is the first
        'thread which was launched in this executable.  If you hit
        'the following assert in the VB IDE debugger, then you hit
        'the stop button during the last run.  In order to clear
        'this setting and allow you to debug, run
        ' ?DeleteAtom(FindAtom(strAtom))
        'in the immediate window until it returns 0, then set
        'the next statement to the If line above.
        Debug.Assert False
    End If
End Sub

Private Function AtomString() As String
    AtomString = "ThreadCheck" & CStr(App.hInstance)
End Function

Private Sub Class_Terminate()
    If m_Atom Then DeleteAtom m_Atom
End Sub

Public Property Get First() As Boolean
    First = m_Atom
End Property