このプログラムは"日本語.xls"のファイルを読み書きするものです。
- 文字列は newCWString でワイド文字列に変換します。
- さらに C++ で wxString に変換しています。
- 今回サポートしているVariant型は文字列、LongのVariant型です。
{-# LANGUAGE ForeignFunctionInterface #-} module Main where import Foreign.Ptr (Ptr) import Foreign.C.String (CWString, CString ,newCWString, peekCWString, newCString) import Foreign.C.Types (CInt, CLong, CClock, CTime, CFloat ,CDouble) import Foreign.Marshal.Alloc (free) import Cinnamon.Ucs (ucs4ToSjis, sjisToUcs4, ucs4ToUtf8, utf8ToUcs4) import Debug.Trace data WxAutomation = WxAutomation data WxVariant = WxVariant data WxString = WxString type VariantArray = Ptr WxVariant type Variant = Ptr WxVariant type AutomationObj = Ptr WxAutomation type WxStringObj = Ptr WxString -- type bool, wxChar, double, long, string, string list, time, date, -- void pointer, list of strings, and list of variants. data VariantData = VLong CLong | VString String | VClock CClock | VTime CTime | VFloat CFloat | VDouble CDouble | VwithName (VariantData, String) | VariantList [VariantData] deriving (Show) main :: IO () main = do c_OleInitialize 0 fPathName <- getFullPathName "日本語.xls" exl <- createInstance "Excel.Application" putStrLn =<< variantToString =<< wxGetProperty exl "Version" -- => 9.0 workbooks <- wxGetObject exl "Workbooks" callMethodArgs workbooks "Open" [VwithName (VString fPathName, "Filename")] activeWbook <- wxGetObject exl "ActiveWorkbook" workSheets <- wxGetObject activeWbook "Worksheets" sheet <- getObjectArgs workSheets "Item" [VLong 2] -- 2 番目の sheet cell <- getObjectArgs sheet "Cells" [VLong 1, VLong 2] -- 1 行、２列目の cell print =<< automationIsValid cell -- => True putProperty cell "Value" (VString "謹賀新年") -- read value <- wxGetProperty cell "Value" putStrLn =<< showVariant "sheet 2 : cel 1 2 :" value putStrLn =<< wxVariantGetType value -- => string outJP <- variantToString value putStrLn (ucs4ToSjis outJP) -- => 謹賀新年 -- 空白cell cell <- getObjectArgs sheet "Cells" [VLong 1, VLong 3] -- 1 行、3列目の cell putStrLn =<< wxVariantGetType =<< wxGetProperty cell "Value" -- => null mapM_ (\(x,y) -> wxCallMethodNonArg x y) [(activeWbook, "Save"),(workbooks , "Close"), (exl, "Quit")] mapM_ c_destroyWxAutomation [activeWbook, workbooks, exl] c_OleUninitialize -- Variant 型には名前がついていて省略されると "" が設定される。 toVariantDT :: VariantData -> IO Variant toVariantDT (VLong value) = return =<< toVariantLong (VwithName (VLong value, "")) toVariantDT (VwithName (VLong value, name)) = return =<< toVariantLong (VwithName (VLong value, name)) toVariantDT (VString value) = return =<< toVariantWxString (VwithName (VString value, "")) toVariantDT (VwithName (VString value, name)) = return =<< toVariantWxString (VwithName (VString value, name)) toVariantLong :: VariantData -> IO Variant toVariantLong (VwithName (VLong value, name)) = do wxName <- stringToWxString name variant <- c_createLongVariant value wxName c_destroyWxString wxName return variant toVariantWxString :: VariantData -> IO Variant toVariantWxString (VwithName (VString value, name)) = do wxValue <- stringToWxString value wxName <- stringToWxString name variant <- c_createWxStringVariant wxValue wxName mapM_ c_destroyWxString [wxValue,wxName] return variant setWxVariantArray :: [Variant] -> IO VariantArray setWxVariantArray variant = do vArray <- c_createWxVariantArray vArraySize return =<< setWxVariantArray' vArray 0 variant where vArraySize = fromIntegral $ length variant setWxVariantArray' :: VariantArray -> CInt -> [Variant] -> IO VariantArray setWxVariantArray' vArray _ [] = return vArray setWxVariantArray' vArray n (x:xs) = do retVarray <- c_setWxVariantArray vArray n x setWxVariantArray' retVarray (n+1) xs showVariant :: String -> Variant -> IO String showVariant memo variant = do vType <- wxVariantGetType variant case vType of "string" -> do name <- wxVariantGetName variant value <- variantToString variant return $ render "string" name value memo "long" -> do name <- wxVariantGetName variant value <- c_wxVariantGetLong variant return $ render "long" name (show value) memo _ -> do return "other" where render vType name value memo = concat ["Variant :<",vType,"> name:<", name, "> value:<",(ucs4ToSjis value),"> memo:<",memo,">"] vDataToVarray :: [VariantData] -> IO VariantArray vDataToVarray vData = do vArray <- c_createWxVariantArray vDataSize return =<< vDataToVarray' vArray 0 vData where vDataSize = fromIntegral $ length vData vDataToVarray' :: VariantArray -> CInt -> [VariantData] -> IO VariantArray vDataToVarray' vArray _ [] = return vArray vDataToVarray' vArray n (x:xs) = do variant <- toVariantDT x newVarray <- c_setWxVariantArray vArray n variant vDataToVarray' newVarray (n+1) xs -- Variant wxVariantIsNull :: Variant -> IO Bool wxVariantIsNull variant = do ret <- c_wxVariantIsNull variant return $ fromCInt ret wxVariantGetName :: Variant -> IO String wxVariantGetName variant = wxVariantAsk variant c_wxVariantGetName wxVariantGetType :: Variant -> IO String wxVariantGetType variant = wxVariantAsk variant c_wxVariantGetType -- Variant 型から情報を取得する関数を引数とする。 wxVariantAsk :: Variant -> (WxStringObj -> IO WxStringObj) -> IO String wxVariantAsk variant func = do wxStr <- func variant string <- wxStringToString wxStr c_destroyWxString wxStr return string getFullPathName :: String -> IO String getFullPathName fileName = do obj <- createInstance "Scripting.FileSystemObject" variant <- wxCallMethod obj "GetAbsolutePathName" fileName wxStr <- c_wxVariantGetString variant string <- wxStringToString wxStr c_destroyWxAutomation obj c_destroyWxVariant variant c_destroyWxString wxStr return string -- String variantToString :: Variant -> IO String variantToString variant = peekCWString =<< variantToCWString variant variantToCWString :: Variant -> IO CWString variantToCWString variant = do wxStr <- c_wxVariantGetString variant cwstring <- c_wxStringToCWString wxStr c_destroyWxString wxStr return cwstring wxStringToString :: WxStringObj -> IO String wxStringToString wxString = peekCWString =<< c_wxStringToCWString wxString stringToWxString :: String -> IO WxStringObj stringToWxString string = do cwstring <- newCWString string outWxString <- c_createWxString cwstring free cwstring return outWxString -- ----------------- createInstance :: String -> IO AutomationObj createInstance objName = do wxObjName <- stringToWxString objName fileObj <- c_wxCreateInstance wxObjName c_destroyWxString wxObjName return fileObj callMethodArgs :: AutomationObj -> String -> [VariantData] -> IO () callMethodArgs obj method vData = do varray <- vDataToVarray vData wxMethod <- stringToWxString method c_wxCallMethodArgs obj wxMethod vCount varray c_destroyWxString wxMethod where vCount = fromIntegral $ length vData wxCallMethod :: AutomationObj -> String -> String -> IO Variant wxCallMethod auto methodName arg = do wxMethodName <- stringToWxString methodName wxArg <- stringToWxString arg variant <- c_wxCallMethod auto wxMethodName wxArg mapM_ c_destroyWxString [wxMethodName, wxArg] return variant wxCallMethodNonArg :: AutomationObj -> String -> IO Variant wxCallMethodNonArg auto methodName = do wxMethodName <- stringToWxString methodName variant <- c_wxCallMethodNonArg auto wxMethodName c_destroyWxString wxMethodName return variant wxGetProperty :: AutomationObj -> String -> IO Variant wxGetProperty auto propertyName = do wxPropertyName <- stringToWxString propertyName variant <- c_wxGetProperty auto wxPropertyName c_destroyWxString wxPropertyName return variant putProperty :: AutomationObj -> String -> VariantData -> IO Bool putProperty auto propertyName vdata = wxPutProperty auto propertyName =<< toVariantDT vdata wxPutProperty :: AutomationObj -> String -> Variant -> IO Bool wxPutProperty auto propertyName variant = do wxPropertyName <- stringToWxString propertyName ret <- c_wxPutProperty auto wxPropertyName variant c_destroyWxString wxPropertyName return $ fromCInt ret wxGetObject :: AutomationObj -> String -> IO AutomationObj wxGetObject auto objectName = do wxObjectName <- stringToWxString objectName automation <- c_wxGetObject auto wxObjectName c_destroyWxString wxObjectName return automation getObjectArgs :: AutomationObj -> String -> [VariantData] -> IO AutomationObj getObjectArgs auto objectName vData = wxGetObjectArgs auto objectName vCount =<< vDataToVarray vData where vCount = fromIntegral $ length vData wxGetObjectArgs :: AutomationObj -> String -> CInt -> Variant -> IO AutomationObj wxGetObjectArgs auto objectName numOfArgs args = do wxObjectName <- stringToWxString objectName automation <- c_wxGetObjectArgs auto wxObjectName numOfArgs args c_destroyWxString wxObjectName return automation automationIsValid :: AutomationObj -> IO Bool automationIsValid auto = do ret <- c_wxAutomationPtrIsNotNULL auto return $ fromCInt ret fromCInt :: CInt -> Bool fromCInt x = case fromIntegral x of 0 -> False _ -> True -- wxString ------------------ foreign import ccall "createWxString" c_createWxString :: CWString -> IO WxStringObj foreign import ccall "destroyWxString" c_destroyWxString :: WxStringObj -> IO() foreign import ccall "wxStringToCWString" c_wxStringToCWString :: WxStringObj -> IO CWString -- ---------- wxAutomationObject ----------------- foreign import ccall "wxCreateInstance" c_wxCreateInstance :: WxStringObj -> IO AutomationObj foreign import ccall "destroyWxAutomation" c_destroyWxAutomation :: AutomationObj -> IO () foreign import ccall "wxAutomationPtrIsNotNULL" c_wxAutomationPtrIsNotNULL :: AutomationObj -> IO CInt foreign import ccall "wxCallMethodNonArg" c_wxCallMethodNonArg :: AutomationObj -> WxStringObj ->IO Variant foreign import ccall "wxCallMethod" c_wxCallMethod :: AutomationObj -> WxStringObj -> WxStringObj -> IO Variant foreign import ccall "wxCallMethodArgs" c_wxCallMethodArgs :: AutomationObj -> WxStringObj -> CInt -> Variant->IO() foreign import ccall "wxGetProperty" c_wxGetProperty :: AutomationObj -> WxStringObj -> IO Variant foreign import ccall "wxPutProperty" c_wxPutProperty :: AutomationObj -> WxStringObj -> Variant -> IO CInt foreign import ccall "wxGetObject" c_wxGetObject :: AutomationObj -> WxStringObj -> IO AutomationObj foreign import ccall "wxGetObjectArgs" c_wxGetObjectArgs :: AutomationObj -> WxStringObj -> CInt -> Variant -> IO AutomationObj ---------------- Variant ------------------ foreign import ccall "destroyWxVariant" c_destroyWxVariant :: Variant -> IO() foreign import ccall "createLongVariant" c_createLongVariant :: CLong -> WxStringObj -> IO Variant foreign import ccall "createWxStringVariant" c_createWxStringVariant :: WxStringObj -> WxStringObj -> IO Variant foreign import ccall "wxVariantIsNull" c_wxVariantIsNull :: Variant -> IO CInt foreign import ccall "wxVariantGetName" c_wxVariantGetName :: Variant -> IO WxStringObj foreign import ccall "wxVariantGetType" c_wxVariantGetType :: Variant -> IO WxStringObj foreign import ccall "wxVariantGetLong" c_wxVariantGetLong :: Variant -> IO CLong foreign import ccall "wxVariantGetString" c_wxVariantGetString :: Variant -> IO WxStringObj ---------------- VariantArray ------------------ foreign import ccall "createWxVariantArray" c_createWxVariantArray :: CInt -> IO VariantArray foreign import ccall "destroyWxVariantArray" c_destroyWxVariantArray :: VariantArray -> IO () foreign import ccall "setWxVariantArray" c_setWxVariantArray :: VariantArray -> CInt -> Variant -> IO VariantArray foreign import ccall "getWxVariantArray" c_getWxVariantArray :: VariantArray -> CInt -> IO Variant foreign import stdcall "ole2.h OleInitialize" c_OleInitialize :: CInt -> IO () foreign import stdcall "ole2.h OleUninitialize" c_OleUninitialize :: IO ()
#include <stdio.h> #include <stdlib.h> #include <locale.h > #include <iostream> #include <wx/msw/ole/automtn.h> #include <wx/variant.h> #include <wx/wx.h> #include <wx/string.h> extern "C" { typedef wxAutomationObject WxAutomation; typedef wxVariant WxVariant; typedef const wxString WxString; // ---------------- wxString ---------------- inline wxString _U(const char String[] = "") { return wxString(String, wxConvUTF8); } WxString* createWxString(wchar_t* wstring){ return new wxString(wstring); } void destroyWxString(WxString* str){ delete str;} wchar_t* wxStringToCWString(WxString* str){ wchar_t *wstring = (wchar_t*)malloc((str->length() +1) * sizeof(wchar_t)); wcscpy( wstring, (wchar_t*)str->wchar_str()); return wstring; } // ---------- wxAutomationObject ----------------- WxAutomation* wxCreateInstance( WxString* instanceName){ wxAutomationObject *p = new wxAutomationObject(); p->CreateInstance(*instanceName); return p; } void destroyWxAutomation(WxAutomation* p){ delete p;} // Checks if the object is in a valid state. // Returns true if the object was successfully initialized or false if it has no valid IDispatch pointer. int wxAutomationPtrIsNotNULL(WxAutomation* p){ if (NULL==p->GetDispatchPtr()) return 0; else return 1; } WxVariant* wxCallMethodNonArg(WxAutomation* p, WxString* methodName){ WxVariant *ret = new WxVariant(); *ret = p->CallMethod(*methodName); return ret; } WxVariant* wxCallMethod(WxAutomation* p, WxString* methodName, WxString* arg){ WxVariant *ret = new WxVariant(); *ret = p->CallMethod(*methodName, *arg); return ret; } void wxCallMethodArgs(WxAutomation* p, wxString* methodName, int n, wxVariant* args){ p->CallMethod(*methodName , n, args); } WxVariant* wxGetProperty(WxAutomation* p, WxString* propertyName){ WxVariant *ret = new WxVariant(); *ret = p->GetProperty(*propertyName); return ret; } int wxPutProperty(WxAutomation* p, WxString* propertyName, WxVariant* variant){ bool ret = p->PutProperty(*propertyName, *variant); if (ret) return 1; else return 0; } WxAutomation* wxGetObject(WxAutomation* p, WxString* objectName){ wxAutomationObject *obj = new wxAutomationObject(); p->GetObject( *obj, *objectName); return obj; } WxAutomation* wxGetObjectArgs(WxAutomation* p, WxString* objectName, int n, WxVariant* args){ wxAutomationObject *ret = new wxAutomationObject(); p->GetObject( *ret, *objectName, n, args); return ret; } // ---------------- Variant ------------------ void destroyWxVariant(WxVariant* var){ delete var;} WxVariant* createLongVariant(long value, WxString* name){ return new WxVariant(value, *name); } WxVariant* createWxStringVariant(WxString* value, WxString* name){ return new WxVariant(*value, *name); } int wxVariantIsNull(WxVariant* var){ bool ret = var->IsNull(); if (ret) return 1; else return 0; } wxString* wxVariantGetName( WxVariant* var){ wxString *ret = new wxString(); *ret = var->GetName(); return ret; } wxString* wxVariantGetType( WxVariant* var){ wxString *ret = new wxString(); *ret = var->GetType(); return ret; } long wxVariantGetLong(WxVariant* var){ return var->GetLong();} wxString* wxVariantGetString( WxVariant* var){ wxString *ret = new wxString(); *ret = var->GetString(); return ret; } // ---------------- VariantArray ------------------ wxVariant* createWxVariantArray(int n){ return new wxVariant[n];} void destroyWxVariantArray(WxVariant* array){ delete[] array;} wxVariant* setWxVariantArray(wxVariant* ret, int n, WxVariant* data){ *(ret + n) = *data; return ret; } wxVariant* getWxVariantArray( WxVariant* array, int n){ return (array+n);} }
g++ win32ole.cpp -c `wx-config --cxxflags` -o win32ole.o ghc --make Main.hs win32ole.o \ -DHAVE_W32API_H -D__WXMSW__ -D_UNICODE \ -I/c/msys/1.0/home/userName/wxMSW-2.8.11/lib/gcc_dll/mswu \ -I/c/msys/1.0/home/userName/wxMSW-2.8.11/include \ -DWXUSINGDLL \ -L/c/msys/1.0/home/userName/wxMSW-2.8.11/lib/gcc_dll \ -L/c/MinGW/lib \ -lstdc++ \ -lwxtiff -lwxjpeg -lwxpng -lwxzlib -lwxregexu \ -lwxexpat -lkernel32 -luser32 -lgdi32 -lcomdlg32 -lwxregexu \ -lwinspool -lwinmm -lshell32 -lcomctl32 -lole32 -loleaut32 \ -luuid -lodbc32 -lodbccp32 -lrpcrt4 -ladvapi32 -lwsock32 -lwxmsw28u -o excel.exe
