source: trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/Windows.ab

'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