'Classes/ActiveBasic/Windows/Windows.ab

Namespace ActiveBasic
Namespace Windows

Function GetPathFromIDList(pidl As LPITEMIDLIST) As String
	Dim buf[ELM(MAX_PATH)] As TCHAR
	If SHGetPathFromIDList(pidl, buf) Then
		Return New String(buf)
	Else
		Return ""
	End If
End Function

Function GetFolderPath(hwnd As HWND, folder As Long) As String
	Dim pidl As LPITEMIDLIST
	Dim hr = SHGetSpecialFolderLocation(hwnd, folder, pidl)
	If SUCCEEDED(hr) Then
		GetFolderPath = GetPathFromIDList(pidl)
		CoTaskMemFree(pidl)
	Else
		GetFolderPath = ""
	End If
End Function

Function GetFolderPath(folder As Long) As String
	Return GetFolderPath(0, folder)
End Function
/*
Function MessageBox(hw As HWND, s As PCSTR, t As PCSTR, b As DWord) As DWord
	Return MessageBoxA(hw, s, t, b)
End Function

Function MessageBox(hw As HWND, s As PCWSTR, t As PCWSTR, b As DWord) As DWord
	Return MessageBoxW(hw, s, t, b)
End Function
*/

Namespace Detail
Function _System_MessageBox(hw As HWND, s As PCSTR, t As PCSTR, b As DWord) As DWord
	Return MessageBoxA(hw, s, t, b)
End Function

Function _System_MessageBox(hw As HWND, s As PCWSTR, t As PCWSTR, b As DWord) As DWord
	Return MessageBoxW(hw, s, t, b)
End Function
End Namespace


/*!
@brief	Windows/COMのエラーを伝える例外クラス
@date	2008/07/13
@auther	Egtra
*/
Class WindowsException
	Inherits System.Exception
Public
	/*!
	@biref	コンストラクタ
	*/
	Sub WindowsException()
		Exception()
		HResult = E_FAIL
	End Sub
	/*!
	@biref	コンストラクタ
	@param[in] hr	エラー値
	*/
	Sub WindowsException(hr As HRESULT)
		Exception(hresultToString(hr))
		HResult = hr
	End Sub
	/*!
	@biref	コンストラクタ
	@param[in] message	エラーメッセージ
	*/
	Sub WindowsException(message As String)
		Exception(message)
		HResult = E_FAIL
	End Sub
	/*!
	@biref	コンストラクタ
	@param[in] hr	エラー値
	@param[in] message	エラーメッセージ
	*/
	Sub WindowsException(hr As HRESULT, message As String)
		Exception(message)
		HResult = hr
	End Sub
	/*!
	@biref	コンストラクタ
	@param[in] message	エラーメッセージ
	@param[in] innerException	内部例外
	*/
	Sub WindowsException(message As String, innerException As Exception)
		Exception(message, innerException)
		HResult = E_FAIL
	End Sub
Private
	Static Function hresultToString(hr As HRESULT) As String
		Dim pszMsg As PCSTR
		FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS,
			0, hr, LANG_USER_DEFAULT, VarPtr(pszMsg) As PTSTR, 0, 0)
		If pszMsg <> 0 Then
			hresultToString = New String(pszMsg)
			LocalFree(pszMsg)
		End If
	End Function
End Class

/*!
@brief	Windowsのエラー値を基に例外を投げる
@param[in] dwErrorCode	Win32エラーコード
@throw WindowsException	常に投げられる。
@date 2008/07/13
@auther Egtra
*/
Sub ThrowWithErrorCode(dwErrorCode As DWord)
	Throw New WindowsException(HRESULT_FROM_WIN32(dwErrorCode))
End Sub

/*!
@brief 内部でGetLastErrorを呼んで、その値を基に例外を投げる。
@throw WindowsException	常に投げられる。
@date 2008/08/26
@auther Egtra
*/
Sub ThrowWithLastError()
	ThrowWithErrorCode(GetLastError())
End Sub
/*!
@brief	HRESULT値を基に例外を投げる。
@date	2008/07/13
@param[in] hr	HRESULT値
@throw WindowsException	FAILED(hr)が真の場合
@auther	Egtra
hrが成功値 (FAILED(hr) = False) の場合、この関数は何も行わない。
*/
Sub ThrowIfFailed(hr As HRESULT)
	If FAILED(hr) Then
		Throw New WindowsException(hr)
	End If
End Sub

End Namespace 'Widnows
End Namespace 'ActiveBasic