共有メモリの使い方について

まずここ読む

http://techtips.belution.com/ja/vc/0001/

んで以下のサンプルをどうぞ。
思いっきりポインタ使っています。
ってか、APIを使用するならC同様、ポインタで扱います。

サンプルは二つのプロジェクトで、両方とも
・フォーム
・標準モジュール
の構成になっています。

標準モジュールは、Project1/Project2兼用です。



'''---------------------------------------------
'''---------- Project1.Form1 ここから ----------
'''---------------------------------------------
Option Explicit

Private pProcID　　 As Long
Private hProcess　　As Long
Private pShared　　 As Long
Private pSharedLen　As Long


Private Const DEF_PROJECT2　　　　　As String = "c:\Project2.exe"
Private Const DEF_MAX_ARRAY　　　　 As Long = 20000
Private pLngXX(1 To DEF_MAX_ARRAY)　As Long


'別アプリ起動
Private Sub Command1_Click()
　　On Error GoTo PGMERR

　　Dim strParam　　As String
　　
　　'別アプリ存在チェック
　　If Dir(DEF_PROJECT2) = "" Then
　　　　MsgBox "EXEがみつからない"
　　　　GoTo PGMEND
　　End If
　　
　　'共有メモリに値を書き込む
　　If Not memWrite(hProcess, pShared, VarPtr(pLngXX(1)), pSharedLen) Then
　　　　Call MsgBox("共有メモリへの書き込み失敗")
　　　　GoTo PGMEND
　　End If

　　'パラメータ作成(プロセスID/配列要素数/共有メモリ先頭ポインタ)
　　strParam = pProcID & " " & DEF_MAX_ARRAY & " " & pShared
　　
　　'起動
　　Call Shell(DEF_PROJECT2 & " " & strParam)
　　
PGMEND:
　　Exit Sub

PGMERR:
　　Call MsgBox(Err.Description, vbCritical)
　　GoTo PGMEND
End Sub


'ロード
Private Sub Form_Load()
　　Me.Command1.Caption = "別アプリ起動"
　　Me.Command1.Enabled = False
　　
　　'プロセスIDを取得する
　　If Not GetThreadProcessId(Me.hwnd, pProcID) Then
　　　　Call MsgBox("プロセス情報取得失敗")
　　　　GoTo PGMEND
　　End If
　　
　　'共有メモリオープン
　　pSharedLen = (Len(pLngXX(1)) * DEF_MAX_ARRAY)
　　If Not memOpen(pProcID, pSharedLen, hProcess, pShared) Then
　　　　Call MsgBox("共有メモリ確保失敗")
　　　　GoTo PGMEND
　　End If
　　
　　
　　'ダミーの値をセット
　　Call setValues
　　
　　Me.Command1.Enabled = True
　　
PGMEND:
End Sub

'アンロード
Private Sub Form_Unload(Cancel As Integer)
　　Call memFree(hProcess, pShared)
End Sub


'ダミー値セット
Private Sub setValues()
　　Dim i　　　 As Long
　　
　　'適当に乱数をセット
　　For i = 1 To DEF_MAX_ARRAY
　　　　pLngXX(i) = Int(30 * Rnd)
　　Next i
End Sub
'''---------------------------------------------
'''---------- Project1.Form1 ここまで ----------
'''---------------------------------------------



'''---------------------------------------------
'''---------- Project2.Form1 ここから ----------
'''---------------------------------------------
Option Explicit

Private hProcess　　As Long

Private Sub Form_Load()
　　Dim strCmd　　　As String
　　Dim varWk　　　 As Variant
　　
　　strCmd = Command$
　　If strCmd = "" Then
　　　　MsgBox "パラメータなし"
　　　　End
　　End If
　　
　　'デバッグ用リストボックスクリア
　　Me.List1.Clear
　　
　　'パラメータ分解
　　varWk = Split(strCmd, " ")
　　
　　'読み取りと画面反映
　　Call memDataRead(CLng(varWk(0)), CLng(varWk(1)), CLng(varWk(2)))
End Sub

'読み取りと画面反映
Private Sub memDataRead(ByVal inAppID As Long, ByVal inArrayCount As Long, ByVal lngMemPointer As Long)
On Error GoTo PGMEND
　　Dim lngXX()　　 As Long
　　Dim dwSize　　　As Long
　　Dim i　　　　　 As Long
　　
　　'配列領域確保
　　ReDim lngXX(1 To inArrayCount) As Long
　　
　　'メモリサイズを取得
　　dwSize = Len(lngXX(1)) * inArrayCount
　　
　　'共有メモリ確保
　　If Not procOpen(inAppID, hProcess) Then
　　　　Call MsgBox("共有メモリ確保失敗")
　　　　GoTo PGMEND
　　End If
　　
　　'共有メモリから値を読み込む
　　If Not memRead(hProcess, lngMemPointer, VarPtr(lngXX(1)), dwSize) Then
　　　　Call MsgBox("共有メモリからの読み込む失敗")
　　　　GoTo PGMEND
　　End If

　　'デバッグ用リストボックスへ出力
　　For i = 1 To inArrayCount
　　　　Me.List1.AddItem lngXX(i)
　　Next i
PGMEND:
　　Call procFree(hProcess)
　　Exit Sub
PGMERR:
　　Call MsgBox(Err.Description, vbCritical)
　　GoTo PGMEND
End Sub
'''---------------------------------------------
'''---------- Project2.Form1 ここまで ----------
'''---------------------------------------------



