HaskellでExcelを読み書きしてみました。
●Haskell のソースコードは UTF8。UTF8 のソースはコンパイルすると内部コードUCS4に変換されます。Windows は表面はSJISですが、COM を呼ぶときにはBSTRに変換しています。
●ソースに書かれた文字列を直接Excelに書き込む場合はUCS4からSJISに変換し、CSting に変換してCで書かれたライブラリを呼びます。
●Cで 書かれたライブラリでは文字列は BSTR に変換され COMを呼びます。COMとのデータのやりとりは Variant型 で行なわれます。
●CString で確保したメモリはGCが行なわれませんので開放する必要があります。
●Variant型というのはデータの種類を表すメンバ VARTYPE vt と大きな共用体で表現されていいます。
// C:\MinGW\include\oaidl.h typedef struct tagVARIANT { _ANONYMOUS_UNION union { struct __tagVARIANT { VARTYPE vt; //(略) _ANONYMOUS_UNION union { long lVal; LONGLONG llVal; unsigned char bVal; short iVal; float fltVal; double dblVal; VARIANT_BOOL boolVal; SCODE scode; CY cyVal; DATE date; BSTR bstrVal; IUnknown *punkVal; LPDISPATCH pdispVal; SAFEARRAY *parray; unsigned char *pbVal; //(略) _ANONYMOUS_STRUCT struct { PVOID pvRecord; struct IRecordInfo *pRecInfo; } __VARIANT_NAME_4; } __VARIANT_NAME_3; } __VARIANT_NAME_2; DECIMAL decVal; } __VARIANT_NAME_1; } VARIANT,*LPVARIANT;●win32ole.hs
{-# LANGUAGE ForeignFunctionInterface #-} -- ghc --make win32ole.hs winole.c -lole32 -loleaut32 -luuid -o ole module Main where import Foreign.Ptr (Ptr) import Foreign.C.String (CString, newCString) import Foreign.C.Types (CLong, CInt) import Foreign.Marshal.Alloc (free) import Cinnamon.Ucs (ucs4ToSjis) data IDispatch = IDispatch main = do cOleInitialize 0 pExl <- instanceNew "Excel.Application" cVersString <- readProperty pExl "Version" cPrintNewLine cVersString -- => 9.0 workBooks <- propertyGet_S pExl "Workbooks" cFullFileName <- getFullPathName "sample2.xls" workBooksOpen workBooks cFullFileName activeWBook <- propertyGet_S pExl "ActiveWorkbook" workSheets <- propertyGet_S activeWBook "Worksheets" sheet <- propertyGet_S_N workSheets "Item" 2 -- 2番目のシート cell <- propertyGet_S_S sheet "Range" "C1" -- C1 セル取得 propertyPut_S_S cell "Value" (ucs4ToSjis "日本語") -- セルに書き込み cSjisString <- readProperty cell "Value" -- セルデータ取得 cPrintNewLine cSjisString -- => 日本語 mapM_ method_S ((activeWBook,"Save"):(workBooks,"Close"):[(pExl, "Quit")]) mapM_ free (cVersString:cFullFileName:[cSjisString]) mapM_ cReleaseObject (cell:sheet:workSheets:activeWBook:workBooks:[pExl]) cOleUninitialize -- Haskell 文字列は List なので 0x00 で終端する CString に変換してCの関数を呼んでいる。 cPrintNewLine :: CString -> IO () cPrintNewLine cstr = do newLine <-newCString "\n" outstr <- cStrcat cstr newLine cprintf outstr free newLine instanceNew :: String -> IO (Ptr IDispatch) instanceNew name = do cName <- newCString name pIDisp <- cInstanceNew cName free cName return pIDisp readProperty :: (Ptr IDispatch) -> String -> IO (CString) readProperty pDisp name = do cName <- newCString name pIDisp <- cReadProperty pDisp cName free cName return pIDisp propertyGet_S :: (Ptr IDispatch) -> String -> IO (Ptr IDispatch) propertyGet_S pDisp name = do cName <- newCString name cString <- cPropertyGet_S pDisp cName free cName return cString getFullPathName :: String -> IO (CString) getFullPathName fName = do cFName <- newCString fName cString <- cgetFullPathName cFName free cFName return cString propertyGet_S_N :: (Ptr IDispatch) -> String -> CLong -> IO (Ptr IDispatch) propertyGet_S_N pDisp name n = do cstring <- newCString name pIDisp <- cPropertyGet_S_N pDisp cstring n free cstring return pIDisp propertyGet_S_S :: (Ptr IDispatch) -> String -> String -> IO (Ptr IDispatch) propertyGet_S_S pDisp command param = do cCommand <- newCString command cParam <- newCString param pIDisp <- cPropertyGet_S_S pDisp cCommand cParam mapM_ free (cCommand:[cParam]) return pIDisp propertyPut_S_S :: (Ptr IDispatch) -> String -> String -> IO () propertyPut_S_S pDisp name value = do cName <- newCString name cValue <- newCString value cPropertyPut_S_S pDisp cName cValue free cName free cValue method_S :: ((Ptr IDispatch), String) -> IO () method_S (pDisp, name) = do cName <- newCString name cMethod_S pDisp cName free cName workBooksOpen :: (Ptr IDispatch) -> CString -> IO () workBooksOpen pDisp fileName = do cstringOpen <- newCString "Open" cMethod_S_S pDisp cstringOpen fileName free cstringOpen -- C の関数を呼ぶための定義 foreign import ccall "InstanceNew" cInstanceNew :: CString -> IO (Ptr IDispatch) foreign import ccall "getFullPathName" cgetFullPathName :: CString -> IO CString foreign import ccall "PropertyGet_S" cPropertyGet_S :: (Ptr IDispatch) -> CString -> IO (Ptr IDispatch) foreign import ccall "PropertyGet_S_S" cPropertyGet_S_S :: (Ptr IDispatch) -> CString -> CString -> IO (Ptr IDispatch) foreign import ccall "PropertyGet_S_N" cPropertyGet_S_N :: (Ptr IDispatch) -> CString -> CLong -> IO (Ptr IDispatch) foreign import ccall "PropertyPut_S_S" cPropertyPut_S_S :: (Ptr IDispatch) -> CString -> CString -> IO () foreign import ccall "ReadProperty" cReadProperty :: (Ptr IDispatch) -> CString -> IO CString foreign import ccall "Method_S_S" cMethod_S_S :: (Ptr IDispatch) -> CString -> CString -> IO () foreign import ccall "Method_S" cMethod_S :: (Ptr IDispatch) -> CString -> IO () foreign import ccall "ReleaseObject" cReleaseObject :: (Ptr IDispatch) -> IO () foreign import ccall "stdlib.h free" cfree :: CString -> IO () foreign import ccall "stdlib.h free" cDispatchFree :: (Ptr IDispatch) -> IO () foreign import ccall "stdio.h printf" cprintf :: CString -> IO () foreign import ccall "string.h strcat" cStrcat :: CString -> CString -> IO (CString) foreign import stdcall "ole2.h OleInitialize" cOleInitialize :: CInt -> IO () foreign import stdcall "ole2.h OleUninitialize" cOleUninitialize :: IO ()●winole.c
#include <stdio.h> #include <malloc.h> #include <windows.h> // 参考 ruby.h #define ALLOCA_N(type,n) (type*)alloca(sizeof(type)*(n)) void messageBox (char* str, char* t, unsigned longx) { MessageBox ( NULL, str, t, x); return; } IDispatch *mallocDispatch(){ return (struct IDispatch *)malloc( sizeof(struct IDispatch) ); } // COM は内部でBSTRを使用しています。 BSTR BSTRfromCstring(char* cstring ){ int cstringlen, out_size; BSTR wstr; cstringlen = strlen(cstring); out_size = MultiByteToWideChar(CP_ACP, 0, cstring, cstringlen, NULL, 0); wstr = SysAllocStringLen(NULL, out_size); MultiByteToWideChar(CP_ACP, 0, cstring, cstringlen, wstr, out_size); return wstr; } char* CSTRfromBSTR(BSTR bstr){ int out_size; char *cstring; out_size = WideCharToMultiByte(CP_ACP, 0, (OLECHAR*)bstr, -1, NULL, 0, NULL, NULL); cstring = (char*)malloc((out_size+1) * sizeof(char)); WideCharToMultiByte(CP_ACP, 0, (OLECHAR*)bstr, -1, cstring, out_size, NULL, NULL); return cstring; } IDispatch *Variant2Dispatch(VARIANT *pVariant){ IDispatch *pDispatch; if (V_ISBYREF(pVariant)) pDispatch = *V_DISPATCHREF(pVariant); else pDispatch = V_DISPATCH(pVariant); return pDispatch; } // 常にインタフェーステーブルへアクセスする。 // Open,Close などのコマンドからテーブルのディスパッチIDを求め実行する。 HRESULT ComInvoke( PVOID *p, char *ComString ,VARIANTARG *param, int nArgs, USHORT wFlags, VARIANT *result){ IDispatch *pDisp; DISPID dispID; HRESULT hr; unsigned short *ucPtr; UINT puArgErr = 0; EXCEPINFO excepinfo; // http://msdn.microsoft.com/ja-jp/library/x6828bcx%28v=VS.80%29.aspx // Win32OLE 製作過程の雑記 : invoke メソッドの引数 // http://homepage1.nifty.com/markey/ruby/win32ole/win32ole03.html#invoke-param DISPPARAMS dispParams = { NULL, NULL, 0, 0 }; dispParams.rgvarg = param; // 引数の配列への参照を表します。 dispParams.rgdispidNamedArgs = NULL; // 名前付き引数の dispID の配列(未使用) dispParams.cArgs = nArgs; // 引数の数を表します。 dispParams.cNamedArgs = 0; // 名前付き引数の数 (未使用) // 参考:ruby win32ole.c ole_invoke2 関数 if (wFlags & DISPATCH_PROPERTYPUT) { dispParams.cNamedArgs = 1; dispParams.rgdispidNamedArgs = ALLOCA_N( DISPID, 1 ); dispParams.rgdispidNamedArgs[0] = DISPID_PROPERTYPUT; } memset( &excepinfo, 0, sizeof(EXCEPINFO)); pDisp = (IDispatch *)p; // コマンド文字列からディスパッチID取得 ucPtr = BSTRfromCstring( ComString ); hr=pDisp->lpVtbl->GetIDsOfNames((IDispatch *)pDisp, &IID_NULL, &ucPtr, 1, LOCALE_USER_DEFAULT, (DISPID*)&dispID); //printf("GetIDsOfNames nArgs:%d %-10s = %04d hr:%08lx\n", nArgs , ComString, dispID, hr); // ここが肝心のInvokeを実行する部分。 VariantInit(result); hr = pDisp->lpVtbl->Invoke( pDisp, // 参考: Ruby付属の「OLE View」 dispID, // arg1 - I4 dispidMember [IN] &IID_NULL, // arg2 - GUID riid [IN] LOCALE_SYSTEM_DEFAULT, // arg3 - UI4 lcid [IN] wFlags, // arg4 - UI2 wFlags [IN] &dispParams, // arg5 - DISPPARAMS pdispparams [IN] result, // arg6 - VARIANT pvarResult [OUT] &excepinfo, // arg7 - EXCEPINFO pexcepinfo [OUT] &puArgErr ); // arg8 - UINT puArgErr [OUT] // printf("Invoke %-10s dispID:%4d hr:%08x puArgErr:%d\n",ComString, dispID, hr,puArgErr); SysFreeString(ucPtr); return hr; } // ProgID("Excel.Application")からCLSID({00024500-0000-0000-C000000000000046}) // を求め、CoCreateInstance APIを呼びます。 IDispatch *InstanceNew(char *ComName){ IDispatch *pDisp; BSTR name; CLSID clsid; HRESULT hr=0; pDisp = mallocDispatch(); name = BSTRfromCstring( ComName ); hr = CLSIDFromProgID(name, &clsid); // HRESULTは最上位ビットで OK ,NG を表現します。 // FAILED はhrが 0 より小さいかどうかチェックするマクロ。 if(FAILED(hr)) { hr = CLSIDFromString(name, &clsid); } hr = CoCreateInstance(&clsid, NULL, CLSCTX_INPROC_SERVER | CLSCTX_LOCAL_SERVER, &IID_IDispatch, (void **)&pDisp); SysFreeString(name); return pDisp; } char *Date2String(DATE date){ char *buf; SYSTEMTIME st; VariantTimeToSystemTime(date, &st); buf = (char*)malloc(20 * sizeof(char)); sprintf(buf,"%04d/%02d/%02d %02d:%02d:%02d", st.wYear,st.wMonth,st.wDay,st.wHour,st.wMinute,st.wSecond); return buf; } char *Number2String(long num){ char *buf; buf = (char*)malloc(30 * sizeof(char)); sprintf(buf,"%d",num); return buf; } char *Double2String(double num){ char *buf; buf = (char*)malloc(30 * sizeof(char)); sprintf(buf,"%f",num); return buf; } char *Variant2String(VARIANT *result){ switch(V_VT(result)){ case VT_EMPTY: return "empty"; break; case VT_NULL: return "null"; break; case VT_I2: // short return Number2String((long)V_I2(result)); break; case VT_I4: // long return Number2String((long)V_I4(result)); break; case VT_R4: // float return Double2String(V_R4(result)); break; case VT_R8: // double return Double2String(V_R8(result)); break; case VT_BOOL: //(True -1,False 0) return (V_BOOL(result) ? "True" : "False"); break; case VT_BSTR: return CSTRfromBSTR(V_BSTR(result)); break; case VT_DATE: return Date2String( V_DATE(result)); break; } } // PropertyPut_S_S((void **)cell, "Value","ほげ"); void PropertyPut_S_S(PVOID *pDisp, char *PropertyName, char *String){ VARIANT result; VARIANTARG param[1]; BSTR bstr; bstr = BSTRfromCstring(String); VariantInit(¶m[0]); param[0].vt = VT_BSTR|VT_BYREF; param[0].pbstrVal = &bstr; ComInvoke((void **)pDisp, PropertyName, param, 1, DISPATCH_PROPERTYPUT, &result); VariantClear(&result); VariantClear(¶m[0]); SysFreeString(bstr); } // GetAbsolutePathName メソッドをコールし、パス名を含めたファイル名を取得 char *GetPathName(IDispatch *fDisp, char *fileName){ VARIANT param, result; HRESULT hr = 0; char *fullPathName; VariantInit(¶m); param.vt = VT_BSTR; param.bstrVal = BSTRfromCstring(fileName); hr = ComInvoke((void **)fDisp, "GetAbsolutePathName", ¶m, 1, DISPATCH_METHOD, &result); fullPathName = CSTRfromBSTR(result.bstrVal); SysFreeString(param.bstrVal); VariantClear(¶m); VariantClear(&result); return fullPathName; } // Scripting.FileSystemObject を作りパス名を含めたファイル名を取得 // in : fileName // out : fullPathName char *getFullPathName(char *fileName){ IDispatch *fileSystemObj; fileSystemObj = InstanceNew("Scripting.FileSystemObject"); return GetPathName(fileSystemObj, fileName); } // workBooks = PropertyGet_S((void **)pExl, "Workbooks"); IDispatch *PropertyGet_S( PVOID *parentDisp, char *ObjName){ VARIANT param, result; DISPID dispID; HRESULT hr = 0; VariantInit(¶m); VariantInit(&result); param.vt = VT_EMPTY; hr = ComInvoke((void **)parentDisp, ObjName, ¶m, 0, DISPATCH_PROPERTYGET | DISPATCH_METHOD,&result); // printf("CreateNewObject ObjName:%-14s hr:%08lx\n",ObjName,hr); VariantClear(¶m); return Variant2Dispatch(&result); } // sheet = PropertyGet_S_N( (void **)workSheets, "Item", 2); // 2 番目のシート IDispatch *PropertyGet_S_N(PVOID *pDisp, char *str, longn){ VARIANT result; VARIANTARG param[1]; HRESULT hr = 0; VariantInit(¶m[0]); param[0].vt = VT_I4; param[0].lVal = n; ComInvoke((void **)pDisp, str, param, 1, DISPATCH_PROPERTYGET , &result); VariantClear(¶m[0]); return Variant2Dispatch(&result); } // cell = PropertyGet_S_S((void **)sheet, "Range", "C2"); IDispatch *PropertyGet_S_S(PVOID *pDisp, char *str1, char *str2){ VARIANT result; VARIANTARG param[1]; BSTR bstr; HRESULT hr = 0; bstr = BSTRfromCstring(str2); VariantInit(¶m[0]); param[0].vt = VT_BSTR|VT_BYREF; param[0].pbstrVal = &bstr; ComInvoke((void **)pDisp, str1, param, 1, DISPATCH_PROPERTYGET , &result); VariantClear(¶m[0]); SysFreeString(bstr); return Variant2Dispatch(&result); } // ver = ReadProperty((void **)pExl, "Version"); char *ReadProperty(PVOID *pDisp, char *PropertyName){ VARIANT param, result; VariantInit(¶m); param.vt = VT_EMPTY; ComInvoke((void **)pDisp, PropertyName,¶m, 0, DISPATCH_PROPERTYGET | DISPATCH_METHOD, &result); VariantClear(¶m); return Variant2String(&result); } // call Method_S_S((void **)workBooks, "Open", "C:\\example.xls"); void Method_S_S(PVOID *pDisp, char *str1, char *str2){ VARIANT result; VARIANTARG param[1]; BSTR bstr; bstr = BSTRfromCstring(str2); VariantInit(¶m[0]); param[0].vt = VT_BSTR|VT_BYREF; param[0].pbstrVal = &bstr; ComInvoke((void **)pDisp, str1, param, 1, DISPATCH_METHOD, &result); SysFreeString(bstr); VariantClear(&result); } // call Method_S((void **)workBooks, "Close"); // call Method_S((void **)pExl, "Quit"); void Method_S(PVOID *pDisp, char *command){ VARIANT param, result; VariantInit(¶m); param.vt = VT_EMPTY; ComInvoke((void **)pDisp, command, ¶m, 0, DISPATCH_METHOD,&result); VariantClear(¶m); VariantClear(&result); } // ReleaseObject((void **)pExl); void ReleaseObject( PVOID *pDisp ){ ((IDispatch *)pDisp)->lpVtbl->Release( (void *)pDisp); }