Browse Source

Fix dde string parsing

master
Denis Tereshkin 7 years ago
parent
commit
3aaaf5d60b
  1. 2
      quik-connector.cabal
  2. 14
      src/System/Win32/DDE.hs
  3. 10
      src/System/Win32/XlParser.hs

2
quik-connector.cabal

@ -49,7 +49,7 @@ library
, aeson , aeson
, cond , cond
, scientific , scientific
, libatrade == 0.8.0.0 , libatrade >= 0.8 && < 0.9
, deepseq , deepseq
, errors , errors
, split , split

14
src/System/Win32/DDE.hs

@ -40,6 +40,7 @@ import Foreign
import Foreign.C.Types import Foreign.C.Types
import Foreign.C.String import Foreign.C.String
import Foreign.Marshal.Array import Foreign.Marshal.Array
import System.Log.Logger (debugM, warningM)
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
@ -121,11 +122,14 @@ ddeCallback state msgType format hConv hsz1 hsz2 hData dwData1 dwData2
handleConnect state hsz1 hsz2 = do handleConnect state hsz1 hsz2 = do
myDdeState <- readIORef state myDdeState <- readIORef state
maybeAppName <- queryString myDdeState 256 hsz2 maybeAppName <- queryString myDdeState 256 hsz2
debugM "DDE" $ "Handle connect:" ++ show maybeAppName
case maybeAppName of case maybeAppName of
Just incomingAppName -> do Just incomingAppName -> do
return $ if incomingAppName == appName myDdeState if incomingAppName == appName myDdeState
then ddeResultTrue then do
else ddeResultFalse return ddeResultTrue
else do
return ddeResultFalse
Nothing -> return ddeResultFalse Nothing -> return ddeResultFalse
handlePoke state hsz1 hData = do handlePoke state hsz1 hData = do
@ -135,7 +139,9 @@ ddeCallback state msgType format hConv hsz1 hsz2 hData dwData1 dwData2
Nothing -> return ddeResultFalse Nothing -> return ddeResultFalse
Just topic -> withDdeData hData (\xlData -> do Just topic -> withDdeData hData (\xlData -> do
case runGetOrFail xlParser $ BL.fromStrict xlData of case runGetOrFail xlParser $ BL.fromStrict xlData of
Left (_, _, errmsg) -> return ddeResultFalse Left (_, _, errmsg) -> do
warningM "DDE" $ "Parsing error: " ++ show errmsg
return ddeResultFalse
Right (_, _, table) -> do Right (_, _, table) -> do
rc <- (dataCallback myDdeState) topic table rc <- (dataCallback myDdeState) topic table
return $ if rc return $ if rc

10
src/System/Win32/XlParser.hs

@ -4,15 +4,17 @@ module System.Win32.XlParser (
xlParser xlParser
) where ) where
import Codec.Text.IConv
import Control.Applicative import Control.Applicative
import Control.Monad import Control.Monad
import Data.Binary.Get import Data.Binary.Get
import Data.Binary.IEEE754 import Data.Binary.IEEE754
import Data.ByteString hiding (concat, unpack) import Data.ByteString hiding (concat, unpack)
import qualified Data.ByteString.Lazy as BL
import Data.List as L import Data.List as L
import Data.Word
import Data.Text as T hiding (concat) import Data.Text as T hiding (concat)
import Data.Text.Encoding import Data.Text.Encoding
import Data.Word
data XlData = XlInt Int | XlDouble Double | XlString String | XlEmpty data XlData = XlInt Int | XlDouble Double | XlString String | XlEmpty
deriving (Eq, Show) deriving (Eq, Show)
@ -73,7 +75,11 @@ xlParser = do
parseStrings blocksize = do parseStrings blocksize = do
length <- fromEnum <$> getWord8 length <- fromEnum <$> getWord8
s <- unpack . decodeUtf8 <$> getByteString length s <- convert "CP1251" "UTF-8" . BL.fromStrict <$> getByteString length
case decodeUtf8' (BL.toStrict s) of
Left err -> fail $ "Can't parse utf8: " ++ show err
Right bs -> do
let s = unpack bs
if length + 1 >= blocksize if length + 1 >= blocksize
then return [XlString s] then return [XlString s]
else do else do

Loading…
Cancel
Save