ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2017年11月21日(火) 11:29

All times are UTC+09:00




新しいトピックを投稿する  トピックへ返信する  [ 6 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 2015年8月06日(木) 20:06 
こんにちは 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が見つからない(あるよ?)ので開始できません」となる始末。
根本的に理解できてないし、適当に打ってもまぁまぁ上手くいかないは承知しておりますが
なんとも情報が少なく、取っ掛かりがつかめません。
何か情報なり、取っ掛かりのご指摘を受けれないものかと書き込みを致しました。
何卒、よろしくおねがいします。


通報する
ページトップ
   
投稿記事Posted: 2015年8月07日(金) 17:21 
なんとなくですが
#import "C:\\Program Files\\Common Files\\Microsoft ・・・
とcには書いてあったので、この辺りから調べたら分るかなと
MSDNには
#import
C++ 固有の仕様
タイプ ライブラリからの情報を組み込むために使用します。 タイプ ライブラリの内容は、ほとんどが COM インターフェイスを記述した C++ クラスに変換されます。
と、COMですか・・・
急に壁が高くなった気がします。
とりあえずの取っ掛かりが分ったので報告まで


通報する
ページトップ
   
投稿記事Posted: 2015年8月21日(金) 18:46 
昔の記事のイグトランスさんのショートカット作成を見ながら分らないなりに
なんとなく近いようなそうでないような感じできましたが
ここからどうやったら良いか分らなくなりました。
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 



通報する
ページトップ
   
投稿記事Posted: 2015年8月25日(火) 18:13 
ちょっと正解に近くなった気がしますが
どうにも全部を使えるように出来ないです。
コード:
#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 


通報する
ページトップ
   
投稿記事Posted: 2015年8月30日(日) 17:33 
少し少し近づいてきましたが、壁が厚くて抜けません。
どうやら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 


通報する
ページトップ
   
投稿記事Posted: 2015年9月13日(日) 18:55 
なんとなく核心にせまりつつはあると思うのですが
今回はファイルがオープンできません。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



通報する
ページトップ
   
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 6 件の記事 ] 

All times are UTC+09:00


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[3人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
cron
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by KONISHI Yohsuke