[269] | 1 | 'Classes/ActiveBasic/Windows/Windows.ab
|
---|
| 2 |
|
---|
| 3 | Namespace ActiveBasic
|
---|
| 4 | Namespace Windows
|
---|
| 5 |
|
---|
| 6 | Function GetPathFromIDList(pidl As LPITEMIDLIST) As String
|
---|
| 7 | Dim buf[ELM(MAX_PATH)] As TCHAR
|
---|
| 8 | If SHGetPathFromIDList(pidl, buf) Then
|
---|
| 9 | Return New String(buf)
|
---|
| 10 | Else
|
---|
| 11 | Return ""
|
---|
| 12 | End If
|
---|
| 13 | End Function
|
---|
| 14 |
|
---|
| 15 | Function GetFolderPath(hwnd As HWND, folder As Long) As String
|
---|
| 16 | Dim pidl As LPITEMIDLIST
|
---|
| 17 | Dim hr = SHGetSpecialFolderLocation(hwnd, folder, pidl)
|
---|
| 18 | If SUCCEEDED(hr) Then
|
---|
| 19 | GetFolderPath = GetPathFromIDList(pidl)
|
---|
| 20 | CoTaskMemFree(pidl)
|
---|
| 21 | Else
|
---|
| 22 | GetFolderPath = ""
|
---|
| 23 | End If
|
---|
| 24 | End Function
|
---|
| 25 |
|
---|
| 26 | Function GetFolderPath(folder As Long) As String
|
---|
| 27 | Return GetFolderPath(0, folder)
|
---|
| 28 | End Function
|
---|
[303] | 29 | /*
|
---|
| 30 | Function MessageBox(hw As HWND, s As PCSTR, t As PCSTR, b As DWord) As DWord
|
---|
| 31 | Return MessageBoxA(hw, s, t, b)
|
---|
| 32 | End Function
|
---|
[269] | 33 |
|
---|
[303] | 34 | Function MessageBox(hw As HWND, s As PCWSTR, t As PCWSTR, b As DWord) As DWord
|
---|
| 35 | Return MessageBoxW(hw, s, t, b)
|
---|
| 36 | End Function
|
---|
| 37 | */
|
---|
| 38 |
|
---|
| 39 | Namespace Detail
|
---|
| 40 | Function _System_MessageBox(hw As HWND, s As PCSTR, t As PCSTR, b As DWord) As DWord
|
---|
| 41 | Return MessageBoxA(hw, s, t, b)
|
---|
| 42 | End Function
|
---|
| 43 |
|
---|
| 44 | Function _System_MessageBox(hw As HWND, s As PCWSTR, t As PCWSTR, b As DWord) As DWord
|
---|
| 45 | Return MessageBoxW(hw, s, t, b)
|
---|
| 46 | End Function
|
---|
| 47 | End Namespace
|
---|
| 48 |
|
---|
[559] | 49 |
|
---|
| 50 | /*!
|
---|
| 51 | @brief Windows/COMのエラーを伝える例外クラス
|
---|
| 52 | @date 2008/07/13
|
---|
| 53 | @auther Egtra
|
---|
| 54 | */
|
---|
| 55 | Class WindowsException
|
---|
| 56 | Inherits System.Exception
|
---|
| 57 | Public
|
---|
| 58 | /*!
|
---|
| 59 | @biref コンストラクタ
|
---|
| 60 | */
|
---|
| 61 | Sub WindowsException()
|
---|
| 62 | Exception()
|
---|
| 63 | HResult = E_FAIL
|
---|
| 64 | End Sub
|
---|
| 65 | /*!
|
---|
| 66 | @biref コンストラクタ
|
---|
| 67 | @param[in] hr エラー値
|
---|
| 68 | */
|
---|
| 69 | Sub WindowsException(hr As HRESULT)
|
---|
| 70 | Exception(hresultToString(hr))
|
---|
| 71 | HResult = hr
|
---|
| 72 | End Sub
|
---|
| 73 | /*!
|
---|
| 74 | @biref コンストラクタ
|
---|
| 75 | @param[in] message エラーメッセージ
|
---|
| 76 | */
|
---|
| 77 | Sub WindowsException(message As String)
|
---|
| 78 | Exception(message)
|
---|
| 79 | HResult = E_FAIL
|
---|
| 80 | End Sub
|
---|
| 81 | /*!
|
---|
| 82 | @biref コンストラクタ
|
---|
| 83 | @param[in] hr エラー値
|
---|
| 84 | @param[in] message エラーメッセージ
|
---|
| 85 | */
|
---|
| 86 | Sub WindowsException(hr As HRESULT, message As String)
|
---|
| 87 | Exception(message)
|
---|
| 88 | HResult = hr
|
---|
| 89 | End Sub
|
---|
| 90 | /*!
|
---|
| 91 | @biref コンストラクタ
|
---|
| 92 | @param[in] message エラーメッセージ
|
---|
| 93 | @param[in] innerException 内部例外
|
---|
| 94 | */
|
---|
| 95 | Sub WindowsException(message As String, innerException As Exception)
|
---|
| 96 | Exception(message, innerException)
|
---|
| 97 | HResult = E_FAIL
|
---|
| 98 | End Sub
|
---|
| 99 | Private
|
---|
| 100 | Static Function hresultToString(hr As HRESULT) As String
|
---|
| 101 | Dim pszMsg As PCSTR
|
---|
| 102 | FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS,
|
---|
| 103 | 0, hr, LANG_USER_DEFAULT, VarPtr(pszMsg), 0, 0)
|
---|
| 104 | If pszMsg <> 0 Then
|
---|
| 105 | hresultToString = New String(pszMsg)
|
---|
| 106 | LocalFree(pszMsg)
|
---|
| 107 | End If
|
---|
| 108 | End Function
|
---|
| 109 | End Class
|
---|
| 110 |
|
---|
| 111 | /*!
|
---|
| 112 | @brief GetLastErrorのエラー値を基に例外を投げる。
|
---|
| 113 | @date 2008/07/13
|
---|
| 114 | @param[in] dwErrorCode Win32エラーコード
|
---|
| 115 | @throw WindowsException 常に投げられる。
|
---|
| 116 | @auther Egtra
|
---|
| 117 | */
|
---|
| 118 | Sub ThrowByWindowsError(dwErrorCode As DWord)
|
---|
| 119 | Throw New WindowsException(HRESULT_FROM_WIN32(dwErrorCode))
|
---|
| 120 | End Sub
|
---|
| 121 |
|
---|
| 122 | /*!
|
---|
| 123 | @brief HRESULT値を基に例外を投げる。
|
---|
| 124 | @date 2008/07/13
|
---|
| 125 | @param[in] hr HRESULT値
|
---|
| 126 | @throw WindowsException FAILED(hr)が真の場合
|
---|
| 127 | @auther Egtra
|
---|
| 128 | hrが成功値 (FAILED(hr) = False) の場合、この関数は何も行わない。
|
---|
| 129 | */
|
---|
[561] | 130 | Sub ThrowIfFailed(hr As HRESULT)
|
---|
[559] | 131 | If FAILED(hr) Then
|
---|
| 132 | Throw New WindowsException(hr)
|
---|
| 133 | End If
|
---|
| 134 | End Sub
|
---|
| 135 |
|
---|
[269] | 136 | End Namespace 'Widnows
|
---|
| 137 | End Namespace 'ActiveBasic
|
---|