Use Unicode API for CreateBMPFile, use *CAString where appropriate

Author: batterseapower

Graphics/Win32/GDI/Bitmap.hsc

@@ -376,10 +376,10 @@ sizeofLPBITMAPFILEHEADER = #{size BITMAPFILEHEADER}
 
 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 #-}
 

System/Win32/DLL.hsc

@@ -54,7 +54,7 @@ foreign import stdcall unsafe "windows.h GetModuleHandleW"
 
 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

System/Win32/NLS.hsc

@@ -350,7 +350,7 @@ stringToUnicode :: CodePage -> String -> IO String
 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

System/Win32/SimpleMAPI.hsc

@@ -20,7 +20,9 @@ import Foreign              ( FunPtr, newForeignPtr, pokeByteOff, maybeWith
                             , 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 )
@@ -141,7 +143,7 @@ loadMapiFuncs dllname dll =  liftM5 MapiFuncs
     (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
@@ -190,8 +192,8 @@ mapiLogon
     -> 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) 
@@ -242,8 +244,8 @@ withRecipient f ses rcls rec act = resolve "" rec
             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
@@ -253,7 +255,7 @@ withRecipient f ses rcls rec act = resolve "" rec
                     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)
@@ -310,7 +312,7 @@ withFileTag ft act =
     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
@@ -330,9 +332,9 @@ withAttachments att act = allocaBytes (len*as) $ \buf -> write (act len buf) buf
         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)
@@ -363,11 +365,11 @@ withMessage
     -> (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 ->

cbits/dumpBMP.c

@@ -34,10 +34,9 @@
 
 //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;
+    HANDLE      hFile;
     HBITMAP     hTmpBmp, hBmpOld;
     BOOL        bSuccess;
     BITMAPFILEHEADER    bfh;
@@ -46,6 +45,7 @@ void CreateBMPFile(LPCSTR pszFileName, HBITMAP hBmp, HDC hDC)
     BITMAPINFO  bmi;
     PBYTE pjTmp, pjTmpBmi;
     ULONG sizBMI;
+	DWORD 		dwBytesWritten;
 
 
     bSuccess = TRUE;
@@ -132,8 +132,8 @@ void CreateBMPFile(LPCSTR pszFileName, HBITMAP hBmp, HDC hDC)
     //
     // 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;
     }
@@ -151,7 +151,7 @@ void CreateBMPFile(LPCSTR pszFileName, HBITMAP hBmp, HDC hDC)
     //
     // Write out the file header now
     //
-    if (_lwrite(hFile, (LPSTR)&bfh, sizeof(BITMAPFILEHEADER)) == -1) {
+    if (WriteFile(hFile, (LPCVOID)&bfh, sizeof(BITMAPFILEHEADER), &dwBytesWritten, NULL) == -1) {
         fprintf(stderr, "Failed in WriteFile!");
         bSuccess = FALSE;
         goto ErrExit3;
@@ -179,7 +179,7 @@ void CreateBMPFile(LPCSTR pszFileName, HBITMAP hBmp, HDC hDC)
     //
     // Now write out the BitmapInfoHeader and color table, if any
     //
-    if (_lwrite(hFile, (LPSTR)pbmi, sizBMI) == -1) {
+    if (WriteFile(hFile, (LPCVOID)pbmi, sizBMI, &dwBytesWritten, NULL) == -1) {
         fprintf(stderr, "Failed in WriteFile!");
         bSuccess = FALSE;
         goto ErrExit4;
@@ -188,7 +188,7 @@ void CreateBMPFile(LPCSTR pszFileName, HBITMAP hBmp, HDC hDC)
     //
     // write the bits also
     //
-    if (_lwrite(hFile, (LPSTR)pBits, pbmi->bmiHeader.biSizeImage) == -1) {
+    if (WriteFile(hFile, (LPCVOID)pBits, pbmi->bmiHeader.biSizeImage, &dwBytesWritten, NULL) == -1) {
         fprintf(stderr, "Failed in WriteFile!");
         bSuccess = FALSE;
         goto ErrExit4;
@@ -199,7 +199,7 @@ void CreateBMPFile(LPCSTR pszFileName, HBITMAP hBmp, HDC hDC)
     SelectObject(hDC, hBmpOld);
     DeleteObject(hTmpBmp);
 ErrExit3:
-    _lclose(hFile);
+    CloseHandle(hFile);
 ErrExit2:
     GlobalFree(pbmi);
 ErrExit1:

include/dumpBMP.h

@@ -3,4 +3,4 @@
 /* There's currently no #define that indicate whether we're
    compiling a .hc file. */
 
-extern void CreateBMPFile(LPCSTR pszFileName, HBITMAP hBmp, HDC hDC);
+extern void CreateBMPFile(LPCTSTR pszFileName, HBITMAP hBmp, HDC hDC);