2005年11月09日

共有メモリクラス for VB.NET

リファラを見ているとですね、大体今まで書いた中でどんな記事に人気があるのか見えてくるんですね。で、最近多いなというのが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

posted by Hongliang at 00:55| Comment(7) | TrackBack(1) | VB.NET | このブログの読者になる | 更新情報をチェックする
この記事へのコメント
いつも御世話になっております。【http://rmt-one1st.jp/game.php?catid=328&actiontype=buysell】でございます。
Posted by Maple Story rmt at 2011年07月25日 13:44
ご注文は24時間受付中、簡単な購入手続き!
Posted by ドフス rmt at 2011年07月25日 14:40
どうぞよろしくお願いいたします。
Posted by ドラゴンネスト rmt at 2011年07月25日 15:06
弊社【http://www.rmt-iroiro.jp/rmtbuy/Arad.htm】が扱う全てのゲームの委託販売商品をウェブマネーにてご購入いただけるキャンペーンを実施しております。
Posted by アラド rmt at 2011年07月25日 15:09
ご注文は24時間受付中、簡単な購入手続き!
Posted by アトランティカ rmt at 2011年07月25日 15:53
http://www.kiraku-rmt.jp/rmtbuy/DragonNest.htm】お取引方法などの詳細は、トップページ、またはこちらに記載されております。
Posted by アイオン rmt at 2011年08月29日 15:03
ブランド 人気
Posted by ブレスレット chan luu at 2013年07月31日 20:38
コメントを書く
お名前:

メールアドレス:

ホームページアドレス:

コメント:

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


※画像の中の文字を半角で入力してください。
この記事へのトラックバックURL
http://blog.seesaa.jp/tb/9121793

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

COM クライアント実装の道程 for TaskScheduler その番外編1 ~アンマネージドメモリへの手抜き
Excerpt: 予告通り、三回目にして速攻で脇道に入ります。 アンマネージドとの相互運用において、面倒なものの一つにアンマネージドメモリの管理があります。.NET ではアンマネージドメモリを扱う場合 System.R..
Weblog: ぬるり。
Tracked: 2006-03-03 01:34

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

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

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

×

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