Win32 2.2.0.2 → 2.2.1.0
raw patch · 15 files changed
+57/−40 lines, 15 files
Files
- Graphics/Win32/Control.hsc +2/−1
- Graphics/Win32/GDI/Bitmap.hsc +2/−2
- Graphics/Win32/Window.hsc +2/−1
- System/Win32/DLL.hsc +1/−1
- System/Win32/FileMapping.hsc +2/−2
- System/Win32/Info.hsc +3/−1
- System/Win32/NLS.hsc +1/−1
- System/Win32/Process.hsc +6/−0
- System/Win32/Registry.hsc +2/−1
- System/Win32/SimpleMAPI.hsc +18/−15
- System/Win32/Time.hsc +1/−1
- System/Win32/Types.hs +2/−1
- Win32.cabal +5/−3
- cbits/dumpBMP.c +9/−9
- include/dumpBMP.h +1/−1
Graphics/Win32/Control.hsc view
@@ -19,7 +19,8 @@ import System.Win32.Types import Graphics.Win32.Message -import Foreign+import Foreign hiding (unsafePerformIO)+import System.IO.Unsafe #include <windows.h> #include <commctrl.h>
Graphics/Win32/GDI/Bitmap.hsc view
@@ -376,10 +376,10 @@ 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 #-}
Graphics/Win32/Window.hsc view
@@ -20,7 +20,8 @@ import Control.Monad import Data.Maybe-import Foreign+import Foreign hiding (unsafePerformIO)+import System.IO.Unsafe #include <windows.h>
System/Win32/DLL.hsc view
@@ -54,7 +54,7 @@ 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/FileMapping.hsc view
@@ -20,7 +20,7 @@ import System.Win32.File import System.Win32.Info -import Control.Exception ( block, bracket )+import Control.Exception ( mask_, bracket ) import Data.ByteString ( ByteString ) import Data.ByteString.Internal ( fromForeignPtr ) import Foreign ( Ptr, nullPtr, plusPtr, maybeWith, FunPtr@@ -44,7 +44,7 @@ (closeHandle) $ \fm -> do fi <- getFileInformationByHandle fh- fp <- block $ do+ fp <- mask_ $ do ptr <- mapViewOfFile fm fILE_MAP_READ 0 0 newForeignPtr c_UnmapViewOfFileFinaliser ptr return (fp, fromIntegral $ bhfiSize fi)
System/Win32/Info.hsc view
@@ -16,7 +16,9 @@ import System.Win32.Types -import System.IO.Error hiding (try)+import Prelude hiding (catch)+import Control.Exception (catch)+import System.IO.Error hiding (catch, try) import Foreign ( Storable(sizeOf, alignment, peekByteOff, pokeByteOff, peek, poke) , Ptr, alloca, allocaArray )
System/Win32/NLS.hsc view
@@ -350,7 +350,7 @@ 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/Process.hsc view
@@ -56,6 +56,12 @@ openProcess :: ProcessAccessRights -> BOOL -> ProcessId -> IO ProcessHandle openProcess r inh i = failIfNull "OpenProcess" $ c_OpenProcess r inh i +foreign import stdcall unsafe "windows.h GetProcessId"+ c_GetProcessId :: ProcessHandle -> IO ProcessId++getProcessId :: ProcessHandle -> IO ProcessId+getProcessId h = failIfZero "GetProcessId" $ c_GetProcessId h+ type Th32SnapHandle = HANDLE type Th32SnapFlags = DWORD -- | ProcessId, number of threads, parent ProcessId, process base priority, path of executable file
System/Win32/Registry.hsc view
@@ -61,7 +61,8 @@ import System.Win32.Types import System.Win32.File -import Foreign+import System.IO.Unsafe+import Foreign hiding (unsafePerformIO) #include <windows.h>
System/Win32/SimpleMAPI.hsc view
@@ -20,7 +20,9 @@ , 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 )@@ -140,7 +142,8 @@ (loadProc "MAPIFreeBuffer" dll mkMapiFreeBuffer) (loadProc "MAPISendMail" dll mkMapiSendMail) where- loadProc name dll conv = withCString name $ \name' -> do+ loadProc :: String -> HMODULE -> (FunPtr a -> a) -> IO a+ loadProc name dll conv = withCAString name $ \name' -> do proc <- failIfNull ("loadMapiDll: " ++ dllname ++ ": " ++ name) $ c_GetProcAddress dll name' return $ conv $ castPtrToFunPtr proc@@ -189,8 +192,8 @@ -> 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) @@ -241,8 +244,8 @@ 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@@ -252,7 +255,7 @@ 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)@@ -309,7 +312,7 @@ 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@@ -329,9 +332,9 @@ 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)@@ -362,11 +365,11 @@ -> (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 ->
System/Win32/Time.hsc view
@@ -300,5 +300,5 @@ size <- c_GetTimeFormat locale flags st fmt nullPtr 0 allocaBytes ((fromIntegral size) * (sizeOf (undefined::CWchar))) $ \out -> do size <- failIf (==0) "getTimeFormat: GetTimeFormat" $- c_GetTimeFormat locale flags st fmt (castPtr out) (fromIntegral size)+ c_GetTimeFormat locale flags st fmt (castPtr out) size peekTStringLen (out,fromIntegral size)
System/Win32/Types.hs view
@@ -18,10 +18,11 @@ ) where import Data.Maybe-import Foreign+import Foreign hiding (unsafePerformIO) import Foreign.C import Control.Exception import System.IO.Error+import System.IO.Unsafe import Data.Char import Numeric (showHex)
Win32.cabal view
@@ -1,5 +1,5 @@ name: Win32-version: 2.2.0.2+version: 2.2.1.0 license: BSD3 license-file: LICENSE author: Alastair Reid@@ -58,6 +58,8 @@ System.Win32.Types System.Win32.Shell extensions: ForeignFunctionInterface+ if impl(ghc >= 7.1)+ extensions: NondecreasingIndentation extra-libraries: "user32", "gdi32", "winmm", "advapi32", "shell32", "shfolder" include-dirs: include@@ -73,6 +75,6 @@ cbits/errors.c source-repository head- type: darcs- location: http://darcs.haskell.org/packages/Win32/+ type: git+ location: http://darcs.haskell.org/packages/Win32.git/
cbits/dumpBMP.c view
@@ -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 @@ BITMAPINFO bmi; PBYTE pjTmp, pjTmpBmi; ULONG sizBMI;+ DWORD dwBytesWritten; bSuccess = TRUE;@@ -132,8 +132,8 @@ // // 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 @@ // // 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 @@ // // 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 @@ // // 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 @@ SelectObject(hDC, hBmpOld); DeleteObject(hTmpBmp); ErrExit3:- _lclose(hFile);+ CloseHandle(hFile); ErrExit2: GlobalFree(pbmi); ErrExit1:
include/dumpBMP.h view
@@ -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);