Commits

Max Bolingbroke  committed fd13a47

Attempt to fix lurking Unicode errors in Win32

  • Participants
  • Parent commits f34803f

Comments (0)

Files changed (5)

File Graphics/Win32/GDI/Bitmap.hsc

 
 createBMPFile :: String -> HBITMAP -> HDC -> IO ()
 createBMPFile name bm dc =
-  withCString name $ \ c_name ->
+  withCWString name $ \ c_name ->
   c_CreateBMPFile c_name bm dc
 foreign import ccall unsafe "dumpBMP.h CreateBMPFile"
-  c_CreateBMPFile :: LPCSTR -> HBITMAP -> HDC -> IO ()
+  c_CreateBMPFile :: LPCTSTR -> HBITMAP -> HDC -> IO ()
 
 {-# CFILES cbits/dumpBMP.c #-}
 

File System/Win32/DLL.hsc

 
 getProcAddress :: HMODULE -> String -> IO Addr
 getProcAddress hmod procname =
-  withCString procname $ \ c_procname ->
+  withCAString procname $ \ c_procname ->
   failIfNull "GetProcAddress" $ c_GetProcAddress hmod c_procname
 foreign import stdcall unsafe "windows.h GetProcAddress"
   c_GetProcAddress :: HMODULE -> LPCSTR -> IO Addr

File System/Win32/NLS.hsc

 stringToUnicode _cp "" = return ""
      -- MultiByteToWideChar doesn't handle empty strings (#1929)
 stringToUnicode cp mbstr =
-  withCStringLen mbstr $ \(cstr,len) -> do
+  withCAStringLen mbstr $ \(cstr,len) -> do
     wchars <- failIfZero "MultiByteToWideChar" $ multiByteToWideChar 
                 cp
                 0

File System/Win32/SimpleMAPI.hsc

                             , Ptr, castPtr, castPtrToFunPtr, nullPtr
                             , touchForeignPtr, alloca, peek, allocaBytes
                             , minusPtr, plusPtr, copyBytes, ForeignPtr )
-import Foreign.C            ( withCString, withCStringLen )
+import Foreign.C            ( withCAString, withCAStringLen )
+  -- Apparently, simple MAPI does not support unicode and probably never will,
+  -- so this module will just mangle any Unicode in your strings
 import Graphics.Win32.GDI.Types     ( HWND)
 import System.Win32.DLL     ( loadLibrary, c_GetProcAddress, freeLibrary
                             , c_FreeLibraryFinaliser )
     (loadProc "MAPISendMail"    dll mkMapiSendMail)
     where
        loadProc :: String -> HMODULE -> (FunPtr a -> a) -> IO a
-       loadProc name dll conv = withCString name $ \name' -> do
+       loadProc name dll conv = withCAString name $ \name' -> do
             proc <- failIfNull ("loadMapiDll: " ++ dllname ++ ": " ++ name)
                         $ c_GetProcAddress dll name'
             return $ conv $ castPtrToFunPtr proc
     -> MapiFlag     -- ^ None, one or many flags: FORCE_DOWNLOAD, NEW_SESSION, LOGON_UI, PASSWORD_UI
     -> IO LHANDLE
 mapiLogon f hwnd ses pw flags =
-    maybeWith withCString ses   $ \ses  ->
-    maybeWith withCString pw    $ \pw   ->
+    maybeWith withCAString ses  $ \ses  ->
+    maybeWith withCAString pw   $ \pw   ->
     alloca                      $ \out  -> do
         mapiFail_ "MAPILogon: " $ mapifLogon
             f (maybeHWND hwnd) 
             act buf
         resolve err rc = case rc of
             Recip name addr ->
-                withCString name $ \name ->
-                withCString addr $ \addr ->
+                withCAString name $ \name ->
+                withCAString addr $ \addr ->
                 allocaBytes (#size MapiRecipDesc) $ \buf -> do
                     (#poke MapiRecipDesc, ulReserved)   buf (0::ULONG)
                     (#poke MapiRecipDesc, lpszName)     buf name
                     a buf
             RecipResolve hwnd flag name fallback -> do
                 res <-  alloca          $ \res ->
-                        withCString name $ \name' -> do
+                        withCAString name $ \name' -> do
                             errn <- mapifResolveName
                                     f ses (maybeHWND hwnd) name' flag 0 res
                             if errn==(#const SUCCESS_SUCCESS)
     where
         w v a = case v of
             Nothing -> a (nullPtr, 0)
-            Just x  -> withCStringLen x a
+            Just x  -> withCAStringLen x a
 
 data Attachment = Attachment
     { attFlag       :: MapiFlag
         len = length att
         write act _ [] = act
         write act buf (att:y) =
-            withCString (attPath att) $ \path ->
+            withCAString (attPath att) $ \path ->
             maybeWith withFileTag (attTag att) $ \tag ->
-            withCString (maybe (attPath att) id (attName att)) $ \name -> do
+            withCAString (maybe (attPath att) id (attName att)) $ \name -> do
                 (#poke MapiFileDesc, ulReserved)    buf (0::ULONG)
                 (#poke MapiFileDesc, flFlags)       buf (attFlag att)
                 (#poke MapiFileDesc, nPosition)     buf (maybe 0xffffffff id $ attPosition att)
     -> (Ptr Message -> IO a)
     -> IO a
 withMessage f ses m act =
-    withCString (msgSubject m)              $ \subject ->
-    withCString (msgBody m)                 $ \body ->
-    maybeWith withCString (msgType m)       $ \message_type ->
-    maybeWith withCString (msgDate m)       $ \date ->
-    maybeWith withCString (msgConversationId m) $ \conv_id ->
+    withCAString (msgSubject m)             $ \subject ->
+    withCAString (msgBody m)                $ \body ->
+    maybeWith withCAString (msgType m)      $ \message_type ->
+    maybeWith withCAString (msgDate m)      $ \date ->
+    maybeWith withCAString (msgConversationId m) $ \conv_id ->
     withRecipients f ses (msgRecips m)          $ \rlen rbuf ->
     withAttachments (msgAttachments m)      $ \alen abuf ->
     maybeWith (withRecipient f ses RcOriginal) (msgFrom m) $ \from ->

File cbits/dumpBMP.c

 
 //typedef LPBITMAPINFO PBITMAPINFO; // hack to keep cygwin32b17 happy
 
-void CreateBMPFile(LPCSTR pszFileName, HBITMAP hBmp, HDC hDC)
+void CreateBMPFile(LPCTSTR pszFileName, HBITMAP hBmp, HDC hDC)
 {
     int         hFile;
-    OFSTRUCT    ofReOpenBuff;
     HBITMAP     hTmpBmp, hBmpOld;
     BOOL        bSuccess;
     BITMAPFILEHEADER    bfh;
     //
     // Lets open the file and get ready for writing
     //
-    if ((hFile = OpenFile(pszFileName, (LPOFSTRUCT)&ofReOpenBuff,
-                 OF_CREATE | OF_WRITE)) == -1) {
+    if ((hFile = CreateFileW(pszFileName, GENERIC_WRITE, FILE_SHARE_READ, NULL, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL))
+          == INVALID_HANDLE_VALUE) {
         fprintf(stderr, "Failed in OpenFile!");
         goto ErrExit2;
     }