2006年03月05日

アンマネージドメモリへの手抜き VB.NET編

もっと早く更新するつもりがいつのまにやら。

では前回のコードの VB.NET 編です。キーワードの色つけはやってません(甚だしい手抜き)。

それと同時に、XML コメント付きの C# ソースへのリンクも。但しこちらは名前空間付いてますのでちょこっとだけ注意。

UnmanagedMemory.vb

Imports System
Imports System.ComponentModel
Imports System.Runtime.InteropServices

Public MustInherit Class UnmanagedMemory
    Implements IDisposable
    Public MustOverride Sub ReadToPtr(
            ByVal dest As IntPtr, ByVal size As Integer, 
            ByVal offset As Integer)
    Public MustOverride Function ReadBytes(
            ByVal length As Integer, ByVal offset As Integer)
            As Byte()
    Public MustOverride Function ReadStructure(
            ByVal type As Type, ByVal offset As Integer) As Object
    Public MustOverride Function ReadString(
            ByVal charSet As CharSet, ByVal offset As Integer)
            As String
    Public MustOverride Sub Write(
            ByVal value As Object, ByVal offset As Integer)
    Public MustOverride Sub Write(
            ByVal value As Byte(), ByVal offset As Integer)
    Public MustOverride Sub Write(
            ByVal ptr As IntPtr, ByVal size As Integer, 
            ByVal offset As Integer)
    Public MustOverride Function Write(
            ByVal value As String, ByVal charSet As CharSet, 
            ByVal offset As Integer) As Integer
    Public MustOverride Sub Clear(
            ByVal size As Integer, ByVal offset As Integer)
    Protected MustOverride Sub Dispose(
            ByVal disposing As Boolean)
    Protected Sub New()
    End Sub
    Public MustOverride ReadOnly Property Address() As IntPtr
    Public Overridable Function Offset(
            ByVal offsetValue As Integer) As IntPtr
        If Me.Address.Equals(IntPtr.Zero) Then
            Throw New InvalidOperationException(
                "まだこのインスタンスにポインタが割り当てられていないか、"
                + "または既に解放済みです。")
        End If
        If offsetValue < 0 Then
            Throw New ArgumentOutOfRangeException(
                "offsetValue", offsetValue,
                "0 未満にすることはできません。")
        End If
        Return New IntPtr(Me.Address.ToInt64() + offsetValue)
    End Function
    Public Overridable Sub ReadToPtr(
            ByVal dest As IntPtr, ByVal size As Integer)
        Me.ReadToPtr(dest, size, 0)
    End Sub
    Public Overridable Function ReadBytes(ByVal length As Integer) As Byte()
        Return Me.ReadBytes(length, 0)
    End Function
    Public Overridable Function ReadStructure(ByVal type As Type) As Object
        Return Me.ReadStructure(type, 0)
    End Function
    Public Overridable Function ReadString() As String
        Return Me.ReadString(CharSet.Auto, 0)
    End Function
    Public Overridable Function ReadString(ByVal charSet As CharSet) As String
        Return Me.ReadString(charSet, 0)
    End Function
    Public Overridable Sub Write(ByVal value As Object)
        Me.Write(value, 0)
    End Sub
    Public Overridable Sub Write(ByVal value As Byte())
        Me.Write(value, 0)
    End Sub
    Public Overridable Sub Write(ByVal ptr As IntPtr, ByVal size As Integer)
        Me.Write(ptr, size, 0)
    End Sub
    Public Overridable Function Write(ByVal value As String) As Integer
        Return Me.Write(value, CharSet.Auto, 0)
    End Function
    Public Overridable Function Write(
            ByVal value As String, ByVal charSet As CharSet) As Integer
        Return Me.Write(value, charSet, 0)
    End Function
    Public Overridable Sub Clear(ByVal size As Integer)
        Me.Clear(size, 0)
    End Sub
    Public Sub Dispose() Implements IDisposable.Dispose
        Me.Dispose(True)
        GC.SuppressFinalize(Me)
    End Sub
    Public Sub Free()
        Me.Dispose()
    End Sub
    Protected Overrides Sub Finalize()
        Me.Dispose(False)
    End Sub
