追記
以前のサンプルはこちらの勘違いでActiveXExeで作ってしまったんだけど、
OCX化指令を出している先輩社員もいるのだから、読み替えてくれると思って
わざわざ再投稿しなかったんだけど、なんかうるさいので、作り直し。
でもほとんど差はなし
っていうか、ActiveX.DLLで通るならそれからOCXなんて、当たり前にできます。
「AcitveXDLLのインターフェイスに肉付けしたのがOCX」
だから、AcitveXDLLにできて、OCXにできないなんてこたぁありえません。
AcitveXEXEも同じこと。
↓↓↓↓↓↓↓↓ 重要ここから ↓↓↓↓↓↓↓↓
「反論するなら、意味も無く『無茶苦茶』発言はご勘弁」
「もしあるなら、調査・結果を書いた上でお願いします」
↑↑↑↑↑↑↑↑ 重要ここまで ↑↑↑↑↑↑↑↑↑
Project1(EXE)
├Form1
│└UserControl1(Project2を参照し、コントロールを貼り付け)
└Module1(EXEとOCX兼用)
Project2(OCX)
├UserControl1
└Module1(EXEとOCX兼用)
'''---------------------------------------------
'''---------- Project1.Form1 ここから ----------
'''---------------------------------------------
Option Explicit
Private pProcID As Long
Private hProcess As Long
Private pShared As Long
Private pSharedLen As Long
Private Type typData
a As Long
b As Long
c As Long
End Type
Private pDat As typData
'別アプリ起動
Private Sub Command1_Click()
On Error GoTo PGMERR
Dim strWk As String
'共有メモリに値を書き込む
If Not memWrite(hProcess, pShared, VarPtr(pDat), pSharedLen) Then
Call MsgBox("共有メモリへの書き込み失敗")
GoTo PGMEND
End If
'ActiveXをたたく
'プロセスID/配列要素数/共有メモリ先頭ポインタ
If Not Me.UserControl11.RunExec(pProcID, pShared, strWk) Then
GoTo PGMEND
End If
MsgBox strWk
PGMEND:
Exit Sub
PGMERR:
Call MsgBox(Err.Description, vbCritical)
GoTo PGMEND
End Sub
'ロード
Private Sub Form_Load()
Me.Command1.Caption = "ActiveX起動"
Me.Command1.Enabled = False
'プロセスIDを取得する
If Not GetThreadProcessId(Me.hwnd, pProcID) Then
Call MsgBox("プロセス情報取得失敗")
GoTo PGMEND
End If
'共有メモリオープン
pSharedLen = Len(pDat)
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()
With pDat
.a = 2
.b = 4
.c = 6
End With
End Sub
'''---------------------------------------------
'''---------- Project1.Form1 ここまで ----------
'''---------------------------------------------
'''---------------------------------------------
'''---------- Project2.UserControl1 ここから ---
'''---------------------------------------------
Option Explicit
Private Type typData
a As Long
b As Long
c As Long
End Type
Private pDat As typData
'メイン部
Public Function RunExec(ByVal inProcID As Long, ByVal inShared As Long, ByRef otBuff As String) As Boolean
On Error GoTo PGMERR
If Not memDataRead(inProcID, inShared, otBuff) Then
GoTo PGMEND
End If
RunExec = True
PGMEND:
Exit Function
PGMERR:
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpContext, Err.HelpFile
GoTo PGMEND
End Function
'読み取りと画面反映
Private Function memDataRead(ByVal inAppID As Long, ByVal lngMemPointer As Long, ByRef otBuff As String) As Boolean
On Error GoTo PGMEND
Dim hProcess As Long
Dim dwSize As Long
Dim strBuff As String
otBuff = ""
'メモリサイズを取得
dwSize = Len(pDat)
'共有メモリ確保
If Not procOpen(inAppID, hProcess) Then
Call MsgBox("共有メモリ確保失敗")
GoTo PGMEND
End If
'共有メモリから値を読み込む
If Not memRead(hProcess, lngMemPointer, VarPtr(pDat), dwSize) Then
Call MsgBox("共有メモリからの読み込む失敗")
GoTo PGMEND
End If
'デバッグ用
With pDat
strBuff = ""
strBuff = strBuff & "受けデータ" & vbCrLf
strBuff = strBuff & " A:" & .a & vbCrLf
strBuff = strBuff & " B:" & .b & vbCrLf
strBuff = strBuff & " C:" & .c & vbCrLf
End With
otBuff = strBuff
memDataRead = True
PGMEND:
Call procFree(hProcess)
Exit Function
PGMERR:
Call procFree(hProcess)
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpContext, Err.HelpFile
GoTo PGMEND
End Function
'''---------------------------------------------
'''---------- Project2.UserControl1 ここまで ---
'''---------------------------------------------
'''-----------------------------------------------
'''---------- 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 ここまで ----------
'''---------- 二つのプロジェクトで必要 ----------
'''-----------------------------------------------
お礼
つまり…BufNameをバッファ名として渡された場合、BufName_1、BufName_2、みたいな感じでOCX内で定義してバッファを並べればいい訳ですね?で、それを管理する構造体を作り、読み込む構造体の名前を格納しておく…ってなんだか分かったような分かって無いような言い方してますが、出来てるので分かったんだと思います。まあ、アドレスにこだわったのがそもそもの間違いだと… お二人には大変ご迷惑をおかけいたしました。おかげさまで足りない頭でも何とか完成には至れました…分かってみれば単純な理屈でしたけど。何故これが思いつかなかったのかと… 初めからこの実装を出していれば話もこじれずに済んだのかもしれませんが…色々と勉強させていただいただきました。Lenやポインタの事もどこかでそのうち参考にさせていただきます。 本当にありがとうございました。