exceptionbase.cls

VB 加密----------能够加密解密控件

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 1  'Persistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ExceptionBase"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'    CopyRight (c) 2005 Kell    y Ethridge
'
'    This file is part of VBCorLib.
'
'    VBCorLib is free software; you can redistribute it and/or modify
'    it under the terms of the GNU Library General Public License as published by
'    the Free Software Foundation; either version 2.1 of the License, or
'    (at your option) any later version.
'
'    VBCorLib is distributed in the hope that it will be useful,
'    but WITHOUT ANY WARRANTY; without even the implied warranty of
'    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'    GNU Library General Public License for more details.
'
'    You should have received a copy of the GNU Library General Public License
'    along with Foobar; if not, write to the Free Software
'    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'
'    Module: ExceptionBase
'

''
' This is a helper class to easily manage an exception type class.
'
' @remarks This class should be used as a contained object that functions
' can be delegated to and performed with. This class contains the primary
' functions and properties common to all exceptions.
' <p>If the user-derived exception class needs to handle more information than
' this base class manages, then the developer needs to implement those
' additional features directly into the derived class.</p>
'
Option Explicit

' Default Values
Private Const DEF_HRESULT           As Long = 5

' Property Names used with PropertyBag
Private Const PROP_MESSAGE          As String = "Message"
Private Const PROP_ISNULLMESSAGE    As String = "IsNullMessage"
Private Const PROP_HRESULT          As String = "HResult"
Private Const PROP_SOURCE           As String = "Source"
Private Const PROP_HELPLINK         As String = "HelpLink"
Private Const PROP_INNEREXCEPTION   As String = "InnerException"
Private Const PROP_VALUES           As String = "Values"
Private Const PROP_DATA             As String = "Data'"

' Set of values that are common to all exception classes.
Private mHResult            As Long
Private mMessage            As String
Private mSource             As String
Private mHelpLink           As String
Private mInnerException     As Exception
Private mValues             As Hashtable
Private mSubclass           As Long
Private mSubclassName       As String
Private mData               As Hashtable


''
' Returns a key/value set of data that is associated to the exception.
'
' @return a key/value set of data that is associated to the exception.
' @remarks This is a public property that is used by the exception
' classes to allow user-defined information to be included with the exception.
'
Public Property Get Data() As IDictionary
    If mData Is Nothing Then Set mData = New Hashtable
    Set Data = mData
End Property

''
' Sets a value that can be associated with the exception without
' needing to maintain the value in the Subclass exception class.
'
' @param Name The name of the value to set.
' @param Value The value to set.
' @remarks If the value already exists, it will be replaced.
'
Public Sub SetValue(ByVal Name As String, ByRef Value As Variant)
    If IsObject(Value) Then
        Set values(Name) = Value
    Else
        values(Name) = Value
    End If
End Sub

''
' Returns a value being maintained in the exception base class.
'
' @param Name The name of the value to retrieve.
' @param Default The value to be returned if the value doesn't exist.
'
Public Function GetValue(ByVal Name As String, Optional ByRef Default As Variant) As Variant
    ' Steal the returned value from the Hashtable.
    Call Helper.MoveVariant(GetValue, values(Name))
    
    ' An empty value is the default return value for a key
    ' that does not exist in a Hashtable. It is also a valid
    ' value that may have been added to the Hashtable.
    ' So now we can check if the key exists. If it doesn't,
    ' then return the default value. This saves us from
    ' having to call into the Hashtable twice unless the
    ' returned value is Empty.
    If IsEmpty(GetValue) Then
        If Not values.Contains(Name) Then Call VariantCopyInd(GetValue, Default)
    End If
End Function

''
' Gets the HResult the current exception represents.
'
' @return The HResult.
' @remarks This is the same as Err.Number in most cases. Since this
' is a helper base class, it can hold any custom value needed for use
' by the Subclass.
' <p>This property can be set in the constructor <b>NewExceptionBase</b>.
'
Public Property Get HResult() As Long
    HResult = mHResult
End Property

''
' Sets the HResult the current exception represents.
'
' @param RHS The new HResult value.
' @remarks This is the same as Err.Number in most cases. Since this
' is a helper base class, it can hold any custom value needed for use
' by the Subclass.
' <p>This property can be set in the constructor <b>NewExceptionBase</b>.
'
Public Property Let HResult(ByVal RHS As Long)
    mHResult = RHS
End Property

''
' Gets the error message associated with the Subclass exception.
'
' @return A custom message set by the Subclass, or a default
' message of "An Error has occurred."
' @remarks Generally this property is set to a meaningful message that
' is related to the exception that is being thrown. The message should
' be human readable.
' <p>This property can be set in the constructor <b>NewExceptionBase</b>.
'
Public Property Get Message() As String
    If cString.IsNull(mMessage) Then
        Message = Environment.GetResourceString(Exception_WasThrown, mSubclassName)
    Else
        Message = mMessage
    End If
End Property

''
' Sets the error message associated with the Subclass exception.
'
' @param NewMessage The message to set the base to. Setting this to
' vbNullString will cause GetMessage to return the default message.
' @remarks Generally this property is set to a meaningful message that
' is related to the exception that is being thrown. The message should
' be human readable.
' <p>This property can be set in the constructor <b>NewExceptionBase</b>.
'
Public Property Let Message(ByVal NewMessage As String)
    mMessage = NewMessage
End Property

''
' Gets the exception that caused the Subclassed exception to be thrown.
'
' @return The inner exception that caused the current exception to be thrown.
' @remarks when an exception is thrown and that exception causes another
' exception to be thrown, then the <b>InnerException</b> of the new <b>Exception</b>
' object should contain the exception that caused it to be thrown.
'
Public Property Get InnerException() As Exception
    Set InnerException = mInnerException
End Property

''
' Sets the exception that caused the Subclassed exception to be thrown.
'
' @param RHS The exception that caused this Subclass exception to be thrown.
' @remarks when an exception is thrown and that exception causes another
' exception to be thrown, then the <b>InnerException</b> of the new <b>Exception</b>
' object should contain the exception that caused it to be thrown.
' <p>The Subclass exception should not allow the <b>InnerException</b> to be changed.</p>
'
Public Property Set InnerException(ByVal RHS As Exception)
    Set mInnerException = RHS
End Property

''
' Gets a description of the source of the exception.
'
' @return A description of the source of the exception.
' @remarks The source of an exception generally will contain the name of
' the function being called when the exception was thrown. This is to help
' narrow down exactly where the exception had occurred.
'
Public Property Get Source() As String
    Source = mSource
End Property

''
' Sets a description of the source of the exception.