End Class

SimpleMemory.vb

Imports System
Imports System.Collections
Imports System.ComponentModel
Imports System.Runtime.InteropServices
Imports System.Text
Imports Microsoft.VisualBasic

Public MustInherit Class SimpleMemory
    Inherits UnmanagedMemory
    Protected Sub New()
        MyBase.New()
    End Sub
    Public Overloads Overrides Sub ReadToPtr(
         ByVal dest As IntPtr, ByVal size As Integer, ByVal offset As Integer)
        If size < 0 Then
            Throw New ArgumentOutOfRangeException(
                "size", size, "サイズを 0 よりも小さくすることはできません。")
        End If
        SimpleMemory.MoveMemory(dest, Me.Offset(offset), New IntPtr(size))
    End Sub
    Public Overloads Overrides Function ReadBytes(
         ByVal length As Integer, ByVal offset As Integer) As Byte()
        If length < 0 Then
            Throw New ArgumentOutOfRangeException(
                "length", length, "長さを 0 よりも小さくすることはできません。")
        End If
        Dim array As Byte() = New Byte(length) {}
        If length = 0 Then
            Return array
        End If
        Marshal.Copy(Me.Offset(offset), array, 0, length)
        Return array
    End Function
    Public Overloads Overrides Function ReadStructure(
         ByVal type As Type, ByVal offset As Integer) As Object
        Return Marshal.PtrToStructure(Me.Offset(offset), type)
    End Function
    Public Overloads Overrides Function ReadString(
         ByVal charSet As CharSet, ByVal offset As Integer) As String
        Select Case charSet
            Case charSet.Auto
                Return Marshal.PtrToStringAuto(Me.Offset(offset))
            Case charSet.Unicode
                Return Marshal.PtrToStringUni(Me.Offset(offset))
            Case charSet.Ansi, charSet.None
                Return Marshal.PtrToStringAnsi(Me.Offset(offset))
            Case Else
                Throw New InvalidEnumArgumentException(
                     "charSet", charSet, GetType(CharSet))
        End Select
    End Function
    Public Overloads Overrides Sub Write(
         ByVal value As Object, ByVal offset As Integer)
        If value Is Nothing Then
            Marshal.WriteIntPtr(Me.Offset(offset), IntPtr.Zero)
        Else
            Marshal.StructureToPtr(value, Me.Offset(offset), True)
        End If
    End Sub
    Public Overloads Overrides Sub Write(
         ByVal value As Byte(), ByVal offset As Integer)
        Marshal.Copy(value, 0, Me.Offset(offset), value.Length)
    End Sub
    Public Overloads Overrides Sub Write(
         ByVal ptr As IntPtr, ByVal size As Integer, ByVal offset As Integer)
        If size <= 0 Then
            Throw New ArgumentOutOfRangeException(
                "size", size, "サイズを 0 以下にすることはできません。")
            SimpleMemory.MoveMemory(Me.Offset(offset), ptr, New IntPtr(size))
        End If
    End Sub
    Public Overloads Overrides Function Write(
         ByVal value As String, ByVal charSet As CharSet,
         ByVal offset As Integer) As Integer
        Dim data As Byte() = Nothing
        Select Case charSet
            Case charSet.Auto
                If Marshal.SystemDefaultCharSize = 2 Then
                    data = Encoding.Unicode.GetBytes(value + Chr(0))
                Else
                    data = Encoding.Default.GetBytes(value + Chr(0))
                End If
            Case charSet.Unicode
                data = Encoding.Unicode.GetBytes(value + Chr(0))
            Case charSet.Ansi
                data = Encoding.Default.GetBytes(value + Chr(0))
            Case Else
                Throw New InvalidEnumArgumentException(
                     "charSet", charSet, GetType(CharSet))
        End Select
        Me.Write(data, offset)
        Return data.Length
    End Function

    Public Overloads Overrides Sub Clear(
         ByVal size As Integer, ByVal offset As Integer)
        If size < 0 Then
            Throw New ArgumentOutOfRangeException(
                "size", size,
                "サイズを 0 よりも小さい値にすることはできません。")
        End If
        Me.Write(New Byte(size) {}, offset)
    End Sub

    Private Declare Sub MoveMemory Lib "Kernel32.dll" (
         ByVal dest As IntPtr, ByVal source As IntPtr, ByVal size As IntPtr)

