'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

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

/*!
@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
End Class

/*!
@brief	Windowsのエラー値を基に例外を投げる
@param[in] dwErrorCode	Win32エラーコード
@param[in] msg	補足説明
@throw WindowsException	常に投げられる。
@date 2008/07/13
@auther Egtra
*/
Sub ThrowWithErrorCode(dwErrorCode As DWord, msg = Nothing As String)
	Throw New WindowsException(HRESULT_FROM_WIN32(dwErrorCode), msg)
End Sub
/*!
@brief WindowsExceptionを投げるラッパ。直前に呼び出したAPI関数などが失敗したときに用いる。
@param[in] msg 補足説明
@throw WindowsException 常に投げられる。
@date 2008/08/20
@auther Egtra
WindowsExceptionを構築する際、GetLastError()の値を渡す。
この関数では、直前のAPI関数が成功したかどうかを調べられないことに注意。
*/
Sub ThrowWithLastError(msg = Nothing As String)
	ThrowWithErrorCode(GetLastError(), msg)
End Sub
/*!
@brief （主にuser32の全部、gdi32の一部が対象）WindowsExceptionを投げるラッパ。直前に呼び出したAPI関数などが失敗したときに用いる。
@param[in] msg 補足説明
@throw WindowsException 常に投げられる。
@date 2008/08/26
@auther Egtra
user32やgdi32の一部など、9xではGetLastErrorでエラーメッセージが取得できないものがある。
そのため、9xでは一律にmsgのみでWindowsExceptionを構築して投げるようにしている。

ところで、CEではNT同様GetLastErrorが使用できるため、
CEへの移植を仮定すると、関数名にNTと付けるのがそぐわないと感じる。代案募集中。
*/
Sub ThrowWithLastErrorNT(msg As String)
	If Not Version.Is9x() Then
		ThrowWithErrorCode(GetLastError(), msg)
	Else
		Throw New WindowsException(msg)
	End If
End Sub
/*!
@brief	HRESULT値を基に例外を投げる。
@param[in] hr HRESULT値
@param[in] msg 補足説明
@throw WindowsException	FAILED(hr)が真の場合
@date 2008/07/13
@auther Egtra
hrが成功値 (FAILED(hr) = False) の場合、この関数は何も行わない。
*/
Sub ThrowIfFailed(hr As HRESULT, msg = Nothing As String)
	If FAILED(hr) Then
		Throw New WindowsException(hr, msg)
	End If
End Sub

End Namespace 'Widnows
End Namespace 'ActiveBasic