開発環境：VB6SP6、Windows7です。
ActiveXコントロールの開発を行っています。
IEShowSaveFileDialog Function
http://msdn.microsoft.com/en-us/library/ms537318(v=VS.85).aspx
保護モード API の概要
http://msdn.microsoft.com/ja-jp/library/dd163925.aspx
上記URLの保護モードでのファイルの保存を実装しようとしているのですが、
IEShowSaveFileDialog関数がE_ACCESSDENIEDを返してしまい、
ファイルの保存まで進めません。
エラーが「アクセス拒否」なので、フォルダ指定が間違っているのかと
思っていろいろ試しましたが、エラーの内容は変わりませんでした。
IEIsProtectedModeProcess関数は動作するので、保護モードAPIが
使えない環境という訳ではないようです。
Declare文も以下の内容で大丈夫だと思うのですが・・・。
何かご指摘が頂けると大変有難いです。
以上、よろしくお願いいたします。
------------ソース--------------
Private Const OFN_OVERWRITEPROMPT = &H2 '既存のファイル名を指定した時にメッセージを出す
Private Const S_OK = &H0
Private Const S_FALSE = &H1
'保護モードAPI
Private Declare Function IESaveFile Lib "Ieframe.dll" (ByVal hstate As Long, ByVal sourceFile As String) As Long
Private Declare Function IEShowSaveFileDialog Lib "Ieframe.dll" _
(ByVal hwnd As Long, _
ByVal initialFileName As String, _
ByVal initialDir As String, _
ByVal fileFilter As String, _
ByVal defExtention As String, _
ByVal filterIndex As Long, _
ByVal flag As Long, _
ByRef filePath As String, _
ByRef handle As Long) As Long
Private Declare Function IEIsProtectedModeProcess Lib "Ieframe.dll" (ByRef result As Long) As Long
Private Sub Command1_Click()
Dim handle As Long
Dim outDir As String
Dim rv As Long
Dim lpszExt As String
Dim lpszDefExt As String
lpszExt = "All Files|*.bmp|"
lpszDefExt = "bmp"
rv = S_FALSE
rv = IEShowSaveFileDialog( _
vbNull, _
"", _
"C:\", _
lpszExt, _
lpszDefExt, _
1, _
OFN_OVERWRITEPROMPT, _
outDir, _
handle)
MsgBox rv & ":" & outDir & ":" & handle & vbCrLf & "rv outDir handle"
End Sub
> 開発環境：VB6SP6、Windows7です。
実行環境としては、
・Windows 7 64bit版 + IE 64bit版(InPrivate ブラウズ有効)
・Windows 7 64bit版 + IE 64bit版(InPrivate ブラウズ無効)
・Windows 7 64bit版 + IE 32bit版(InPrivate ブラウズ有効)
・Windows 7 64bit版 + IE 32bit版(InPrivate ブラウズ無効)
・Windows 7 32bit版 + IE 32bit版(InPrivate ブラウズ有効)
・Windows 7 32bit版 + IE 32bit版(InPrivate ブラウズ無効)
といった組み合わせが考えられそうですね。
念のため、Windows 7 の Service Pack 状況と、
Internet Explorer のバージョンと SP も明記してください。
> IEShowSaveFileDialog関数がE_ACCESSDENIEDを返してしまい、
E_ACCESSDENIED が返されるということは、下記のコードを実行したときに、
『実行時エラー '70': 書き込みできません。』になるということでしょうか。
If rv <> 0 Then
On Error Resume Next
Err.Raise rv 'HRESULT の内容確認
MsgBox "実行時エラー:" & CStr(Err.Number) _
& "(0x" & Right(String(8, "0") & Hex(rv), 8) & ")" _
& Err.Description
On Error GoTo 0
End If
> ByVal initialFileName As String, _
API が求めているのは『__in LPWSTR lpwstrInitialFileName』ですが、
上記の定義だと、LPWSTR ではなく LPSTR の呼び出しになってしまいます。
LPWSTR に渡す場合は、宣言側を ByRef Byte (あるいは ByRef Any) にして、
Dim b() As Byte
b = "文字列" & vbNullChar
ret = ApiFunction( b(0) )
のように、バイト配列の先頭要素として渡してあげてください。
> ByRef filePath As String, _
その宣言で受け取れるのは、BSTR* の場合かと思います。実際には
『__out LPWSTR *lppwstrDestinationFilePath』が求められていますので、
ByVal Long あたりで宣言した方が都合が良いのでは無いでしょうか。
> rv = IEShowSaveFileDialog( _
> vbNull, _
第一引数は
| hwnd [in]
| A handle to the owner window of the dialog box.
| Must be a valid handle to a window that the control owns.
ですから、これは明らかに違うと思いますよ。
そもそも『vbNull』というのは、API にとっては整数値「1」と同義です。
vbNull は VbVarType 列挙型として定義されており、これは
Select Case VarType(variantValue)
Case vbEmpty '= 0
MsgBox "これは Empty です。"
Case vbNull '= 1
MsgBox "これは Null です。"
Case vbInteger '= 2
MsgBox "これは Integer です。"
Case vbLong '= 3
MsgBox "これは Long です。"
：
：
End Select
のように、VarType に「Null 値」が渡されたことを意味する定数です。
もしも C 言語でいうところの NULL 値を指定したいのであれば、ByVal 0& を渡しましょう。
＞といった組み合わせが考えられそうですね。
＞念のため、Windows 7 の Service Pack 状況と、
＞Internet Explorer のバージョンと SP も明記してください。
Windows7はSPなしの32bit版です。
IEは、IE8 32bit版(InPrivate ブラウズ無効)です。
InPrivate ブラウズ、初めて知りました。
＞> IEShowSaveFileDialog関数がE_ACCESSDENIEDを返してしまい、
＞E_ACCESSDENIED が返されるということは、下記のコードを実行したときに、
＞『実行時エラー '70': 書き込みできません。』になるということでしょうか。
はい、そうです。
＞API が求めているのは『__in LPWSTR lpwstrInitialFileName』ですが、
＞上記の定義だと、LPWSTR ではなく LPSTR の呼び出しになってしまいます。
＞> ByRef filePath As String, _
LPSTRの呼び出し方で正しいと思ってました。
大間違いですね。
＞もしも C 言語でいうところの NULL 値を指定したいのであれば、ByVal 0& を渡しましょう。
これも知りませんでした。
丁寧にありがとうございました。
で、ここまでの情報を踏まえていろいろ試した結果、
第一引数にNULLではなくハンドルを渡すことと
LPWSTRの呼び出し方を正しく変えることにより、
ダイアログが表示され、正常終了が返るようになりました。
第八引数で値を受けることはできていませんが・・・。
＞> ByRef filePath As String, _
＞その宣言で受け取れるのは、BSTR* の場合かと思います。実際には
＞『__out LPWSTR *lppwstrDestinationFilePath』が求められていますので、
＞ByVal Long あたりで宣言した方が都合が良いのでは無いでしょうか。
こちら、ByVal Longで宣言してStrPtr関数でアドレスを渡してみましたが、
何の値も受け取れていません。もうちょっと調べて何とかしたいと思います。
> こちら、ByVal Longで宣言してStrPtr関数でアドレスを渡してみましたが、
相手が LPCWSTR の場合は、その方法で良さそうですけれどね(SetWindowTextW など)。
今回は LPWSTR* なので、その方法では駄目だと思います。
> 何の値も受け取れていません。
試していませんが、こんな感じでどうでしょう。
(1) Long 型の変数を用意する。
(2) APIに対して、その変数のアドレス(VarPtr)を値渡しするか、または、変数を参照渡しする。
(3) API 側で Unicode 文字列が生成され、その先頭アドレスが 1 の変数に書き込まれる。
(4) 3 が指す Unicode文字列の長さを、lstrlenW API で調べる。
(5) その文字列が格納可能な領域を Byte 配列を ReDim で確保する。
(6) 3 が指す Unicod 文字列を、lstrcpyW API か RtlMoveMemory API で 5 に書き込む。
(7) 6 のUnicode バイナリを String 変数に代入する。NULL 終端が含まれていればそれも取り除く。
(8) DLL で確保されていたメモリは不要なので、1 が指すポインタを CoTaskMemFree API で解放する。
壁が多くて難儀しています。
＞(4) 3 が指す Unicode文字列の長さを、lstrlenW API で調べる。
これはクリアしました。
ダイアログで選択するフォルダを変えると、文字列長が変わります。
＞(6) 3 が指す Unicod 文字列を、lstrcpyW API か RtlMoveMemory API で 5 に書き込む。
＞(7) 6 のUnicode バイナリを String 変数に代入する。NULL 終端が含まれていればそれも取り除く。
ここが上手くいっていないようです。
ちょっと時間がかかりそうです。
'保護モードAPI
Private Declare Function IESaveFile Lib "Ieframe.dll" (ByVal hstate As Long, ByVal sourceFile As Long) As Long
Private Declare Function IEShowSaveFileDialog Lib "Ieframe.dll" _
(ByVal hwnd As Long, _
ByVal initialFileName As Long, _
ByVal initialDir As Long, _
ByVal fileFilter As Long, _
ByVal defExtention As Long, _
ByVal filterIndex As Long, _
ByVal flag As Long, _
ByRef filePath As Long, _
ByRef handle As Long) As Long
Private Declare Function lstrlenW _
Lib "kernel32" _
(ByVal lpString As Long) _
As Long
'メモリブロックを移動する関数の宣言
Private Declare Sub RtlMoveMemory Lib "kernel32" _
(Destination As Any, _
Source As Any, _
ByVal length As Long)
' CoTaskMemFree 関数
Private Declare Sub CoTaskMemFree Lib "OLE32.DLL" (ByVal pv As Long)
Dim handle As Long
Dim outDir As String
Dim rv As Long
Dim hwnd As Long
Dim lpszExt As String
Dim lpszDefExt As String
lpszExt = "All Files|*.*|"
lpszDefExt = ""
hwnd = GetForegroundWindow()
rv = S_FALSE
Dim outDirPtr As Long
rv = IEShowSaveFileDialog( _
hwnd, _
StrPtr("testdata.txt"), _
StrPtr(""), _
StrPtr(lpszExt), _
StrPtr(lpszDefExt), _
1, _
OFN_OVERWRITEPROMPT, _
outDirPtr, _
handle)
MsgBox outDirPtr & vbCrLf & "outDirPtr"
Dim length As Long
Dim bytedata() As Byte
Dim outStr As String
length = lstrlenW(outDirPtr)
MsgBox "文字列長:" & length
ReDim bytedata(0 To length * 2)
Call RtlMoveMemory(bytedata(0), outDirPtr, lngLengthChar * 2)
outStr = StrConv(bytedata, vbFromUnicode)
MsgBox outStr
outStr = StrConv(bytedata, vbUnicode)
MsgBox outStr
outStr = bytedata
MsgBox outStr
Call CoTaskMemFree(outDirPtr)
> rv = IEShowSaveFileDialog( _
> hwnd, _
> StrPtr("testdata.txt"), _
> StrPtr(""), _
> StrPtr(lpszExt), _
> StrPtr(lpszDefExt), _
> 1, _
> OFN_OVERWRITEPROMPT, _
> outDirPtr, _
> handle)
今回の API が、文字列引数に「LPCWSTR」と「LPWSTR」の
2 種類が使われていることに注意してください。
型名に含まれる "C" は、CONST 引数であることを意味しています。
(LP は LONG POINTER、W は WIDE(Unicode)、STR はもちろん文字列です)
先にも書きましたが、LPWSTR (あるいは LPCWSTR) に対しては、
Dim b() As Byte
b = "文字列" & vbNullChar
ret = ApiFunction( b(0) ) 'ByRef Byte
のように、バイト配列にコピーした後、その先頭要素への参照を渡した方が無難です。
相手が LPCWSTR(C 付き) な引数である場合には、
Dim s As String
s = "文字列"
ret = ApiFunction( StrPtr(s) ) 'ByVal Long
でも同じ効果が得られるかと思いますが、これを LPWSTR(C 無し)に対して使うのは
安全ではありません。LPCWSTR の場合は参照先が変更されないことが
保証されていますが、LPWSTR の場合は保証されていません。
文字列部(StrPtr)だけ変更されて、データ長部(StrPtr - 4)が変更されないと
不整合を起こしかねません。(変更されなければ問題は出ないのですが)
それと、"testdata.txt" などの「文字列リテラル」を C 抜きの文字列型に対して渡すのも
一応避けておいた方が良いでしょう。「変数」を経由して渡すことをお勧めします。
> length = lstrlenW(outDirPtr)
> ReDim bytedata(0 To length * 2)
Unicode 文字列を Byte 配列で確保する場合、配列のインデックスは
1 文字なら、0〜1
2 文字なら、0〜3
3 文字なら、0〜5
となるはずですが、上記ではそうなっていませんよね。
> outStr = StrConv(bytedata, vbFromUnicode)
> outStr = StrConv(bytedata, vbUnicode)
これはどちらも化けるでしょうね。やるとすれば
outStr = bytedata
outStr = StrConv(bytedata, 0)
outStr = CStr(bytedata)
のいずれかだと思いますよ。(未検証)
> Call RtlMoveMemory(bytedata(0), outDirPtr, lngLengthChar * 2)
lngLengthCharなんて変数(？)が突然、出てきますが
コピー元は、参照渡しではなくて値渡ししないと。
RtlMoveMemory bytedata(0), ByVal outDirPtr, length * 2
魔界の仮面弁士さん、度々ご指摘ありがとうございます。
APIをVB6で動作させるための知識が欠落していることが
よく分かったので、勉強しなおします。
> Call RtlMoveMemory(bytedata(0), outDirPtr, lngLengthChar * 2)
kumattiさん、ご指摘ありがとうございます。
lngLengthCharはlengthの間違いでした。
本ソースはlengthだったので、写し間違いだと思われます。
依然、LPCWSTR*から文字列を取得するところで苦戦しております。
＞ outStr = bytedata
＞ outStr = StrConv(bytedata, 0)
＞ outStr = CStr(bytedata)
魔界の仮面弁士さんから頂いた上のコードでも
文字列を取得することはできないままです。
何か勘違いかミスをしているのだと思うのですが・・・。
ポインタは取得できているのに。（lstrlenWは正しい値を返します）
ポインタから文字列を取得するところで
上手くいっていないのだと思います。
もうしばらく頑張ってみます。
>> Call RtlMoveMemory(bytedata(0), outDirPtr, lngLengthChar * 2)
> lngLengthCharはlengthの間違いでした。
> 本ソースはlengthだったので、写し間違いだと思われます。
kumatti さんが指摘されていたのは、変数名のスペルミスだけではありませんよね。
> 依然、LPCWSTR*から文字列を取得するところで苦戦しております。
LPWSTR*ではなく?
> ポインタは取得できているのに。（lstrlenWは正しい値を返します）
> ポインタから文字列を取得するところで
> 上手くいっていないのだと思います。
lstrlenW に渡している ByVal Long 値は、Unicode 文字列への
ポインタですよね。ということは、そのアドレスが指す場所を
取得すると、文字列の先頭文字になるはず。もしもそうなっていないなら、
RtlMoveMemory の呼び出し方が間違っているのではないでしょうか。