Article ID: 189134
Article Last Modified on 7/1/2004
+-+---------------+----------------+
|S| Facility | Code |
+-+---------------+----------------+
S - the severity bit
0 - Success
1 - Error
Facility - the facility code
0 - FACILITY_NULL
1 - FACILITY_RPC
2 - FACILITY_DISPATCH
3 - FACILITY_STORAGE
4 - FACILITY_ITF
7 - FACILITY_WIN32
8 - FACILITY_WINDOWS
10 - FACILITY_CONTROL
Code - the status code
HRESULT __stdcall MyFunction(int* pnMyInteger)
Function MyFunction() As Long
#include <windows.h>
// Raises a false Error in Visual Basic from your DLL
HRESULT __stdcall BogusError()
{
// Some of the more common Automation errors have default
// values and descriptions.
// E_FAIL -- General Automation Error
// E_INVALIDARG -- Invalid procedure call or argument
// E_OUTOFMEMORY -- Out of memory
// E_ACCESSDENIED -- Permission denied
// DISP_E_OVERFLOW -- Overflow
// DISP_E_TYPEMISMATCH -- Type mismatch
// DISP_E_BADINDEX -- Subscript out of range
// DISP_E_ARRAYISLOCKED -- Array is fixed or locked
return DISP_E_TYPEMISMATCH;
}
// Sums a VB Integer Array and returns the result to VB
HRESULT __stdcall SumArray(SAFEARRAY** ppsaVBArray, short* piResult)
{
short iElement;
long lLb, lUb, lCnt;
long lResult = 0;
// Return E_INVALIDARG if the array has been declared but
// not initialized or if it has the wrong dimension.
if((*ppsaVBArray == NULL) || (SafeArrayGetDim(*ppsaVBArray) != 1))
return E_INVALIDARG;
// Get the upper and lower bounds of the array. A failure
// here should not occur, but trap it anyway.
if(FAILED(SafeArrayGetUBound(*ppsaVBArray, 1, &lUb)))
return E_FAIL;
if(FAILED(SafeArrayGetLBound(*ppsaVBArray, 1, &lLb)))
return E_FAIL;
// Loop through the array and sum up the elements.
for (lCnt = lLb; lCnt <= lUb; lCnt++)
{
if(FAILED(SafeArrayGetElement(*ppsaVBArray, &lCnt, &iElement)))
return DISP_E_BADINDEX;
lResult += iElement;
}
// VB Integer limited to maximum size of 32,767. Return
// Overflow error if sum exceeds max.
if(lResult > 32767)
return DISP_E_OVERFLOW;
// Otherwise, copy the result to the out parameter.
*piResult = (short)lResult;
// Return S_OK to let VB know function was successful.
return S_OK;
}
LIBRARY ErrSamp
DESCRIPTION 'Microsoft KB Sample DLL'
EXPORTS
BogusError
SumArray
[
uuid(2EE43FE0-F2E8-11d1-996A-92FF02C40D32),
helpstring("KB Sample: Raise Error in VB from a C DLL"),
lcid(0x0409),
version(1.0)
]
library ErrSample
{
[
helpstring("Sample functions exported by CErrSamp.dll"),
dllname("ErrSamp.dll")
]
module ErrFunctions
{
[
helpstring("Generates a trappable error value."),
entry("BogusError")
]
// The return HRESULT gets processed by VB, so this function
// will appear as a Sub to the VB developer.
HRESULT __stdcall BogusError();
[
helpstring("Returns the sum of an Integer array."),
entry("SumArray")
]
// To return a value to the VB developer's code, use the special
// [out, retval] keyword to make the last parameter the return
// value of the function after VB has processed our HRESULT.
HRESULT __stdcall SumArray([in] SAFEARRAY(short)* IntArray,
[out, retval] short* piResult);
} //End of Module
}; //End of Library
Option Explicit
Private Sub Form_Load()
Command1.Caption = "Raise Error"
Command2.Caption = "Sum Array"
End Sub
Private Sub Command1_Click()
On Error GoTo Err_Trap
BogusError
Exit Sub
Err_Trap:
MsgBox "Error: " & Err.Description, vbCritical, _
"Opps! Error" & Str$(Err.Number)
End Sub
Private Sub Command2_Click()
Dim aiMyArray() As Integer
Dim iRet As Integer
Dim i As Integer
On Error GoTo Err_Trap
' Array has been declared but not initialized.
' SumArray will return VB error # 5.
iRet = SumArray(aiMyArray)
' Initialize the Array and fill it with large
' values. This will cause Overflow error.
ReDim aiMyArray(5) As Integer
For i = 0 To 4
aiMyArray(i) = 10000 + i
Next i
iRet = SumArray(aiMyArray)
' ReDim the array and set new values. This
' time the function will succeed.
ReDim aiMyArray(3 To 9) As Integer
For i = 3 To 9
aiMyArray(i) = 1000 + i
Next i
iRet = SumArray(aiMyArray)
MsgBox "The sum of the array is" _
& Str$(iRet), , "Success!"
Exit Sub
Err_Trap:
Dim sMsg As String
sMsg = "This error was returned by your"
sMsg = sMsg & " C DLL!!" & vbCrLf & vbCrLf
sMsg = sMsg & Err.Description
MsgBox sMsg, vbCritical, _
"Opps! Error" & Str$(Err.Number)
Err.Clear
Resume Next
End Sub
Keywords: kbhowto KB189134