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 |
|
---|
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 | */
|
---|
130 | Sub ThrowIfFailed(hr As HRESULT)
|
---|
131 | If FAILED(hr) Then
|
---|
132 | Throw New WindowsException(hr)
|
---|
133 | End If
|
---|
134 | End Sub
|
---|
135 |
|
---|
136 | End Namespace 'Widnows
|
---|
137 | End Namespace 'ActiveBasic
|
---|