こんにちは koboと申します。
AB(ver4.24)win7-64bitで利用しています。
ふとOCR機能をやってみたいと思い立ち、色々調べるうちに
Microsoft Office Document Imaging (MODI)というのがoffice2007にあり
OCR機能があるようで、C#やらではやってるのを見ました。
「VisualStudioのプロジェクトの「参照の追加」で「Microsoft Office Document Imaging 12.0 Type Library」があるので読み込むと使える」
との記述があり、CやらVBはさっぱりのおっさんなので
ABでやるときは、なにやら別処理が要るであろうことまでは予想できるのですが
何をしたらいいのかさっぱりです。
良く書かれているのが「MDIVWCTL.dll」を利用するとのことでそれがあるのは確認したのですが
DLLを使えるようにする自体2~3回しかやったこともなく
適当に「Declare Sub MDIVWCTL Lib "MDIVWCTL" (ここの引数(?)が何かも不明なので空白)」なんて打ってみて反応をみるも
「"MDIVWCTL.DLL" を見つけることができません。」なので
フルアドレスを「Declare sub MDIVWCTL Lib "C:\Program Files (x86)\Common Files\microsoft shared\MODI\12.0\MDIVWCTL.DLL" ()」
と打ってみても今度は別の「MSPGIMME.dllが見つからない(あるよ?)ので開始できません」となる始末。
根本的に理解できてないし、適当に打ってもまぁまぁ上手くいかないは承知しておりますが
なんとも情報が少なく、取っ掛かりがつかめません。
何か情報なり、取っ掛かりのご指摘を受けれないものかと書き込みを致しました。
何卒、よろしくおねがいします。
Microsoft Office Document Imaging (MODI)の利用でOCRはできるか
Re: Microsoft Office Document Imaging (MODI)の利用でOCRはできるか
なんとなくですが
#import "C:\\Program Files\\Common Files\\Microsoft ・・・
とcには書いてあったので、この辺りから調べたら分るかなと
MSDNには
#import
C++ 固有の仕様
タイプ ライブラリからの情報を組み込むために使用します。 タイプ ライブラリの内容は、ほとんどが COM インターフェイスを記述した C++ クラスに変換されます。
と、COMですか・・・
急に壁が高くなった気がします。
とりあえずの取っ掛かりが分ったので報告まで
#import "C:\\Program Files\\Common Files\\Microsoft ・・・
とcには書いてあったので、この辺りから調べたら分るかなと
MSDNには
#import
C++ 固有の仕様
タイプ ライブラリからの情報を組み込むために使用します。 タイプ ライブラリの内容は、ほとんどが COM インターフェイスを記述した C++ クラスに変換されます。
と、COMですか・・・
急に壁が高くなった気がします。
とりあえずの取っ掛かりが分ったので報告まで
Re: Microsoft Office Document Imaging (MODI)の利用でOCRはできるか
昔の記事のイグトランスさんのショートカット作成を見ながら分らないなりに
なんとなく近いようなそうでないような感じできましたが
ここからどうやったら良いか分らなくなりました。
ttps://msdn.microsoft.com/en-us/library/aa192253.aspx
MSDNには色々かいてありますが、他の言語では new でおわっちゃってるのですが
似たようにかこうにもさっぱり分りません。
なんとか助け舟をだして頂くわけにはいかないでしょうか
なんとなく近いようなそうでないような感じできましたが
ここからどうやったら良いか分らなくなりました。
ttps://msdn.microsoft.com/en-us/library/aa192253.aspx
MSDNには色々かいてありますが、他の言語では new でおわっちゃってるのですが
似たようにかこうにもさっぱり分りません。
なんとか助け舟をだして頂くわけにはいかないでしょうか
コード: 全て選択
#strict
'MODI
' ここからプログラムが実行されます。
'宣言
Declare Function CLSIDFromProgID Lib "OLE32" (pszProgID As *WCHAR, ByRef clsid As CLSID) As HRESULT
Declare Function CLSIDFromString Lib "OLE32" (String As *WCHAR, ByRef clsid As CLSID) As HRESULT
' クラスIDからオブジェクトを作る。
TypeDef HRESULT = Long
TypeDef CLSID = GUID 'Globally Unique Identifiers
TypeDef IID = GUID
TypeDef PITEMIDLIST = VoidPtr
TypeDef PCITEMIDLIST = VoidPtr
Const E_UNEXPECTED = &h8000FFFF As HRESULT
Const FACILITY_WIN32 = 7
Dim CLSID_MODI = [
&h40942A6C,
&h1520,
&h4132,
[&hBD,&hF8,&hBD,&hC1,&hF7,&h1F,&h54,&h7B]
] As GUID
Dim IID_IDocument = [
&hD4073843,
&hA58A,
&h469A,
[&hA8,&hE2,&hCF,&hF3,&hFF,&h77,&hEE,&h4E]
] As GUID
Dim IID_ILayout = [
&hC300C846,
&hA3FD,
&h4A5B,
[&hAD,&h65,&h4A,&h6A,&hB4,&h6B,&h78,&h21]
] As GUID
Dim IID_IImage = [
&hAC0D48A6,
&h886D,
&h4EB5,
[&hA8,&hA1,&h09,&h3D,&h60,&hB9,&hA8,&h4A]
] As GUID
'---------------------------------------------------------------------------------
'メイン
' COMのインスタンス
Dim hr As HRESULT
hr = CoInitialize(0) 'COM初期化
If hr <> S_OK Then
MessageBoxStr(0, GetErrorStr(hr As DWord), "初期化に失敗", MB_ICONERROR)
End
End If
Dim pShellLink As *IShellLink
hr = CoCreateInstance(CLSID_MODI, 0, CLSCTX_ALL, IID_IDocument , VarPtr(pShellLink))
Select case hr
case S_OK
msgbox 0,"S_OK","#"
case REGDB_E_CLASSNOTREG
msgbox 0,"REGDB_E_CLASSNOTREG","#"
end
case CLASS_E_NOAGGREGATION
msgbox 0,"CLASS_E_NOAGGREGATION","#"
end
case E_NOINTERFACE
msgbox 0,"E_NOINTERFACE","#"
end
case E_INVALIDARG
msgbox 0,"E_INVALIDARG","#"
end
case else
msgbox 0,"イレギュラ","error"
end
end select
'------------------
'------------------
' COM開放
CoUninitialize()
End
Function MessageBoxStr(hwnd As HWND, strText As String, pszCaption As BytePtr, uType As DWord) As Long
MessageBox(hwnd, StrPtr(strText), pszCaption, uType)
End Function
'インターフェイスの宣言が必要です。
Class IShellLinkA
Inherits IUnknown
Public
Virtual Function GetPath(_
/* [size_is][out] */ pszFile As BytePtr,_
/* [in] */ cch As Long,_
/* [full][out][in] */ pfd As *WIN32_FIND_DATA,_
/* [in] */ fFlags As DWord) As HRESULT
Virtual Function GetIDList(
/* [out] */ ppidl As *PITEMIDLIST) As HRESULT
Virtual Function SetIDList(
/* [in] */ pidl As PCITEMIDLIST) As HRESULT
Virtual Function GetDescription(
/* [size_is][out] */ pszName As BytePtr,
/* [in] */ cch As Long) As HRESULT
Virtual Function SetDescription(
/* [in] */ pszName As BytePtr) As HRESULT
Virtual Function GetWorkingDirectory(
/* [size_is][out] */ pszDir As BytePtr,
/* [in] */ cch As Long) As HRESULT
Virtual Function SetWorkingDirectory(
/* [in] */ pszDir As BytePtr) As HRESULT
Virtual Function GetArguments(
/* [size_is][out] */ pszArgs As BytePtr,
/* [in] */ cch As Long) As HRESULT
Virtual Function SetArguments(
/* [in] */ pszArgs As BytePtr) As HRESULT
Virtual Function GetHotkey(
/* [out] */ ByRef wHotkey As Word) As HRESULT
Virtual Function SetHotkey(
/* [in] */ wHotkey As Word) As HRESULT
Virtual Function GetShowCmd(
/* [out] */ ByRef piShowCmd As Long) As HRESULT
Virtual Function SetShowCmd(
/* [in] */ iShowCmd As Long) As HRESULT
Virtual Function GetIconLocation(
/* [size_is][out] */ pszIconPath As BytePtr,
/* [in] */ cch As Long,
/* [out] */ ByRef iIcon As Long) As HRESULT
Virtual Function SetIconLocation(
/* [in] */ pszIconPath As BytePtr,
/* [in] */ iIcon As Long) As HRESULT
Virtual Function SetRelativePath(
/* [in] */ pszPathRel As BytePtr,
/* [in] */ dwReserved As DWord) As HRESULT
Virtual Function Resolve(
/* [in] */ hwnd As HWND,
/* [in] */ fFlags As DWord) As HRESULT
Virtual Function SetPath(
/* [in] */ pszFile As BytePtr) As HRESULT
End Class
TypeDef IShellLink = IShellLinkA
Function GetErrorStr(dwMessageId As DWord) As String
Dim pszMsg As BytePtr
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, _
NULL, _
dwMessageId, _
LANG_USER_DEFAULT, _
VarPtr(pszMsg), _
0, _
NULL)
If Not pszMsg = NULL Then
GetErrorStr = pszMsg
LocalFree(pszMsg)
End If
End Function
Re: Microsoft Office Document Imaging (MODI)の利用でOCRはできるか
ちょっと正解に近くなった気がしますが
どうにも全部を使えるように出来ないです。
どうにも全部を使えるように出来ないです。
コード: 全て選択
#strict
'MODI
TypeDef HRESULT = Long
TypeDef CLSID = GUID 'Globally Unique Identifiers
TypeDef IID = GUID
TypeDef PITEMIDLIST = VoidPtr
TypeDef PCITEMIDLIST = VoidPtr
Const E_UNEXPECTED = &h8000FFFF As HRESULT
Const FACILITY_WIN32 = 7
Dim CLSID_MODI = [
&h40942A6C,
&h1520,
&h4132,
[&hBD,&hF8,&hBD,&hC1,&hF7,&h1F,&h54,&h7B]
] As GUID
Dim IID_IDocument = [
&hD4073843,
&hA58A,
&h469A,
[&hA8,&hE2,&hCF,&hF3,&hFF,&h77,&hEE,&h4E]
] As GUID
Dim IID_ILayout = [
&hC300C846,
&hA3FD,
&h4A5B,
[&hAD,&h65,&h4A,&h6A,&hB4,&h6B,&h78,&h21]
] As GUID
Dim IID_IImage = [
&hAC0D48A6,
&h886D,
&h4EB5,
[&hA8,&hA1,&h09,&h3D,&h60,&hB9,&hA8,&h4A]
] As GUID
'---------------------------------------------------------------------------------
'メイン
' COMのインスタンス
Dim hr As HRESULT
hr = CoInitialize(0) 'COM初期化
If hr <> S_OK Then
MessageBoxStr(0, GetErrorStr(hr As DWord), "初期化に失敗", MB_ICONERROR)
End
End If
Dim pDocument As *Document
hr = CoCreateInstance(CLSID_MODI, 0, CLSCTX_ALL, IID_IDocument , VarPtr(pDocument))
Select case hr
case S_OK
msgbox 0,"S_OK","#"
case REGDB_E_CLASSNOTREG
msgbox 0,"REGDB_E_CLASSNOTREG","#"
end
case CLASS_E_NOAGGREGATION
msgbox 0,"CLASS_E_NOAGGREGATION","#"
end
case E_NOINTERFACE
msgbox 0,"E_NOINTERFACE","#"
end
case E_INVALIDARG
msgbox 0,"E_INVALIDARG","#"
end
case else
msgbox 0,"イレギュラ-","error"
end
end select
'------------------
pDocument->Create("F:\ActiveBasic\ABPプログラム集\テスト集\ocr.bmp")
pDocument->OCR(17, 0, 0)
'doc.OCR(MODI.MiLANGUAGES.miLANG_JAPANESE, false, false) '日本語指定
ここらあたりで文字を取り出したいけどLayoutが使えるようになってない
pDocument->Close(0)
'------------------
' COM開放
CoUninitialize()
msgbox 0,"fin","#"
End
Function MessageBoxStr(hwnd As HWND, strText As String, pszCaption As BytePtr, uType As DWord) As Long
MessageBox(hwnd, StrPtr(strText), pszCaption, uType)
End Function
'インターフェイスの宣言が必要です。
TypeDef Document = IDocument
Class IDocument
Inherits IUnknown
Public
Virtual Sub Create(_
FileOpen as String _ /* ファイル名 */
)
Virtual Sub Close(_
SaveChanges as Long _ /*ドキュメントが未保存の場合*/
) /*閉じる前に保存するかどうか*/
Virtual Sub OCR(_
LangId as Long,_ /* ドキュメントの言語 9 英語、17 日本語*/
OCROrientImage as Long ,_ /* ドキュメントの回転を補正させるかどうか*/
OCRStraightenImage as Long_ /* ドキュメントの歪みを補正させるかどうか*/
)
Virtual Sub SaveAs(_
FileName as String,_ 'ファイル名
FileFormat as DWord,_ 'フォーマット
CompLevel as DWord_ '圧縮レベル
)
Virtual Sub Save()
Virtual Sub PrintOut(_ '指定されたプリンターまたはファイルに作業中の文書を印刷します。
From as Long,_ '差出人
To as Long,_ '宛先
Copies as Long,_ 'コピー
PrinterName as String,_ 'プリンター名
PrintToFileName as String,_ 'PrintToFileName
PrintAnnotation as Long,_ 'PrintAnnotation (Boolean)
FitMode as Long_ 'FitMode MiPRINT_FITMODES ( miPRINT_ACTUALSIZE or miPRINT_PAGE )
)
End Class
Function GetErrorStr(dwMessageId As DWord) As String
Dim pszMsg As BytePtr
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, _
NULL, _
dwMessageId, _
LANG_USER_DEFAULT, _
VarPtr(pszMsg), _
0, _
NULL)
If Not pszMsg = NULL Then
GetErrorStr = pszMsg
LocalFree(pszMsg)
End If
End Function
Re: Microsoft Office Document Imaging (MODI)の利用でOCRはできるか
少し少し近づいてきましたが、壁が厚くて抜けません。
どうやらDocumentインターフェイスにはアクセスできているっぽいのですが
OCRメソッドに失敗するのと
Imageインターフェイスにアクセスできません。
そもそも見当違いで、なにも進んでいない気もしますがABではこのDLLの利用は無理なのでしょうか
ヘッダーファイルからヒントを得てとも思いましたが、それすら上手くいかず
おとなしくCやらVBやらに乗り換えたほうが早いのでしょうか
どうやらDocumentインターフェイスにはアクセスできているっぽいのですが
OCRメソッドに失敗するのと
Imageインターフェイスにアクセスできません。
そもそも見当違いで、なにも進んでいない気もしますがABではこのDLLの利用は無理なのでしょうか
ヘッダーファイルからヒントを得てとも思いましたが、それすら上手くいかず
おとなしくCやらVBやらに乗り換えたほうが早いのでしょうか
コード: 全て選択
#strict
'MODI
TypeDef HRESULT = Long
TypeDef CLSID = GUID 'Globally Unique Identifiers
TypeDef IID = GUID
TypeDef PITEMIDLIST = VoidPtr
TypeDef PCITEMIDLIST = VoidPtr
TypeDef WCHAR = Word
TypeDef BSTR = *WCHAR
TypeDef VARIANT_BOOL = Integer
Const VARIANT_TRUE = -1
Const VARIANT_FALSE = 0
TypeDef BOOL = Long
TypeDef Document = IDocument
/*
'OCR言語設定
Const MODI.MiLANGUAGES.miLANG_CHINESE_SIMPLIFIED = 2052
Const MODI.MiLANGUAGES.miLANG_CZECH = 5
Const MODI.MiLANGUAGES.miLANG_DANISH = 6
Const MODI.MiLANGUAGES.miLANG_GERMAN = 7
Const MODI.MiLANGUAGES.miLANG_GREEK = 8
Const MODI.MiLANGUAGES.miLANG_ENGLISH = 9
Const MODI.MiLANGUAGES.miLANG_SPANISH = 10
Const MODI.MiLANGUAGES.miLANG_FINNISH = 11
Const MODI.MiLANGUAGES.miLANG_FRENCH = 12
Const MODI.MiLANGUAGES.miLANG_HUNGARIAN = 14
Const MODI.MiLANGUAGES.miLANG_ITALIAN = 16
Const MODI.MiLANGUAGES.miLANG_JAPANESE = 17
Const MODI.MiLANGUAGES.miLANG_KOREAN = 18
Const MODI.MiLANGUAGES.miLANG_DUTCH = 19
Const MODI.MiLANGUAGES.miLANG_NORWEGIAN = 20
Const MODI.MiLANGUAGES.miLANG_POLISH = 21
Const MODI.MiLANGUAGES.miLANG_PORTUGUESE = 22
Const MODI.MiLANGUAGES.miLANG_RUSSIAN = 25
Const MODI.MiLANGUAGES.miLANG_SWEDISH = 29
Const MODI.MiLANGUAGES.miLANG_TURKISH = 31
Const MODI.MiLANGUAGES.miLANG_CHINESE_TRADITIONAL = 1028
*/
Dim CLSID_MODI = [
&h40942A6C,
&h1520,
&h4132,
[&hBD,&hF8,&hBD,&hC1,&hF7,&h1F,&h54,&h7B]
] As GUID
Dim IID_IDocument = [
&hD4073843,
&hA58A,
&h469A,
[&hA8,&hE2,&hCF,&hF3,&hFF,&h77,&hEE,&h4E]
] As GUID
Dim IID_ILayout = [
&hC300C846,
&hA3FD,
&h4A5B,
[&hAD,&h65,&h4A,&h6A,&hB4,&h6B,&h78,&h21]
] As GUID
Dim IID_IImage = [
&hAC0D48A6,
&h886D,
&h4EB5,
[&hA8,&hA1,&h09,&h3D,&h60,&hB9,&hA8,&h4A]
] As GUID
'---------------------------------------------------------------------------------
'メイン
' COMのインスタンス
Dim hr As HRESULT
hr = CoInitialize(0) 'COM初期化
If hr <> S_OK Then
MessageBoxStr(0, GetErrorStr(hr As DWord), "初期化に失敗", MB_ICONERROR)
End
End If
Dim pDocument As *Document
hr = CoCreateInstance(CLSID_MODI, 0, CLSCTX_ALL, IID_IDocument , VarPtr(pDocument))
Select case hr
case S_OK
msgbox 0,"S_OK","#"
case REGDB_E_CLASSNOTREG
msgbox 0,"REGDB_E_CLASSNOTREG","#"
end
case CLASS_E_NOAGGREGATION
msgbox 0,"CLASS_E_NOAGGREGATION","#"
end
case E_NOINTERFACE
msgbox 0,"E_NOINTERFACE","#"
end
case E_INVALIDARG
msgbox 0,"E_INVALIDARG","#"
end
case else
msgbox 0,"イレギュラ","error"
end
end select
Dim pIImages as *IImages
hr = pDocument->QueryInterface(VarPtr(IID_IImage), VarPtr(pIImages))
Select case hr
case S_OK
msgbox 0,"S_OK","#"
case REGDB_E_CLASSNOTREG
msgbox 0,"REGDB_E_CLASSNOTREG","#"
CoUninitialize()
end
case CLASS_E_NOAGGREGATION
msgbox 0,"CLASS_E_NOAGGREGATION","#"
CoUninitialize()
end
case E_NOINTERFACE
msgbox 0,"E_NOINTERFACE","#"
CoUninitialize()
end
case E_INVALIDARG
msgbox 0,"E_INVALIDARG","#"
CoUninitialize()
end
case else
msgbox 0,"イレギュラ","error"
CoUninitialize()
end
end select
if SUCCEEDED(pDocument->Create("F:\ActiveBasic\ABPプログラム集\テスト集\ocr.tif")) then 'ファイルのロード
msgbox 0,"Step 150 ok","Create"
else
msgbox 0,"Step 150 False","Create"
end if
if SUCCEEDED(pDocument->OCR(17, FALSE, FALSE,)) then 'OCR実行
msgbox 0,"Step 155 ok","OCR"
else
msgbox 0,"Step 155 False","OCR"
end if
if SUCCEEDED(pDocument->Close(0)) then 'Close
msgbox 0,"Step 170 ok","Close"
else
msgbox 0,"Step 170 False","Close"
end if
if SUCCEEDED(pDocument->Release()) then 'Release
msgbox 0,"Step 176 ok","Release"
else
msgbox 0,"Step 176 False","Release"
end if
' COM開放
CoUninitialize()
msgbox 0,"fin","#"
end
class IImages
Inherits IUnknown
public
Virtual Function GetCount() as Long
End Class
Class IDocument
Inherits IUnknown
Public
Virtual Function Create(_
FileOpen as String _ /* ファイル名 */
) As HRESULT
Virtual Function Close(_
SaveChanges as Long _ /*ドキュメントが未保存の場合*/
) As HRESULT /*閉じる前に保存するかどうか*/
Virtual Function OCR(_
LangId as Long,_ /* ドキュメントの言語 9 英語、17 日本語*/
OCROrientImage as Long ,_ /* ドキュメントの回転を補正させるかどうか*/
OCRStraightenImage as Long_ /* ドキュメントの歪みを補正させるかどうか*/
) As HRESULT
Virtual Function SaveAs(_
FileName as String,_ 'ファイル名
FileFormat as DWord,_ 'フォーマット
CompLevel as DWord_ '圧縮レベル
) As HRESULT
Virtual Function Save() As HRESULT
Virtual Function PrintOut(_ '指定されたプリンターまたはファイルに作業中の文書を印刷します。
From as Long,_ '差出人
To as Long,_ '宛先
Copies as Long,_ 'コピー
PrinterName as String,_ 'プリンター名
PrintToFileName as String,_ 'PrintToFileName
PrintAnnotation as Long,_ 'PrintAnnotation (Boolean)
FitMode as Long_ 'FitMode MiPRINT_FITMODES ( miPRINT_ACTUALSIZE or miPRINT_PAGE )
) As HRESULT
End Class
Function SUCCEEDED(hResult as HRESULT) as BOOL
SUCCEEDED = (hResult >= 0)
endFunction
Function FAILED(hResult as HRESULT) as BOOL
FAILED = (hResult < 0)
endFunction
End
Function MessageBoxStr(hwnd As HWND, strText As String, pszCaption As BytePtr, uType As DWord) As Long
MessageBox(hwnd, StrPtr(strText), pszCaption, uType)
End Function
Function GetErrorStr(dwMessageId As DWord) As String
Dim pszMsg As BytePtr
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, _
NULL, _
dwMessageId, _
LANG_USER_DEFAULT, _
VarPtr(pszMsg), _
0, _
NULL)
If Not pszMsg = NULL Then
GetErrorStr = pszMsg
LocalFree(pszMsg)
End If
End Function
Re: Microsoft Office Document Imaging (MODI)の利用でOCRはできるか
なんとなく核心にせまりつつはあると思うのですが
今回はファイルがオープンできません。BSTR(wideChar?)型でのファイル名を求められているとは
思うので用意をしたのですが、相変わらずファイルを開けません。
苦労しているせいで色々勉強になります(笑
OLEViewerなるものも初めて知りました。
お陰でclassの中は大丈夫だと思っています・・・たぶん
何かお気付きあれば返信ください・・・
今回はファイルがオープンできません。BSTR(wideChar?)型でのファイル名を求められているとは
思うので用意をしたのですが、相変わらずファイルを開けません。
苦労しているせいで色々勉強になります(笑
OLEViewerなるものも初めて知りました。
お陰でclassの中は大丈夫だと思っています・・・たぶん
何かお気付きあれば返信ください・・・
コード: 全て選択
#strict
'MODI
' ここからプログラムが実行されます。
'宣言
TypeDef HRESULT = Long
TypeDef CLSID = GUID 'Globally Unique Identifiers
TypeDef IID = GUID
TypeDef PITEMIDLIST = VoidPtr
TypeDef PCITEMIDLIST = VoidPtr
TypeDef WCHAR = Word
TypeDef BSTR = *WCHAR
TypeDef VARIANT_BOOL = Integer
Const VARIANT_TRUE = -1
Const VARIANT_FALSE = 0
TypeDef BOOL = Long
Declare Function CLSIDFromProgID Lib "OLE32" (pszProgID As *WCHAR, ByRef clsid As CLSID) As HRESULT
Declare Function CLSIDFromString Lib "OLE32" (String As *WCHAR, ByRef clsid As CLSID) As HRESULT
Declare Function SysAllocString Lib "OleAut32" ( ByVal psz As BytePtr ) As BSTR
Declare Function SysAllocStringByteLen Lib "OleAut32" ( ByVal psz As BytePtr, ByVal len As DWord) As WordPtr
Declare Function SysStringByteLen Lib "oleaut32" ( bstr As BSTR ) As BSTR
Declare Function SysFreeString Lib "OleAut32" ( ByVal pbstr As WordPtr) As Long
class VARIANT
public
vt as Word 'タグ
wReserved1 as Word 'パディング用
wReserved2 as Word
wReserved3 as Word
Value as DWord '値
Value2 as DWord
end class
Const E_UNEXPECTED = &h8000FFFF As HRESULT
Const FACILITY_WIN32 = 7
Dim CLSID_MODI = [
&h40942A6C,
&h1520,
&h4132,
[&hBD,&hF8,&hBD,&hC1,&hF7,&h1F,&h54,&h7B]
] As GUID
Dim IID_IDocument = [
&hD4073843,
&hA58A,
&h469A,
[&hA8,&hE2,&hCF,&hF3,&hFF,&h77,&hEE,&h4E]
] As GUID
'---------------------------------------------------------------------------------
'メイン
' COMのインスタンス
Dim hr As HRESULT
hr = CoInitialize(0) 'COM初期化
If hr <> S_OK Then
MessageBoxStr(0, GetErrorStr(hr As DWord), "初期化に失敗", MB_ICONERROR)
End
End If
Dim pIDocument As *IDocument
hr = CoCreateInstance(CLSID_MODI, 0, CLSCTX_ALL, IID_IDocument , VarPtr(pIDocument))
Select case hr
case S_OK
msgbox 0,"S_OK"+ex"\r\n\r\n処理は正常に終了し、指定されたオブジェクトは正常に作成されました。","#"
case REGDB_E_CLASSNOTREG
msgbox 0,"REGDB_E_CLASSNOTREG"+ex"\r\n\r\n指定されたクラスは、レジストリに登録されていなかったため、処理が失敗しました。"+_
"CLSIDがレジストリに登録されていても、要求されたCLSCTXに合致しなければ、この値が返されます。","#"
case CLASS_E_NOAGGREGATION
msgbox 0,"CLASS_E_NOAGGREGATION"+ex"\r\n\r\n指定されたクラスは集約をサポートしていないため、処理が失敗しました。","#"
case E_NOINTERFACE
msgbox 0,"E_NOINTERFACE"+ex"\r\n\r\n指定されたクラスは、要求されたインターフェースを実装していないため、処理が失敗しました。"+_
"もう1つの可能性は、オブジェクトを集約した場合に制御側 IUnknownが、オブジェクトの要求する"+_
"インターフェースを実装していない場合にも、この値を返すことがあります。E_POINTER特にppv にNULLを指定した場合に"+_
"この値が返されることがあります。","#"
case E_INVALIDARG
msgbox 0,"E_INVALIDARG"+ex"\r\n\r\n集約するために制御側 IUnknownを指定しているにも関わらず、オブジェクトに要求するインターフェースに、"+_
"IUnknown以外を指定した場合に、この値が返却されることがあります。E_OUTOFMEMORYメモリを割り当てることが"+_
"出来なかったために、処理が失敗しました。","#"
case else
msgbox 0,"イレギュラ","error"
end select
if hr<>S_OK then
' COM開放
CoUninitialize()
end
end if
dim name as BSTR
dim buf as BytePtr
buf = StrByteptr("F:\ActiveBasic\ocr.tif")
name = String_BSTR( buf , lstrlen(buf) )
free( buf )
'if SUCCEEDED( pIDocument->Create( name.getPtr() ) ) then 'ファイルのロード
if SUCCEEDED( pIDocument->Create( name+sizeof(DWord) ) ) then 'ファイルのロード
msgbox 0,"Step 150 ok","Create"
if SUCCEEDED(pIDocument->OCR(17, FALSE, FALSE,)) then 'OCR実行
msgbox 0,"Step 155 ok","OCR"
'doc.OCR(MODI.MiLANGUAGES.miLANG_JAPANESE, false, false) '日本語指定
Dim IImages as *IImages
IImages = pIDocument->Images()
Dim count as Long
count = IImages->GetCount()
msgbox 0,ex"pIDocument.Count "+Str$(count),"count"
if SUCCEEDED(pIDocument->Close(0)) then 'Close
msgbox 0,"Step 170 ok","Close"
else
msgbox 0,"Step 170 False","Close"
end if
if SUCCEEDED(pIDocument->Release()) then 'Release
msgbox 0,"Step 176 ok","Release"
else
msgbox 0,"Step 176 False","Release"
end if
else
msgbox 0,"Step 155 False","OCR"
end if
else
msgbox 0,ex"Step 150 False\r\n"+MakeStr(GetErrorStr(HRESULT_FROM_WIN32(GetLastError()))),"Create"
' MessageBoxStr(0, GetErrorStr(hr As DWord), "ショートカット作成に失敗", MB_ICONERROR)
end if
WStringfree( name )
' COM開放
CoUninitialize()
msgbox 0,"fin","#"
end
Function StrByteptr( str as String ) as BytePtr
'StringデータをByteptrで返答する
Dim data as BytePtr
Dim l as DWord
l = len(str)
data = calloc( l +1 )
lstrcpy( data , StrPtr(str) )
StrByteptr = data
end Function
Function SUCCEEDED(hResult as HRESULT) as BOOL
SUCCEEDED = (hResult >= 0)
endFunction
Function FAILED(hResult as HRESULT) as BOOL
FAILED = (hResult < 0)
endFunction
Function MessageBoxStr(hwnd As HWND, strText As String, pszCaption As BytePtr, uType As DWord) As Long
MessageBox(hwnd, StrPtr(strText), pszCaption, uType)
End Function
Function GetErrorStr(dwMessageId As DWord) As String
Dim pszMsg As BytePtr
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, _
NULL, _
dwMessageId, _
LANG_USER_DEFAULT, _
VarPtr(pszMsg), _
0, _
NULL)
If Not pszMsg = NULL Then
GetErrorStr = pszMsg
LocalFree(pszMsg)
End If
End Function
Class IDispatch
Public
'IUnknown
Virtual Function QueryInterface(
ByRef riid As GUID, ppvObj As DWordPtr) As HRESULT
Virtual Function AddRef() As HRESULT
Virtual Function Release() As HRESULT
'IDispatch
Virtual Function GetTypeInfoCount(pCount As *DWord) As HRESULT 'インターフェースの数取得
Virtual Function GetTypeInfo( 'オブジェクトの型情報を取得します。インターフェイスの型情報の取得に使用できます。
iTInfo As DWord,
lcid As DWord,
ppTInfo As VoidPtr) As HRESULT
Virtual Function GetIDsOfNames( '一連の名前を対応する一連のディスパッチ識別子に割り当てます。
riid As *GUID,
rgszNames As VoidPtr,
cNames As DWord,
lcid As DWord,
rgDispId As *Long) As HRESULT
Virtual Function Invoke( 'オブジェクトによって公開されるメソッドとプロパティへのアクセスを提供します。ディスパッチ関数 DispInvoke は、Invoke の標準的な実装を提供します。
dispIdMember As Long,
riid As *GUID,
lcid As DWord,
wFlags As Word,
pDispParams As VoidPtr,
pVarResult As VoidPtr,
pExcepInfo As VoidPtr,
puArgErr As *DWord) As HRESULT
End Class
Class IDocument
Inherits IDispatch
Public
Virtual Function Save() As HRESULT
Virtual Function Close(_
SaveChanges as Long _ /*ドキュメントが未保存の場合*/
) As HRESULT /*閉じる前に保存するかどうか*/
Virtual Function SaveAs(_
FileName as String,_ 'ファイル名
FileFormat as DWord,_ 'フォーマット
CompLevel as DWord_ '圧縮レベル
) As HRESULT
Virtual Function Images() as *IImages
Virtual Function Create(_
FileOpen as BSTR _ /* ファイル名 */
) As HRESULT
Virtual Function OCR(_
LangId as Long,_ /* ドキュメントの言語 9 英語、17 日本語*/
OCROrientImage as Long ,_ /* ドキュメントの回転を補正させるかどうか*/
OCRStraightenImage as Long_ /* ドキュメントの歪みを補正させるかどうか*/
) As HRESULT
Virtual Function PrintOut(_ '指定されたプリンターまたはファイルに作業中の文書を印刷します。
From as Long,_ '差出人
To as Long,_ '宛先
Copies as Long,_ 'コピー
PrinterName as String,_ 'プリンター名
PrintToFileName as String,_ 'PrintToFileName
PrintAnnotation as Long,_ 'PrintAnnotation (Boolean)
FitMode as Long_ 'FitMode MiPRINT_FITMODES ( miPRINT_ACTUALSIZE or miPRINT_PAGE )
) As HRESULT
End Class
' IImages wrapper class
class IImages
Inherits IDispatch
public
Virtual Function GetCount() as Long
' Virtual Function Add(Page as *IDispatch , BeforePage as *IDispatch ) as HRESULT
' Virtual Function _NewEnum() as *IUnkown
' Virtual Function Item(Index as Long) as *IDispatch
' Virtual Function Remove(Page as *IDispatch) As HRESULT
End Class
sub WStringfree(p as BSTR)
if p <> NULL then
SysFreeString(p)
endif
endsub
Function String_BSTR(pString As BytePtr, length As Long ) As BSTR
Dim sizeWChar As Long
sizeWChar = MultiByteToWideChar(CP_ACP, 0, pString, length , 0, 0)
If sizeWChar = 0 Then
MessageBoxStr(0, GetErrorStr(sizeWChar As DWord), "error 482", MB_ICONERROR)
String_BSTR = 0
Exit Function
End If
Dim pwString As *WCHAR
sizeWChar++
' バッファを確保
pwString = SysAllocStringByteLen( NULL, sizeof(DWord) + sizeof(WCHAR)*sizeWChar )
If pwString = 0 Then
MessageBoxStr(0, GetErrorStr(sizeWChar As DWord), "error 497", MB_ICONERROR)
String_BSTR = 0
Exit Function
End If
' 文字列の長さ格納(単位はバイトで、終端文字は含まれない)
SetDWord(pwString , sizeof(WCHAR)*(sizeWChar-1))
' 文字列先頭を指すようにポインタ移動
'pwString = pwString + sizeof(DWord)
sizeWChar = MultiByteToWideChar(CP_ACP, 0, pString , length + 1, pwString + sizeof(DWord) , sizeWChar)
If sizeWChar = 0 Then
MessageBoxStr(0, GetErrorStr(sizeWChar As DWord), "error 503", MB_ICONERROR)
String_BSTR = 0
Exit Function
End If
String_BSTR = pwString
End Function
Function HRESULT_FROM_WIN32(x As DWord) As HRESULT
If (x As HRESULT) <= 0 Then
HRESULT_FROM_WIN32 = x As HRESULT
Else
HRESULT_FROM_WIN32 = (LOWORD(x) Or (FACILITY_WIN32 << 16) Or &h80000000) As HRESULT
End If
End Function