VB6 サンプル

[標準モジュール]

' Constants - FormatMessage.dwFlags
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER As Long = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY As Long = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE As Long = &H800
Private Const FORMAT_MESSAGE_FROM_STRING As Long = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK As Long = &HFF

'==========================================
' メッセージの文字列を指定の書式で取得する
'==========================================
Public Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
(ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) As Long

' Constants - LoadLibraryEx.dwFlags
Private Const DONT_RESOLVE_DLL_REFERENCES As Long = &H1
Private Const LOAD_IGNORE_CODE_AUTHZ_LEVEL As Long = &H10
Private Const LOAD_LIBRARY_AS_DATAFILE As Long = &H2
Private Const LOAD_LIBRARY_AS_DATAFILE_EXCLUSIVE As Long = &H40
Private Const LOAD_LIBRARY_AS_IMAGE_RESOURCE As Long = &H20
Private Const LOAD_WITH_ALTERED_SEARCH_PATH As Long = &H8

Public Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" _
(ByVal lpFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Public Declare Function FreeLibrary Lib "kernel32" (ByVal hModule As Long) As Long
Public Declare Function GetLastError Lib "kernel32.dll" () As Long

【サンプルリスト】

'==================================================
' エラーコードに対応するエラーメッセージを取得する
'   dwMessageId : Err.LastDllErrorのエラーコード
'==================================================
Public Function ErrMessage_GetLastError(dwMessageId As Long) As String

  Dim dwFlags As Long    'オプションフラグ
  Dim lpBuffer As String 'メッセージを格納するたのバッファ
  Dim result As Long     '戻り値(文字列のバイト数)

  dwFlags = FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS Or FORMAT_MESSAGE_MAX_WIDTH_MASK
  lpBuffer = String(1024, vbNullChar)
  result = FormatMessage(dwFlags, 0&, dwMessageId, 0&, lpBuffer, Len(lpBuffer), 0&)
  If (result > 0) Then
    lpBuffer = Left(lpBuffer, InStr(lpBuffer, vbNullChar) - 1)
  Else
    lpBuffer = ""
  End If
  ErrMessage_GetLastError = lpBuffer & "(" & dwMessageId & ")"

End Function

【サンプルリスト】

'================================================================
' WININET.DLLからエラーコードに対応するエラーメッセージを取得する
'   dwMessageId : Err.LastDllErrorのエラーコード
'=================================================================
Public Function ErrMessage_WinInet(dwMessageId As Long) As String

  Dim dwFlags As Long    'オプションフラグ
  Dim lpBuffer As String 'メッセージを格納するたのバッファ
  Dim hModule As Long    'DLLファイルのハンドル
  Dim result As Long     '戻り値(文字列のバイト数)

  dwFlags = FORMAT_MESSAGE_IGNORE_INSERTS Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_MAX_WIDTH_MASK
  lpBuffer = String(1024, vbNullChar)
  hModule = LoadLibraryEx("WININET.DLL", 0&, LOAD_LIBRARY_AS_DATAFILE)
  If (hModule <> 0) Then dwFlags = dwFlags Or FORMAT_MESSAGE_FROM_HMODULE
  result = FormatMessage(dwFlags, ByVal hModule, dwMessageId, 0&, lpBuffer, Len(lpBuffer), 0&)
  If (hModule <> 0) Then FreeLibrary hModule
  If (result > 0) Then
    lpBuffer = Left(lpBuffer, InStr(lpBuffer, vbNullChar) - 1)
  Else
    lpBuffer = ""
  End If
  ErrMessage_WinInet = lpBuffer & "(" & dwMessageId & ")"

End Function

●FormatMessage

【機能】

指定したエラーコードに対応するエラーメッセージ文字列を取得します。

【宣言】

Public Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
(ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) As Long

dwFlags :

オプションフラグ。

FORMAT_MESSAGE_ALLOCATE_BUFFER	0x00000100	エラーメッセージを格納する文字列バッファの領域を確保します。このフラグを指定した場合、lpBufferパラメータには、文字列ポインタへのポインタを指定します。また、取得したバッファが不要になれば、LocalFree関数でメモリから解放する必要があります。
FORMAT_MESSAGE_ARGUMENT_ARRAY	0x00002000	Arguments パラメータを、32ビット値の配列（va_list構造体ではない）へのポインタとします。
FORMAT_MESSAGE_FROM_HMODULE	0x00000800	lpSourceパラメータに、モジュールハンドルを指定します。FORMAT_MESSAGE_FROM_STRINGと同時に指定することはできません。
FORMAT_MESSAGE_FROM_STRING	0x00000400	lpSourceパラメータはメッセージ定義の文字列を指定します。FORMAT_MESSAGE_FROM_HMODULE、FORMAT_MESSAGE_FROM_SYSTEM と同時に指定することはできません。
FORMAT_MESSAGE_FROM_SYSTEM	0x00001000	システム定義のメッセージを検索します。FORMAT_MESSAGE_FROM_HMODULEを指定している場合、lpSourceに指定されるモジュールになければシステムメッセージのテーブルを捜します。FORMAT_MESSAGE_FROM_STRINGと同時に指定することはできません。
FORMAT_MESSAGE_IGNORE_INSERTS	0x00000200	Arguments パラメータを無視します。
FORMAT_MESSAGE_MAX_WIDTH_MASK	0x000000FF	エラーメッセージ内の改行コードを取り除きます。

lpSource :

FORMAT_MESSAGE_FROM_STRINGフラグを指定したときは、文字列へのポインタを指定します。
FORMAT_MESSAGE_FROM_HMODULEフラグを指定したときは、モジュールハンドルを指定します。
それ以外の場合は無視されます。

dwMessageId :

エラーコードを指定します。FORMAT_MESSAGE_FROM_STRINGフラグを指定したときは、無視されます。

dwLanguageId :

言語IDを指定します。FORMAT_MESSAGE_FROM_STRINGフラグを指定したときは、無視されます。

lpBuffer :

メッセージを格納するたのバッファへのポインタを指定します。
FORMAT_MESSAGE_ALLOCATE_BUFFERフラグを指定したときは、バッファポインタへのポインタを指定します。

nSize :

lpBufferパラメータで指定したバッファのサイズを指定します。
FORMAT_MESSAGE_ALLOCATE_BUFFERフラグを指定したときは、FormatMessage関数に割り当てるバッファの最小サイズを指定します。

Arguments :

32ビット値の配列ポインタを指定します。

【例】

Public Function ErrMessage_GetLastError(dwMessageId As Long) As String

  Dim dwFlags As Long    'オプションフラグ
  Dim lpBuffer As String 'メッセージを格納するたのバッファ
  Dim result As Long     '戻り値(文字列のバイト数)

  dwFlags = FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS Or FORMAT_MESSAGE_MAX_WIDTH_MASK
  lpBuffer = String(1024, vbNullChar)
  result = FormatMessage(dwFlags, 0&, dwMessageId, 0&, lpBuffer, Len(lpBuffer), 0&)

  If (result > 0) Then
    lpBuffer = Left(lpBuffer, InStr(lpBuffer, vbNullChar) - 1)
  Else
    lpBuffer = ""
  End If

  ErrMessage_GetLastError = lpBuffer & "(" & dwMessageId & ")"

End Function