リファラを見ているとですね、大体今まで書いた中でどんな記事に人気があるのか見えてくるんですね。で、最近多いなというのがVB.NETと共有メモリの組み合わせ。……折角来て頂いたのにVB.NETのコード書いて無くてすいません。
いや、ツールを使えばいいのかも知れませんが、詳しくないので移植がめんどくさいんですよ。で、Lispでコンバータでもちょちょいと作ろうかと……と、そちらの方にずっぽりはまってしまっていけません。本末転倒というか。私は元々完成品よりも部品を作る方が好きであるというのは自覚もしているのですが。
まあいつまでもそんなこと言ってお客さんを失望させ続けるのも何ですので、今回VB.NETに移植しました。VSがこういうときは大活躍です。
ところでVSに一旦コピーするに当たって大量に出てきたのが、Overloadsキーワードをつけろって警告。C#畑の者として、このキーワードの必然性が良く分からないんですが、一体何で必要なんですかね？ オーバーロードは引数リストを見れば一目瞭然だし（Partialクラスならともかく）、派生クラスにしてもOverridesキーワードを付けてるんだからわざわざOverloadsをつけるのも……。Shadowsするんならともかく。
そもそもVB.NETってキーワードが多いんですよ、やたらと。おかげで命名に苦労するところがある。列挙体のメンバにReadOnlyなんて名前付けるのは良くあることだと思うんですが、これすら[と]でくくらないと使えない。C#のgetキーワードのように、その場面以外では普通に使えるとか……もややこしさの一因になるかな、VB.NETの場合。
まあそんなわけです。どんなわけか知りませんが。
クラスの解説は05/10/22の記事を参照してください。何故かコードはないくせにVB.NETの解説が含まれています。
Imports System
Imports System.ComponentModel
Imports System.Diagnostics
Imports System.Runtime.InteropServices
Imports System.Text
Namespace HongliangSoft.Utilities
Public MustInherit Class SharedMemory
Implements IDisposable
Private m_address As IntPtr
Private m_allocSize As Integer
Public Function GetAddress(ByVal offset As Integer) As IntPtr
Me.ValidateArguments(0, offset)
Return New IntPtr(Me.m_address.ToInt64() + offset)
End Function
Protected Sub SetAddress(ByVal address As IntPtr)
If m_disposed Then
Throw New ObjectDisposedException("", _
"破棄されたインスタンスを再利用することはできません。")
End If
If Not (Me.m_address.Equals(IntPtr.Zero)) Then
Throw New InvalidOperationException( _
"共有メモリのアドレスを再設定することはできません。")
End If
Me.m_address = address
End Sub
Public ReadOnly Property Address() As IntPtr
Get
Me.ValidateArguments(0, 0)
Return m_address
End Get
End Property
Protected Sub ThrowLastWin32Error()
Dim errorCode As Integer = Marshal.GetLastWin32Error()
Dim buffer As StringBuilder = New StringBuilder(256)
FormatMessage(FormatMessageOptions.FromSystem, IntPtr.Zero, errorCode, _
0, buffer, 256, IntPtr.Zero)
Throw New Win32Exception(errorCode, buffer.ToString())
End Sub
Public Shared Function Alloc(ByVal process As IntPtr, _
ByVal size As Integer) As SharedMemory
Dim memory As SharedMemory
If IsNT Then
memory = New SharedMemoryNT(process, size)
Else
memory = New SharedMemory9x(size)
End If
memory.m_allocSize = size
Return memory
End Function
Public Shared Function Alloc(ByVal process As Process, _
ByVal size As Integer) As SharedMemory
Dim memory As SharedMemory
If IsNT Then
memory = New SharedMemoryNT(process, size)
Else
memory = New SharedMemory9x(size)
End If
memory.m_allocSize = size
Return memory
End Function
Public Overridable Overloads Sub Write(ByVal value As Object)
Me.Write(value, 0)
End Sub
Public MustOverride Overloads Sub Write(ByVal value As Object, _
ByVal offset As Integer)
Public Overridable Overloads Sub Write(ByVal value As Byte())
Me.Write(value, 0)
End Sub
Public MustOverride Overloads Sub Write(ByVal value As Byte(), _
ByVal offset As Integer)
Public Overridable Overloads Sub Write(ByVal value As IntPtr, _
ByVal size As Integer)
Me.Write(value, size, 0)
End Sub
Public MustOverride Overloads Sub Write(ByVal value As IntPtr, _
ByVal size As Integer,
ByVal offset As Integer)
Public Overridable Overloads Sub Write(ByVal value As String)
Me.Write(value, 0)
End Sub
Public MustOverride Overloads Sub Write(ByVal value As String,
ByVal offset As Integer)
Public Overridable Overloads Function ReadStructure( _
ByVal type As Type) As Object
Return Me.ReadStructure(type, 0)
End Function
Public MustOverride Overloads Function ReadStructure(ByVal type As Type, _
ByVal offset As Integer) As Object
Public Overridable Overloads Function ReadBytes( _
ByVal size As Integer) As Byte()
Return Me.ReadBytes(size, 0)
End Function
Public MustOverride Overloads Function ReadBytes(ByVal size As Integer, _
ByVal offset As Integer) As Byte()
Public Overridable Overloads Function ReadString( _
ByVal size As Integer) As String
Return Me.ReadString(size, 0)
End Function
Public MustOverride Overloads Function ReadString(ByVal size As Integer, _
ByVal offset As Integer) As String
Public Overridable Overloads Sub ReadToPtr(ByVal dest As IntPtr, _
ByVal size As Integer)
Me.ReadToPtr(dest, size)
End Sub
Public MustOverride Overloads Sub ReadToPtr(ByVal dest As IntPtr, _
ByVal size As Integer, _
ByVal offset As Integer)
Public Sub Free() Implements IDisposable.Dispose
Me.Free(True)
Me.Dispose(True)
GC.SuppressFinalize(Me)
End Sub
Protected MustOverride Sub Free(ByVal disposing As Boolean)
Private Sub Dispose(ByVal disposing As Boolean)
If Not (Me.m_disposed) Then
Me.m_disposed = True
Me.m_address = IntPtr.Zero
End If
End Sub
Protected Overrides Sub Finalize()
Me.Free(False)
Me.Dispose(False)
End Sub
Protected Overridable Sub ValidateArguments(ByVal size As Integer, _
ByVal offset As Integer)
If Me.m_disposed Then
Throw New ObjectDisposedException("", _
"破棄された共有メモリにはアクセスできません。")
End If
If offset < 0 Then
Throw New ArgumentOutOfRangeException( _
"offset", offset, "オフセットを0未満には指定できません。")
End If
If (offset + size) > Me.m_allocSize Then
Throw New ArgumentException( _
"offsetとsizeの合計が、確保したサイズを超えてしまっています。" _
& "確保した以外の領域にアクセスしてしまいます。")
End If
End Sub
Private m_disposed As Boolean = False
Protected Shared ReadOnly Property IsNT() As Boolean
Get
Return Environment.OSVersion.Platform = PlatformID.Win32NT
End Get
End Property
Private Declare Auto Function FormatMessage Lib "kernel32.dll" ( _
ByVal flags As FormatMessageOptions, ByVal source As IntPtr, _
ByVal messageId As Integer, ByVal langId As Integer, _
ByVal buffer As StringBuilder, ByVal size As Integer, _
ByVal arguments As IntPtr) As Integer
<Flags()> Private Enum FormatMessageOptions
MaxWidthMask = &HFF
AllocateBuffer = &H100
IgnoreInserts = &H200
FromString = &H400
FromHModule = &H800
FromSystem = &H1000
ArgumentArray = &H2000
End Enum
Public NotInheritable Class SharedMemoryNT
Inherits SharedMemory
Friend Sub New(ByVal process As IntPtr, ByVal size As Integer)
Me.AllocInternal(process, size)
End Sub
Friend Sub New(ByVal process As Process, ByVal size As Integer)
Me.m_processInstance = process.GetProcessById(process.Id)
Me.AllocInternal(m_processInstance.Handle, size)
End Sub
Private Sub AllocInternal(ByVal process As IntPtr, ByVal size As Integer)
If process.Equals(IntPtr.Zero) Then
Throw New ArgumentException("process", _
"指定したプロセスハンドルは無効です。")
End If
Dim address As IntPtr = VirtualAllocEx(process, IntPtr.Zero, _
size, AllocationTypes.Alloc, _
ProtectTypes.ExecuteReadWrite)
If address.Equals(IntPtr.Zero) Then
MyBase.ThrowLastWin32Error()
End If
Me.m_process = process
MyBase.SetAddress(address)
End Sub
Public Overloads Overrides Sub Write(ByVal value As Object, _
ByVal offset As Integer)
Dim size As Integer = Marshal.SizeOf(value)
Dim ptr As IntPtr = Marshal.AllocCoTaskMem(size)
Try
Marshal.StructureToPtr(value, ptr, True)
Me.Write(ptr, size, offset)
Finally
Marshal.FreeCoTaskMem(ptr)
End Try
End Sub
Public Overloads Overrides Sub Write(ByVal value As Byte(), _
ByVal offset As Integer)
MyBase.ValidateArguments(value.Length, offset)
If Not (WriteProcessMemory(Me.m_process, MyBase.GetAddress(offset), _
value, value.Length, IntPtr.Zero)) Then
MyBase.ThrowLastWin32Error()
End If
End Sub
Public Overloads Overrides Sub Write(ByVal value As IntPtr, _
ByVal size As Integer, _
ByVal offset As Integer)
MyBase.ValidateArguments(size, offset)
If Not (WriteProcessMemory(Me.m_process, MyBase.GetAddress(offset), _
value, size, IntPtr.Zero)) Then
MyBase.ThrowLastWin32Error()
End If
End Sub
Public Overloads Overrides Sub Write(ByVal value As String, _
ByVal offset As Integer)
Me.Write(Encoding.Unicode.GetBytes(value), offset)
End Sub
Public Overloads Overrides Function ReadStructure(ByVal type As Type, _
ByVal offset As Integer) As Object
Dim size As Integer = Marshal.SizeOf(type)
Dim buffer As IntPtr = Marshal.AllocCoTaskMem(size)
Try
Me.ReadToPtr(buffer, size, offset)
Return Marshal.PtrToStructure(buffer, type)
Finally
Marshal.FreeCoTaskMem(buffer)
End Try
End Function
Public Overloads Overrides Function ReadBytes(ByVal size As Integer, _
ByVal offset As Integer) As Byte()
MyBase.ValidateArguments(size, offset)
Dim buffer As Byte() = New Byte(size) {}
If Not (ReadProcessMemory(Me.m_process, MyBase.GetAddress(offset), _
buffer, size, IntPtr.Zero)) Then
MyBase.ThrowLastWin32Error()
End If
Return buffer
End Function
Public Overloads Overrides Function ReadString(ByVal size As Integer, _
ByVal offset As Integer) As String
Dim buffer As IntPtr = Marshal.AllocCoTaskMem(size)
Try
Me.ReadToPtr(buffer, size, offset)
Return Marshal.PtrToStringUni(buffer)
Finally
Marshal.FreeCoTaskMem(buffer)
End Try
End Function
Public Overloads Overrides Sub ReadToPtr(ByVal dest As IntPtr, _
ByVal size As Integer, _
ByVal offset As Integer)
MyBase.ValidateArguments(size, offset)
If Not (ReadProcessMemory(Me.m_process, MyBase.GetAddress(offset), _
dest, size, IntPtr.Zero)) Then
MyBase.ThrowLastWin32Error()
End If
End Sub
Protected Overloads Overrides Sub Free(ByVal disposing As Boolean)
If Not (Me.m_disposed) Then
VirtualFreeEx(Me.m_process, Me.m_address, 0, FreeTypes.Release)
Me.m_process = IntPtr.Zero
If disposing Then
If Not (m_processInstance Is Nothing) Then
m_processInstance.Dispose()
m_processInstance = Nothing
End If
End If
End If
End Sub
End Class
Private m_process As IntPtr
Private m_processInstance As Process
Private Declare Function VirtualAllocEx Lib "kernel32.dll" ( _
ByVal process As IntPtr, ByVal address As IntPtr, _
ByVal size As Integer, ByVal allocationType As AllocationTypes, _
ByVal protect As ProtectTypes) As IntPtr
Private Declare Function VirtualFreeEx Lib "kernel32.dll" ( _
ByVal process As IntPtr, ByVal address As IntPtr, _
ByVal size As Integer, ByVal freeType As FreeTypes) As Boolean
Private Declare Function WriteProcessMemory Lib "kernel32.dll" ( _
ByVal process As IntPtr, ByVal address As IntPtr, _
ByVal buffer As IntPtr, ByVal size As Integer, _
ByVal writtenSize As IntPtr) As Boolean
Private Declare Function WriteProcessMemory Lib "kernel32.dll" ( _
ByVal process As IntPtr, ByVal address As IntPtr, _
<InAttribute()> ByVal buffer As Byte(), ByVal size As Integer, _
ByVal writtenSize As IntPtr) As Boolean
Private Declare Function ReadProcessMemory Lib "kernel32.dll" ( _
ByVal process As IntPtr, ByVal address As IntPtr, _
ByVal buffer As IntPtr, ByVal size As Integer, _
ByVal readSize As IntPtr) As Boolean
Private Declare Function ReadProcessMemory Lib "kernel32.dll" ( _
ByVal process As IntPtr, ByVal address As IntPtr, _
<Out()> ByVal buffer As Byte(), ByVal size As Integer, _
ByVal readSize As IntPtr) As Boolean
<Flags()> Private Enum AllocationTypes
Commit = &H1000
Reserve = &H2000
Alloc = Commit Or Reserve
Reset = &H80000
TopDown = &H100000
End Enum
<Flags()> Private Enum ProtectTypes
NoAccess = &H1
[ReadOnly] = &H2
ReadWrite = &H4
Execute = &H10
ExecuteRead = &H20
ExecuteReadWrite = &H40
Guard = &H100
NoCache = &H200
End Enum
<Flags()> Private Enum FreeTypes
Decommit = &H4000
Release = &H8000
End Enum
Public NotInheritable Class SharedMemory9x
Inherits SharedMemory
Friend Sub New(ByVal size As Integer)
Me.m_map = CreateFileMapping(InvalidHandleValue, IntPtr.Zero, _
ProtectAttributes.Commit, 0, size, Nothing)
If Me.m_map.Equals(IntPtr.Zero) Then
MyBase.ThrowLastWin32Error()
End If
MyBase.SetAddress(MapViewOfFile(Me.m_map, AccessMode.AllAccess, 0, 0, 0))
If MyBase.Address.Equals(IntPtr.Zero) Then
CloseHandle(Me.m_map)
MyBase.ThrowLastWin32Error()
End If
End Sub
Public Overloads Overrides Sub Write(ByVal value As Object, _
ByVal offset As Integer)
MyBase.ValidateArguments(Marshal.SizeOf(value), offset)
Marshal.StructureToPtr(value, MyBase.GetAddress(offset), True)
End Sub
Public Overloads Overrides Sub Write(ByVal value As Byte(), _
ByVal offset As Integer)
MyBase.ValidateArguments(value.Length, offset)
Marshal.Copy(value, 0, MyBase.GetAddress(offset), value.Length)
End Sub
Public Overloads Overrides Sub Write(ByVal value As IntPtr, _
ByVal size As Integer, _
ByVal offset As Integer)
MyBase.ValidateArguments(size, offset)
CopyMemory(MyBase.GetAddress(offset), value, size)
End Sub
Public Overloads Overrides Sub Write(ByVal value As String, _
ByVal offset As Integer)
Me.Write(Encoding.Default.GetBytes(value), offset)
End Sub
Public Overloads Overrides Function ReadStructure(ByVal type As Type, _
ByVal offset As Integer) As Object
MyBase.ValidateArguments(Marshal.SizeOf(type), offset)
Return Marshal.PtrToStructure(MyBase.GetAddress(offset), type)
End Function
Public Overloads Overrides Function ReadBytes(ByVal size As Integer, _
ByVal offset As Integer) As Byte()
MyBase.ValidateArguments(size, offset)
Dim bytes As Byte() = New Byte(size) {}
Marshal.Copy(MyBase.GetAddress(offset), bytes, 0, size)
Return bytes
End Function
Public Overloads Overrides Function ReadString(ByVal size As Integer, _
ByVal offset As Integer) As String
MyBase.ValidateArguments(size, offset)
Return Marshal.PtrToStringAnsi(MyBase.GetAddress(offset))
End Function
Public Overloads Overrides Sub ReadToPtr(ByVal dest As IntPtr, _
ByVal size As Integer, _
ByVal offset As Integer)
MyBase.ValidateArguments(size, offset)
CopyMemory(dest, MyBase.GetAddress(offset), size)
End Sub
Protected Overloads Overrides Sub Free(ByVal disposing As Boolean)
If Not (Me.m_disposed) Then
UnmapViewOfFile(MyBase.Address)
CloseHandle(Me.m_map)
Me.m_map = IntPtr.Zero
End If
End Sub
Private m_map As IntPtr
Private Declare Auto Function CreateFileMapping Lib "kernel32.dll" ( _
ByVal fileHandle As IntPtr, ByVal security As IntPtr, _
ByVal protects As ProtectAttributes, _
ByVal maximumSizeHigh As Integer, ByVal maximumSizeLow As Integer, _
ByVal name As String) As IntPtr
Private Declare Function MapViewOfFile Lib "kernel32.dll" ( _
ByVal mappingObject As IntPtr, ByVal desiredAccess As AccessMode, _
ByVal offsetHigh As Integer, ByVal offserLow As Integer, _
ByVal numberOfBytesToMap As Integer) As IntPtr
Private Declare Sub CopyMemory Lib "kernel32.dll" ( _
ByVal destination As IntPtr, ByVal source As IntPtr, _
ByVal length As Integer)
Private Declare Function UnmapViewOfFile Lib "kernel32.dll" ( _
ByVal baseAddress As IntPtr) As Boolean
Private Declare Function CloseHandle Lib "kernel32.dll" ( _
ByVal handle As IntPtr) As Boolean
<Flags()> Private Enum AccessMode
Copy = &H1
Write = &H2
Read = &H4
AllAccess = &HF001F
End Enum
<Flags()> Private Enum ProtectAttributes
[ReadOnly] = &H2
ReadWrite = &H4
WriteCopy = &H8
Image = &H1000000
Reserve = &H4000000
Commit = &H8000000
NoCache = &H10000000
End Enum
Private Shared ReadOnly InvalidHandleValue As IntPtr = New IntPtr(-1)
End Class
End Class
End Namespace
