もっと早く更新するつもりがいつのまにやら。
では前回のコードの 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