'''-----------------------------------------------
'''---------- Project1.Module1 ここから ----------
'''---------- Project2.Module1 ここから ----------
'''---------- 二つのプロジェクトで必要　----------
'''-----------------------------------------------
Option Explicit

Private Declare Function OpenProcess Lib "kernel32" ( _
　　ByVal dwDesiredAccess As Long, _
　　ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" ( _
　　ByVal hProcess As Long, _
　　ByVal lpAddress As Long, _
　　ByVal dwSize As Long, _
　　ByVal flAllocationType As Long, _
　　ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" ( _
　　ByVal hProcess As Long, _
　　ByVal lpAddress As Long, _
　　ByVal dwSize As Long, _
　　ByVal dwFreeType As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" ( _
　　ByVal hwnd As Long, _
　　ByRef lpdwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
　　ByVal hObject As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" ( _
　　ByVal hProcess As Long, _
　　ByVal lpBaseAddress As Long, _
　　ByVal lpBuffer As Long, _
　　ByVal nSize As Long, _
　　ByRef lpNumberOfBytesWritten As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" ( _
　　ByVal hProcess As Long, ByVal lpBaseAddress As Long, _
　　ByVal lpBuffer As Long, _
　　ByVal nSize As Long, _
　　ByRef lpNumberOfBytesWritten As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)


Private Const STANDARD_RIGHTS_REQUIRED　As Long = &HF0000
Private Const SYNCHRONIZE　　　　　　　 As Long = &H100000

Private Const PROCESS_TERMINATE　　　　 As Long = &H1
Private Const PROCESS_CREATE_THREAD　　 As Long = &H2
Private Const PROCESS_SET_SESSIONID　　 As Long = &H4
Private Const PROCESS_VM_OPERATION　　　As Long = &H8
Private Const PROCESS_VM_READ　　　　　 As Long = &H10
Private Const PROCESS_VM_WRITE　　　　　As Long = &H20
Private Const PROCESS_DUP_HANDLE　　　　As Long = &H40
Private Const PROCESS_CREATE_PROCESS　　As Long = &H80
Private Const PROCESS_SET_QUOTA　　　　 As Long = &H100
Private Const PROCESS_SET_INFORMATION　 As Long = &H200
Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const PROCESS_ALL_ACCESS　　　　As Long = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF

Private Const PAGE_NOACCESS　　　　　　 As Long = &H1
Private Const PAGE_READONLY　　　　　　 As Long = &H2
Private Const PAGE_READWRITE　　　　　　As Long = &H4
Private Const PAGE_WRITECOPY　　　　　　As Long = &H8
Private Const PAGE_EXECUTE　　　　　　　As Long = &H10
Private Const PAGE_EXECUTE_READ　　　　 As Long = &H20
Private Const PAGE_EXECUTE_READWRITE　　As Long = &H40
Private Const PAGE_EXECUTE_WRITECOPY　　As Long = &H80
Private Const PAGE_GUARD　　　　　　　　As Long = &H100
Private Const PAGE_NOCACHE　　　　　　　As Long = &H200
Private Const PAGE_WRITECOMBINE　　　　 As Long = &H400

Private Const MEM_COMMIT　　　　　　　　As Long = &H1000
Private Const MEM_RESERVE　　　　　　　 As Long = &H2000
Private Const MEM_DECOMMIT　　　　　　　As Long = &H4000
Private Const MEM_RELEASE　　　　　　　 As Long = &H8000
Private Const MEM_FREE　　　　　　　　　As Long = &H10000
Private Const MEM_PRIVATE　　　　　　　 As Long = &H20000
Private Const MEM_MAPPED　　　　　　　　As Long = &H40000
Private Const MEM_RESET　　　　　　　　 As Long = &H80000
Private Const MEM_TOP_DOWN　　　　　　　As Long = &H100000
Private Const MEM_4MB_PAGES　　　　　　 As Long = &H80000000

'プロセスオブジェクトのハンドルを開く
Public Function procOpen(ByVal inAppID As Long, otProc As Long) As Boolean
　　otProc = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, inAppID)
　　If otProc = 0 Then
　　　　GoTo PGMEND
　　End If

　　procOpen = True
PGMEND:
End Function

'プロセスオブジェクトのハンドルを開放する
Public Sub procFree(inProc As Long)
　　Call CloseHandle(inProc)
　　inProc = 0
End Sub

'共有メモリをオープン
Public Function memOpen(ByVal inAppID As Long, ByVal inSize As Long, otProc As Long, otSharedAddress As Long) As Boolean
　　'共有メモリをクローズする
　　Call memFree(otProc, otSharedAddress)
　　
　　'プロセスオブジェクトのハンドルを開く
　　If Not procOpen(inAppID, otProc) Then
　　　　GoTo PGMEND
　　End If

　　
　　'共有メモリを開放する
　　otSharedAddress = VirtualAllocEx(otProc, 0, inSize, MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
　　If otSharedAddress = 0 Then
　　　　GoTo PGMEND
　　End If
　　
　　memOpen = True
PGMEND:
　　If Not memOpen Then
　　　　Call memFree(otProc, otSharedAddress)
　　End If
End Function

'共有メモリをクローズ
Public Sub memFree(inProc As Long, inSharedAddress As Long)
　　'クローズ
　　Call VirtualFreeEx(inProc, inSharedAddress, 0, MEM_RELEASE)
　　inSharedAddress = 0
　　
　　'プロセスオブジェクトのハンドルを開放する
　　Call procFree(inProc)
End Sub

'共有メモリ領域に書き込む
Public Function memWrite(ByVal inProc As Long, ByVal inSharedAddress As Long, ByVal inMemPnt As Long, ByVal inSize As Long, Optional otSize As Long) As Boolean
　　Dim lngSts　As Long
　　otSize = 0
　　lngSts = WriteProcessMemory(inProc, inSharedAddress, ByVal inMemPnt, inSize, otSize)
　　memWrite = (lngSts <> 0)
End Function

'共有メモリ領域から読み込む
Public Function memRead(ByVal inProc As Long, ByVal inSharedAddress As Long, ByVal inMemPnt As Long, ByVal inSize As Long, Optional otSize As Long) As Boolean
　　Dim lngSts　As Long
　　otSize = 0
　　lngSts = ReadProcessMemory(inProc, inSharedAddress, ByVal inMemPnt, inSize, otSize)
　　memRead = (lngSts <> 0)
End Function

'ハンドルから、プロセスIDとスロッドIDを取得する
Public Function GetThreadProcessId(ByVal inWnd As Long, Optional otProcID As Long, Optional otThred As Long) As Boolean
　　otProcID = 0
　　otThred = 0
　　otThred = GetWindowThreadProcessId(inWnd, otProcID)
　　GetThreadProcessId = (otThred <> 0)
End Function
'''-----------------------------------------------
'''---------- Project1.Module1 ここまで ----------
'''---------- Project2.Module1 ここまで ----------
'''---------- 二つのプロジェクトで必要　----------
'''-----------------------------------------------

参考URL：http://techtips.belution.com/ja/vc/0001/

追記

http://oshiete1.goo.ne.jp/kotaeru.php3?q=317246
の＃4でZeroMemoryについて述べられている。

「その型で、文字列以外は領域が決まっている。ただし、固定長文字列は可。」
という意の言葉が、最初の方である。


同様にサンプルも、先頭アドレスと領域サイズさえあれば可。
仕様的には全く一緒。
さらに当たり前ですが、その領域が連続していることが前提条件。

それに添っているのであれば、ユーザ型であろうとなかろうと、関係なく可能です。


でも、宣言できないような型は、共有領域以前の問題。
サイズオーバーなら、型・インターフェースを見直す必要があると思うけど、どうだろう。。。

限界まで共有領域を確保するのは、負荷としても問題ありでは？

xx(20000) As Long

yy(20000) As Long

ユーザー定義型ではなく、配列として受ければよいのでは？