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
|
---|
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
|
---|
33 |
|
---|
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 |
|
---|
49 | Function HResultToString(hr As HRESULT) As String
|
---|
50 | Dim pszMsg As PCSTR
|
---|
51 | FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS,
|
---|
52 | 0, hr, LANG_USER_DEFAULT, VarPtr(pszMsg) As PTSTR, 0, 0)
|
---|
53 | If pszMsg <> 0 Then
|
---|
54 | HResultToString = New String(pszMsg)
|
---|
55 | LocalFree(pszMsg)
|
---|
56 | End If
|
---|
57 | End Function
|
---|
58 |
|
---|
59 | /*!
|
---|
60 | @brief Windows/COMのエラーを伝える例外クラス
|
---|
61 | @date 2008/07/13
|
---|
62 | @auther Egtra
|
---|
63 | */
|
---|
64 | Class WindowsException
|
---|
65 | Inherits System.Exception
|
---|
66 | Public
|
---|
67 | /*!
|
---|
68 | @biref コンストラクタ
|
---|
69 | */
|
---|
70 | Sub WindowsException()
|
---|
71 | Exception()
|
---|
72 | HResult = E_FAIL
|
---|
73 | End Sub
|
---|
74 | /*!
|
---|
75 | @biref コンストラクタ
|
---|
76 | @param[in] hr エラー値
|
---|
77 | */
|
---|
78 | Sub WindowsException(hr As HRESULT)
|
---|
79 | Exception(HResultToString(hr))
|
---|
80 | HResult = hr
|
---|
81 | End Sub
|
---|
82 | /*!
|
---|
83 | @biref コンストラクタ
|
---|
84 | @param[in] message エラーメッセージ
|
---|
85 | */
|
---|
86 | Sub WindowsException(message As String)
|
---|
87 | Exception(message)
|
---|
88 | HResult = E_FAIL
|
---|
89 | End Sub
|
---|
90 | /*!
|
---|
91 | @biref コンストラクタ
|
---|
92 | @param[in] hr エラー値
|
---|
93 | @param[in] message エラーメッセージ
|
---|
94 | */
|
---|
95 | Sub WindowsException(hr As HRESULT, message As String)
|
---|
96 | Exception(message)
|
---|
97 | HResult = hr
|
---|
98 | End Sub
|
---|
99 | /*!
|
---|
100 | @biref コンストラクタ
|
---|
101 | @param[in] message エラーメッセージ
|
---|
102 | @param[in] innerException 内部例外
|
---|
103 | */
|
---|
104 | Sub WindowsException(message As String, innerException As Exception)
|
---|
105 | Exception(message, innerException)
|
---|
106 | HResult = E_FAIL
|
---|
107 | End Sub
|
---|
108 | Private
|
---|
109 | End Class
|
---|
110 |
|
---|
111 | /*!
|
---|
112 | @brief Windowsのエラー値を基に例外を投げる
|
---|
113 | @param[in] dwErrorCode Win32エラーコード
|
---|
114 | @param[in] msg 補足説明
|
---|
115 | @throw WindowsException 常に投げられる。
|
---|
116 | @date 2008/07/13
|
---|
117 | @auther Egtra
|
---|
118 | */
|
---|
119 | Sub ThrowWithErrorCode(dwErrorCode As DWord, msg = Nothing As String)
|
---|
120 | Throw New WindowsException(HRESULT_FROM_WIN32(dwErrorCode), msg)
|
---|
121 | End Sub
|
---|
122 | /*!
|
---|
123 | @brief WindowsExceptionを投げるラッパ。直前に呼び出したAPI関数などが失敗したときに用いる。
|
---|
124 | @param[in] msg 補足説明
|
---|
125 | @throw WindowsException 常に投げられる。
|
---|
126 | @date 2008/08/20
|
---|
127 | @auther Egtra
|
---|
128 | WindowsExceptionを構築する際、GetLastError()の値を渡す。
|
---|
129 | この関数では、直前のAPI関数が成功したかどうかを調べられないことに注意。
|
---|
130 | */
|
---|
131 | Sub ThrowWithLastError(msg = Nothing As String)
|
---|
132 | ThrowWithErrorCode(GetLastError(), msg)
|
---|
133 | End Sub
|
---|
134 | /*!
|
---|
135 | @brief (主にuser32の全部、gdi32の一部が対象)WindowsExceptionを投げるラッパ。直前に呼び出したAPI関数などが失敗したときに用いる。
|
---|
136 | @param[in] msg 補足説明
|
---|
137 | @throw WindowsException 常に投げられる。
|
---|
138 | @date 2008/08/26
|
---|
139 | @auther Egtra
|
---|
140 | user32やgdi32の一部など、9xではGetLastErrorでエラーメッセージが取得できないものがある。
|
---|
141 | そのため、9xでは一律にmsgのみでWindowsExceptionを構築して投げるようにしている。
|
---|
142 |
|
---|
143 | ところで、CEではNT同様GetLastErrorが使用できるため、
|
---|
144 | CEへの移植を仮定すると、関数名にNTと付けるのがそぐわないと感じる。代案募集中。
|
---|
145 | */
|
---|
146 | Sub ThrowWithLastErrorNT(msg As String)
|
---|
147 | If Not Version.Is9x() Then
|
---|
148 | ThrowWithErrorCode(GetLastError(), msg)
|
---|
149 | Else
|
---|
150 | Throw New WindowsException(msg)
|
---|
151 | End If
|
---|
152 | End Sub
|
---|
153 | /*!
|
---|
154 | @brief HRESULT値を基に例外を投げる。
|
---|
155 | @param[in] hr HRESULT値
|
---|
156 | @param[in] msg 補足説明
|
---|
157 | @throw WindowsException FAILED(hr)が真の場合
|
---|
158 | @date 2008/07/13
|
---|
159 | @auther Egtra
|
---|
160 | hrが成功値 (FAILED(hr) = False) の場合、この関数は何も行わない。
|
---|
161 | */
|
---|
162 | Sub ThrowIfFailed(hr As HRESULT, msg = Nothing As String)
|
---|
163 | If FAILED(hr) Then
|
---|
164 | Throw New WindowsException(hr, msg)
|
---|
165 | End If
|
---|
166 | End Sub
|
---|
167 |
|
---|
168 | End Namespace 'Widnows
|
---|
169 | End Namespace 'ActiveBasic
|
---|