|Public Const PAGE_EXECUTE_READWRITE = &h40
|Public Const HEAP_ZERO_MEMORY = &h08
|Public Const VT_R8 = 5
|Public Const VT_VARIANT = 12
|Public Const VT_ARRAY = &h2000
|'============================================
|Public Wrap
|Set Wrap = CreateObject(""DynamicWrapperX"")
|
|Public oServ
|Public Point
|'============================================
|
|Class Service
| Private hHeap
| Private ppv
| Private pVal
| Private pFlag
| Private addrParamTypesAvailable
| Private rgsabound
| Private DllSeg
|
| Private Sub Class_Initialize
| 'Необходимые функции
| Wrap.Register ""Kernel32"", ""LoadLibrary"" , ""i=s"", ""r=h""
| Wrap.Register ""Kernel32"", ""GetProcAddress"" , ""i=hs"", ""r=u""
| Wrap.Register ""Kernel32"", ""VirtualProtect"" , ""i=lllp"", ""r=l""
| Wrap.Register ""Kernel32"", ""HeapAlloc"", ""i=lll"", ""r=l""
| Wrap.Register ""Kernel32"", ""GetProcessHeap"", ""r=l""
| Wrap.Register ""Kernel32"", ""HeapFree"", ""i=lll"",""r=l""
|
| Wrap.Register ""Oleaut32"", ""SafeArrayCreate"", ""i=llp"",""r=l""
| Wrap.Register ""Oleaut32"", ""SafeArrayGetDim"", ""i=p"",""r=l""
| Wrap.Register ""Oleaut32"", ""SafeArrayGetElement"", ""i=plp"",""r=l""
| Wrap.Register ""Oleaut32"", ""SafeArrayPutElement"", ""i=plp"",""r=l""
|
| 'Выделяем память под результат
| hHeap = Wrap.GetProcessHeap()
| ppv = Wrap.HeapAlloc(hHeap, HEAP_ZERO_MEMORY, 4)
| pFlag = Wrap.HeapAlloc(hHeap, HEAP_ZERO_MEMORY, 4)
| pVal = Wrap.HeapAlloc(hHeap, HEAP_ZERO_MEMORY, 16)
| rgsabound = Wrap.HeapAlloc(hHeap, HEAP_ZERO_MEMORY, 8)
|
|
| 'Для патча DWX налету
| '=============================================================
| handle = Wrap.LoadLibrary(""dynwrapx"")
| Addr = Wrap.GetProcAddress(handle, ""DllGetClassObject"")
| DllSeg = Addr And &hFFFF0000
|
| Offset = &h41C8 + 10 'VT_Dispatch
| addrParamTypesAvailable = DllSeg + Offset
| '=============================================================
| Wrap.VirtualProtect addrParamTypesAvailable, 2, PAGE_EXECUTE_READWRITE, pFlag
| End Sub
|
| Private Sub Class_Terminate
| Wrap.VirtualProtect addrParamTypesAvailable, 2, Wrap.NumGet(pFlag), pFlag
| Wrap.HeapFree hHeap, 0, ppv
| Wrap.HeapFree hHeap, 0, pFlag
| Wrap.HeapFree hHeap, 0, pVal
| Wrap.HeapFree hHeap, 0, rgsabound
| End Sub
|
| Public Function GetSafeArray(Arr)
| 'Учим DWX принимать массив
| vtType = Wrap.NumGet(addrParamTypesAvailable, 0, ""t"")
| Wrap.NumPut VarType(Arr), addrParamTypesAvailable, 0, ""t""
|
| 'Получим указатель на SafeArray
| GetSafeArray = Wrap.GetIDispatch(Arr)
|
| 'Возвращаем статус-кво
| Wrap.NumPut vtType, addrParamTypesAvailable, 0, ""t""
| End Function
|
| Public Function GetElement(pSafeArray, ind)
| Wrap.NumPut ind, ppv
| Wrap.SafeArrayGetElement pSafeArray, ppv, pVal
|
| GetElement = Wrap.NumGet(pVal, 8, ""d"")
| End Function
|
| Public Function PutElement(pSafeArray, ind, vl)
| 'Тип Variant - VT_R8
| Wrap.NumPut VT_R8, pVal, 0, ""t""
| 'Значение Variant
| Wrap.NumPut vl, pVal, 8, ""d""
|
| Wrap.NumPut ind, ppv
| Wrap.SafeArrayPutElement pSafeArray, ppv, pVal
| End Function
|
| Public Function ArrayCreate(vt, cElements)
| 'Структура SAFEARRAYBOUND
| Wrap.NumPut cElements, rgsabound, 0
| Wrap.NumPut 0 , rgsabound, 4
|
| pSA = Wrap.SafeArrayCreate(vt, 1, rgsabound)
|
| 'Научим DWX возвращать массивы
| '=============================================================
| addr = DllSeg + &h278D
| Wrap.VirtualProtect addr, 8, PAGE_EXECUTE_READWRITE, pFlag
|
| 'Запоминаем участок памяти
| mem1 = Wrap.NumGet(addr, 0)
| mem2 = Wrap.NumGet(addr, 4)
|
| 'Меняем участок памяти
| Wrap.NumPut &h90909090, addr, 0
| Wrap.NumPut &h90909090, addr, 4
|
| Wrap.NumPut VT_ARRAY + vt, addr, 0, ""t""
|
| ArrayCreate = Wrap.GetObject(pSA)
|
| 'Возвращаем статус-кво
| Wrap.NumPut mem1, addr, 0
| Wrap.NumPut mem2, addr, 4
| '=============================================================
| End Function
|End Class
|
|Set oServ = New Service
|
|'===========================================================
|Public Function GetSafeArray(Arr)
| GetSafeArray = oServ.GetSafeArray(Arr)
|End Function
|
|Public Function GetElement(pSafeArray, ind)
| GetElement = oServ.GetElement(pSafeArray, ind)
|End Function
|
|Public Function PutElement(pSafeArray, ind, vl)
| oServ.PutElement pSafeArray, ind, vl
|End Function
|
|Public Function ArrayCreate(vt, cElements)
| ArrayCreate = oServ.ArrayCreate(vt, cElements)
|End Function
|
|Public Function Test()
| pArr = GetSafeArray(Point)
|
| item0 = GetElement(pArr, 0)
| item1 = GetElement(pArr, 1)
|
| MsgBox ""item0 = "" & CSTR(item0)
| MsgBox ""item1 = "" & CSTR(item1)
|
| PutElement pArr, 0, 3.14
| MsgBox ""item0 = "" & CSTR(Point(0))
|
| newArray = ArrayCreate(VT_VARIANT, 3)
| MsgBox TypeName(newArray)
|
| newArray(0) = 15.56
| MsgBox newArray(0)
|End Function
|'===========================================================
|
|Point = Array(10.454, 11.56944656, 12, 15, 25)
|";
.
