消息框错误:国外导入不安全 [英] Message Box Error : foreign import unsafe

问题描述

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行)，但有错误:

Here is simple win32 gui application with a button but when I click the button there must be a message box (22 line) but there is error :

buttons.exe:日程安排:不安全地重新输入.也许是外国人" 进口不安全"应该是安全"?

buttons.exe: schedule: re-entered unsafely. Perhaps a 'foreign import unsafe' should be 'safe'?

我该如何解决?

推荐答案

就像Daniel Wagner所说，这是Win32软件包中的错误.由于MessageBoxW有很多副作用，因此必须安全地导入.

Like Daniel Wagner commented, this is a bug in the Win32 package. MessageBoxW must be imported safely, because of the many side-effects it has.

messageBox函数是不安全"导入的MessageBoxW函数的包装.当不安全地导入不安全导入的函数时，Haskell会假定线程在返回之前不会调用任何Haskell代码.但是，如果调用MessageBoxW，Windows将向第30行中创建的窗口抛出很多窗口消息，因此当您使用不安全的外部函数时，将运行Haskell代码.这也是对messageBox的调用在创建该窗口之前 起作用的原因.

The messageBox function is a wrapper for the 'unsafely' imported MessageBoxW function. When an unsafely imported function function is unsafely imported, Haskell assumes that the thread will not call any Haskell code until it returns. However, if you call MessageBoxW, Windows will throw quite a few window messages to the window you created in line 30, so Haskell code will be ran while you're in an unsafe foreign function. This is also the reason why calls to messageBox will work until that window has been created.

一个可能的解决方法是直接自己纠正该功能.首先，改变

A possible workaround is to simply correct the function yourself. First, change

import Graphics.Win32

到

import Graphics.Win32 hiding (messageBox, c_MessageBox)

然后，从模块Graphics.Win32.Misc中复制messageBox和c_MessageBox的定义，并删除unsafe和/或添加safe:

Then, copy the definitions of messageBox and c_MessageBox from the module Graphics.Win32.Misc, with unsafe removed and/or safe added:

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

这篇关于消息框错误:国外导入不安全的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！