Ошибка в окне сообщения: иностранный импорт небезопасен - PullRequest
4 голосов
/ 05 сентября 2011
import Graphics.Win32
import System.Win32.DLL
import Control.Exception (bracket)
import Foreign
import System.Exit
main :: IO ()
main = do
    mainInstance <- getModuleHandle Nothing
    hwnd <- createWindow_ 200 200 wndProc mainInstance
    createButton_ hwnd mainInstance
    messagePump hwnd
wndProc :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT
wndProc hwnd wmsg wParam lParam
    | wmsg == wM_DESTROY = do
        sendMessage hwnd wM_QUIT 1 0
        return 0
    | wmsg == wM_COMMAND && wParam == 1 = do
        messageBox nullPtr "Yahoo!!" "Message box" 0 -- Error! Why? :(
        return 0
    | otherwise = defWindowProc (Just hwnd) wmsg wParam lParam
createWindow_ :: Int -> Int -> WindowClosure -> HINSTANCE -> IO HWND
createWindow_ width height wndProc mainInstance = do
    let winClass = mkClassName "ButtonExampleWindow"
    icon <- loadIcon Nothing iDI_APPLICATION
    cursor <- loadCursor Nothing iDC_ARROW
    bgBrush <- createSolidBrush (rgb 240 240 240)
    registerClass (cS_VREDRAW + cS_HREDRAW, mainInstance, Just icon, Just cursor, Just bgBrush, Nothing, winClass)
    w <- createWindow winClass "Button example" wS_OVERLAPPEDWINDOW Nothing Nothing (Just width) (Just height) Nothing Nothing mainInstance wndProc
    showWindow w sW_SHOWNORMAL
    updateWindow w
    return w
createButton_ :: HWND -> HINSTANCE -> IO ()
createButton_ hwnd mainInstance = do
    hBtn <- createButton "Press me" wS_EX_CLIENTEDGE (bS_PUSHBUTTON + wS_VISIBLE + wS_CHILD) (Just 50) (Just 80) (Just 80) (Just 20) (Just hwnd) (Just (castUINTToPtr 1)) mainInstance
    return ()
messagePump :: HWND -> IO ()
messagePump hwnd = allocaMessage $ \ msg ->
    let pump = do
        getMessage msg (Just hwnd) `catch` \ _ -> exitWith ExitSuccess
        translateMessage msg
        dispatchMessage msg
        pump
    in pump

Вот простое приложение Win32 GUI с кнопкой, но когда я нажимаю кнопку, должно быть окно сообщения (22 строки), но есть ошибка:

buttons.exe: расписание: повторно вошел небезопасно.Возможно, «иностранный импорт небезопасен» должен быть «безопасным»?

Как я могу это исправить?

1 Ответ

4 голосов
/ 09 сентября 2011

Как прокомментировал Дэниел Вагнер, это ошибка в пакете Win32.MessageBoxW необходимо безопасно импортировать из-за множества побочных эффектов.

Функция messageBox является оберткой для импортируемой функции «небезопасно» MessageBoxW.Когда небезопасно импортированная функция функции импортируется небезопасно, Haskell предполагает, что поток не будет вызывать какой-либо код Haskell, пока не вернется.Однако, если вы вызовете MessageBoxW, Windows выдаст довольно много оконных сообщений в окно, которое вы создали в строке 30, поэтому код на Haskell будет выполняться, пока вы находитесь в небезопасной внешней функции.Это также причина, по которой вызовы messageBox будут работать до тех пор, пока это окно не будет создано.

Возможный обходной путь - просто исправить функцию самостоятельно.Сначала измените

import Graphics.Win32

на

import Graphics.Win32 hiding (messageBox, c_MessageBox)

Затем скопируйте определения messageBox и c_MessageBox из модуля Graphics.Win32.Misc, удалив unsafe и / илиsafe добавлено:

messageBox :: HWND -> String -> String -> MBStyle -> IO MBStatus
messageBox wnd text caption style =
  withTString text $ \ c_text ->
  withTString caption $ \ c_caption ->
  failIfZero "MessageBox" $ c_MessageBox wnd c_text c_caption style
foreign import stdcall safe "windows.h MessageBoxW"
  c_MessageBox :: HWND -> LPCTSTR -> LPCTSTR -> MBStyle -> IO MBStatus
...