End Class

CoTaskMem.vb

Imports System
Imports System.ComponentModel
Imports System.Runtime.InteropServices

Public NotInheritable Class CoTaskMem
    Inherits SimpleMemory

    Private addr As IntPtr
    Public Overrides ReadOnly Property Address() As IntPtr
        Get
            Return Me.Address
        End Get
    End Property
    Public Sub New(ByVal size As Integer)
        Me.addr = Marshal.AllocCoTaskMem(size)
    End Sub
    Public Sub New(ByVal ptr As IntPtr)
        Me.addr = ptr
    End Sub
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If Not (Me.addr.Equals(IntPtr.Zero)) Then
            Marshal.FreeCoTaskMem(Me.addr)
            Me.addr = IntPtr.Zero
        End If
    End Sub
    Public Shared Function FromString(ByVal value As String) As CoTaskMem
        If value Is Nothing Then
            Throw New ArgumentNullException(
                "value", "null を指定することはできません。")
        End If
        Return New CoTaskMem(Marshal.StringToCoTaskMemAuto(value))
    End Function
    Public Shared Function FromString(
         ByVal value As String, ByVal charSet As CharSet) As CoTaskMem
        If value Is Nothing Then
            Throw New ArgumentNullException(
                "value", "null を指定することはできません。")
        End If
        Select Case charSet
            Case charSet.Auto
                Return CoTaskMem.FromString(value)
            Case charSet.Unicode
                Return New CoTaskMem(Marshal.StringToCoTaskMemUni(value))
            Case charSet.Ansi, charSet.None
                Return New CoTaskMem(Marshal.StringToCoTaskMemAnsi(value))
            Case Else
                Throw New InvalidEnumArgumentException(
                    "charSet", charSet, GetType(CharSet))
        End Select
    End Function
    Public Shared Function FromStructure(ByVal value As Object) As CoTaskMem
        If value Is Nothing Then
            Throw New ArgumentNullException(
                "value", "null を指定することはできません。")
        End If
        Dim ptr As IntPtr = Marshal.AllocCoTaskMem(Marshal.SizeOf(value))
        Marshal.StructureToPtr(value, ptr, False)
        Return New CoTaskMem(ptr)
    End Function
    Public Shared Function FromBytes(ByVal value As Byte()) As CoTaskMem
        If value Is Nothing Then
            Throw New ArgumentNullException(
                "value", "null を指定することはできません。")
        End If
        Dim ptr As IntPtr = Marshal.AllocCoTaskMem(value.Length)
        Marshal.Copy(value, 0, ptr, value.Length)
        Return New CoTaskMem(ptr)
    End Function
End Class
posted by Hongliang at 10:33| Comment(2) | TrackBack(0) | VB.NET | このブログの読者になる | 更新情報をチェックする
この記事へのコメント
是非この機会に当サイト委託販売をご利用ください。委託販売商品リストは下記URLからどうぞ。
Posted by アラド戦記 rmt at 2011年12月04日 08:04
阪神ジュベナイルフィリーズ 最新情報をもとにオッズに惑わされない独自の予想法で万馬券を掴みとれ!競馬歴の長い人も必見の誰もが驚く枠馬を大公開!
Posted by 阪神ジュベナイルフィリーズ at 2011年12月05日 02:33
コメントを書く
お名前:

メールアドレス:

ホームページアドレス:

コメント:

認証コード: [必須入力]


※画像の中の文字を半角で入力してください。

この記事へのトラックバック

ここ(hongliang.seesaa.net)で公開しているものについて、利用は自由に行って頂いて構いません。改変、再頒布もお好きになさって下さい。利用に対しこちらが何かを要求することはありません。

ただし、公開するものを使用、または参考したことによって何らかの損害等が生じた場合でも、私はいかなる責任も負いません。

あ、こんなのに使ったってコメントを頂ければ嬉しいです。

×

この広告は1年以上新しい記事の投稿がないブログに表示されております。