- 題名: IPersistFileのクラスを作成使用するには？
- 日時: 2012/08/26 19:54:39
- ID: 30853
- この記事の返信元:
- （なし）
- この記事への返信:
- [30855] Re[1]: IPersistFileのクラスを作成使用するには？2012/08/26 23:40:37
- ツリーを表示
DOBON.NETプログラミング掲示板過去ログ
■No30853に返信(ミソモさんの記事)
> ExcelVBAで稼働していたものをVB2005expressで作る必要に迫られ困っています
VBA には VBA の、.NET には .NET の流儀があるので…そのまま置き換えても駄目ですよ。
> MSXML2.XMLHTTP30ClassによるResponsetextの取得まで問題ありません
MSXML3 は OOM コンポーネントですので、VB2005 から利用するのであれば、
WebRequest / WebResponse クラスに差し替えた方が良いでしょう。
> SetObject()の実行時に、メモリアドレスの取得に失敗しますので正しいコードを指導願います
API の宣言が間違っているのが原因でしょうね…。
それと、その引数に渡すべきオブジェクトは、ActiveX 版の WebBrowser ならば
VBA の場合と同様に AxWebBrowser1.Document で良いと思いますが、
マネージの System.Windows.Forms.WebBrowset を使っているなら、
WebBrowser1.Document を渡すのではなく、
WebBrowser1.Document.DomDocument を渡す必要があります。
> 2．IPersistFileクラスが完成したとして、SetObject(ByVal Source As Object)
> の引数に入れるべきobjectがわかりません
使いたいのは IPersistStreamInit ではなく、IPersistFile なのですね?
.NET の場合は、標準で IPersistFile インターフェイスが用意されているため、
わざわざ自分で {0000010b-0000-0000-C000-000000000046} な
インターフェイスを用意せずとも
Dim p As System.Runtime.InteropServices.ComTypes.IPersistFile
p = WebBrowser1.Document.DomDocument
p.Save("C:\temp\test.html",True)
System.Runtime.InteropServices.Marshal.ReleaseComObject(p)
だけで保存できますよ。
# .NET 1.x では System.Runtime.InteropServices.UCOMIPersistFile で代用。
> Dim stm As New PersistStreamInit 'yu-tang氏作成のClass(公開)
IPersistStreamInit を使いたいなら、IID は
{7FD52380-4E07-101B-AE2D-08002B2EC713} です。
一応、GAC から Microsoft.VisualStudio.OLE.Interop.dll を参照設定すれば、
Microsoft.VisualStudio.OLE.Interop.IPersistStreamInit を利用できますが…。
> Private Structure UUID
この UUID というのは、.NET でいうところの System.Guid 構造体のことなので
わざわざ再定義する必要は無かったりします。
まぁ、再定義したいのであればそれでも構いませんが、見た感じ、
VBA から .NET へのデータ型の置き換えに失敗しているようですね。
VBA の Integer 型 は、VB.NET では System.Int16 構造体(すなわち、Short 型)に相当します。
VBA の Long 型 は、VB.NET では System.Int32 構造体(すなわち、Integer型)に相当します。
VBA の LongLong 型 は、VB.NET では System.Int64 構造体(すなわち、Long 型)に相当します。
VBA の LongPtr 型 は、VB.NET では System.IntPtr構造体に相当します。
参考にしているコードは x86 版の VBA/VB6 でしょうから、LongLong / LongPtr 型は無かったかもしれませんが、
いずれにせよ Integer だった箇所は Short に置き換えるべきですし、Long も Long のままでは NG です。
(VBA で Long だった箇所は、文脈によって Integer に置き換える場合と、IntPtr に置き換える場合とがあります。
> ReDim mudtIPersistFile.Data4(7)
> '{0000010b-0000-0000-C000-000000000046}
> With mudtIPersistFile
> .Data1 = &H10B
> .Data4(0) = &HC0
> .Data4(7) = &H46
> End With
これも、本来は
Private IID_IPersistFile As New Guid("{0000010b-0000-0000-C000-000000000046}")
という一行で済ませられますよ。
とはいえ今回のケースにおいては IPersistFile 自体がすでに
System.Runtime.InteropServices.ComTypes 名前空間にて
提供されているので、そもそもこのクラスを作る意味すらないのですけれどね。
冗長な質問にも関わらず、丁寧な説明いただき感謝しきりです
ご忠告に従い、まずはWebRequest/WebResponseを使用する事から始めました
http://dobon.net/vb/dotnet/internet/webrequest.html
の丸写しですので当然ですが無事ソースを取得できました
********************************************************************************
sub test
Dim enc As System.Text.Encoding = _
System.Text.Encoding.GetEncoding("shift_jis")
Dim postData As String = "xxxxxxx"
Dim postDataBytes As Byte() = _
System.Text.Encoding.ASCII.GetBytes(postData)
Dim req As System.Net.WebRequest = _
System.Net.WebRequest.Create("http://xxx")
req.Method = "POST"
req.ContentType = "application/x-www-form-urlencoded"
req.ContentLength = postDataBytes.Length
Dim reqStream As System.IO.Stream = req.GetRequestStream()
reqStream.Write(postDataBytes, 0, postDataBytes.Length)
reqStream.Close()
Dim res As System.Net.WebResponse = req.GetResponse()
Dim resStream As System.IO.Stream = res.GetResponseStream()
Dim sr As New System.IO.StreamReader(resStream, enc)
Debug.Print(sr.ReadToEnd())
sr.Close()
end sub
文字化けしますので、これから文字コードの変換方法を調べます
********************************************************************************
> Dim p As System.Runtime.InteropServices.ComTypes.IPersistFile
> p = WebBrowser1.Document.DomDocument
> p.Save("C:\temp\test.html",True)
> System.Runtime.InteropServices.Marshal.ReleaseComObject(p)
今の私ではWebBrowser1をブラウザ立ち上げずに使用する方法がわかりませんが
IPersistFileをこうして使用出来ることがわかり、諸々調べる道筋がはっきりしました
参照先としてしか調べていませんでしたので、msdnの情報の活かし方が全くわからなかった次第です
ひとつひとつが、今後の勉強の指針となりました
非力につき最終的な解決までは日数かかりますので、
追って結果を報告申し上げたいと思います
まずは魔界の仮面弁士さんへ重ねて御礼申し上げます、ありがとうございました
分類:[.NET]
2012/08/26(Sun) 21:20:17 編集(投稿者)
2012/08/26(Sun) 19:57:29 編集(投稿者)
ブラウザを起動せずにパラメータ送信必要なWebソースの取得をしようとしてます
次のように使用するつもりです
text(0) = doc.all(100).innertext
ExcelVBAで稼働していたものをVB2005expressで作る必要に迫られ困っています
MSXML2.XMLHTTP30ClassによるResponsetextの取得まで問題ありません
(responsexmlは取得されません)
********************************************************************************
大きく分けて2点教えていただきたいです
1．既出の”「WebBrowser」でソースコードを取得するには?”
http://hpcgi1.nifty.com/MADIA/VBBBS/wwwlng.cgi?print+200310/03100017.txt
を参考に（以下、原本と記載）クラスモジュールを以下のように改変しましたが、
SetObject()の実行時に、メモリアドレスの取得に失敗しますので正しいコードを指導願います
2．IPersistFileクラスが完成したとして、SetObject(ByVal Source As Object)
の引数に入れるべきobjectがわかりません
（1に記載した”SetObject()の実行時”は仕方なしにResponsetextを引数としました）
同様のことをExcel VBAで行なっていたときは
-----------------------------
Dim stm As New PersistStreamInit 'yu-tang氏作成のClass(公開)
Set doc = New MSHTML.HTMLDocument
...(略).....
stm = doc
stm.Load Http.ResponseStream
text(0) = doc.all(100).innertext
-------------------------------
としていましたが、docにあたるものをVBで作ることができません
'1.クラスモジュールIPersistFile.vbのコード
Option Explicit On
Imports System.Runtime.InteropServices
Public Class Persistfile
Private Structure UUID
Public Data1 As Long
Public Data2 As Integer
Public Data3 As Integer
Public Data4() As Byte
End Structure
Private mudtIPersistFile As UUID
Private Const autCCStdCall = 4
Private Declare Function DispCallFunc Lib "oleaut32" _
(ByVal pvInstance As Long, _
ByVal oVft As Long, _
ByVal CallConv As Integer, _
ByVal vtReturn As Integer, _
ByVal cActuals As Long, _
ByRef prgvt As Integer, _
ByRef prgpvarg As Long, _
ByRef pvargResult As Object _
) As Long
Private mobjSource As Object
Private mlpPersistFile As Long
Private Const comIUnknown_QueryInterface = 0
Private Const comIUnknown_Release = 8
Private Const comIPersistFile_Save = 24
Public Sub New()
ReDim mudtIPersistFile.Data4(7)
'{0000010b-0000-0000-C000-000000000046}
With mudtIPersistFile
.Data1 = &H10B
.Data4(0) = &HC0
.Data4(7) = &H46
End With
End Sub
Public Sub SetObject(ByVal Source As Object)
'******以下宣言部でError"オブジェクトに、プリミティブでないか、
' または blittable でないデータが含まれています。"**********
Dim gch1 As GCHandle = GCHandle.Alloc(Source, GCHandleType.Pinned)
Dim Adr1 As Integer = gch1.AddrOfPinnedObject().ToInt32()
Dim gch2 As GCHandle = GCHandle.Alloc(mudtIPersistFile, GCHandleType.Pinned)
Dim Adr2 As Integer = gch2.AddrOfPinnedObject().ToInt32()
Dim gch3 As GCHandle = GCHandle.Alloc(mlpPersistFile, GCHandleType.Pinned)
Dim Adr3 As Integer = gch3.AddrOfPinnedObject().ToInt32()
'***************************************************************************
mobjSource = Source
If Source Is Nothing Then
mlpPersistFile = 0
Else
Dim hResult As Long
If mlpPersistFile <> 0 Then
Call Invoke_(mlpPersistFile, comIUnknown_Release)
mlpPersistFile = 0
End If
hResult = Invoke_(Adr1, comIUnknown_QueryInterface, _
Adr2, Adr3)
If hResult < 0 Then
mlpPersistFile = 0
Err.Raise(hResult)
End If
End If
gch1.Free()
gch2.Free()
gch3.Free()
End Sub
Public Sub Save(ByVal pszFileName As String, ByVal fRemember As Boolean)
Dim bytFileName() As Byte
Dim hResult As Long
Dim lngBool As Long
ReDim bytFileName(0) '*************(*)1
Dim gch4 As GCHandle = GCHandle.Alloc(bytFileName(0), GCHandleType.Pinned)
Dim Adr4 As Integer = gch4.AddrOfPinnedObject().ToInt32()
If mlpPersistFile = 0 Then
Err.Raise(91)
Exit Sub
End If
bytFileName(0) = pszFileName & vbNullChar '*************(*)2
lngBool = IIf(fRemember, 1&, 0&)
hResult = Invoke_(mlpPersistFile, comIPersistFile_Save, _
Adr4, lngBool)
If hResult <> 0 Then
Err.Raise(hResult)
End If
gch4.Free()
End Sub
Private Function Invoke_(ByVal lpObject As Long, ByVal VtblOffset As Long, _
ByVal ParamArray Args() As Object) As Long
Dim lngPtArgs() As Long
Dim intVtArgs() As Integer
Dim varResult As Object
Dim lngArgs As Long
Dim n As Long
Dim gch5 As GCHandle = GCHandle.Alloc(Args(n), GCHandleType.Pinned)
Dim Adr5 As Integer = gch5.AddrOfPinnedObject().ToInt32()
If lpObject = 0 Then
Exit Function
End If
lngArgs = UBound(Args) - LBound(Args) + 1
If lngArgs = 0 Then
ReDim lngPtArgs(0), intVtArgs(0)
Else
ReDim lngPtArgs(lngArgs - 1), intVtArgs(lngArgs - 1)
For n = 0 To lngArgs - 1
intVtArgs(n) = VarType(Args(n))
lngPtArgs(n) = Adr5
Next
End If
n = 0
n = DispCallFunc(lpObject, VtblOffset, autCCStdCall, _
vbLong, lngArgs, intVtArgs(0), lngPtArgs(0), varResult)
If n >= 0 Then
Invoke_ = CLng(varResult)
End If
gch5.Free()
End Function
Protected Overrides Sub finalize()
Call Invoke_(mlpPersistFile, comIUnknown_Release)
mlpPersistFile = 0
mobjSource = Nothing
End Sub
End Class
--------------------------
(*)1は原本にはないものだが(*)2の原本において配列のErrorが出るため追加
(*)2の原本は bytFileName = pszFileName & vbNullChar
********************************************************************************
長くなり申し訳ありませんが、ご指導願います