声明API的时候，如果你把某个参数的定义写成“xxxx() As Any”，那么VB6就会在调用这个API的时候把你提供的数组它的SAFEARRAY结构体的地址传给这个API。所以又到了使用某个傀儡函数的时候：VarPtr。
VB6的msvbvm60.dll导出了一个傀儡函数VarPtr，它的实现其实就是把自己参数列表的第一个参数原样返回给你。IDA里面已经看到了，这个VarPtr的反汇编是这么写的：
mov eax,[esp+4]
ret 4
复制代码
所以我们可以手动声明它的API，并且修改它的名字（别名）和参数的定义。我是这样写的：
Declare Function ArrayPtr Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any) As Long
Private Declare Function ArrayPtr Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const FADF_AUTO = &H1 'An array that is allocated on the stack.
Private Const FADF_STATIC = &H2 'An array that is statically allocated.
Private Const FADF_EMBEDDED = &H4 'An array that is embedded in a structure.
Private Const FADF_FIXEDSIZE = &H10 'An array that may not be resized or reallocated.
Private Const FADF_RECORD = &H20 'An array that contains records. When set, there will be a pointer to the IRecordInfo interface at negative offset 4 in the array descriptor.
Private Const FADF_HAVEIID = &H40 'An array that has an IID identifying interface. When set, there will be a GUID at negative offset 16 in the safe array descriptor. Flag is set only when Private Const FADF_DISPATCH or Private Const FADF_UNKNOWN is also set.
Private Const FADF_HAVEVARTYPE = &H80 'An array that has a variant type. The variant type can be retrieved with SafeArrayGetVartype.
Private Const FADF_BSTR = &H100 'An array of BSTRs.
Private Const FADF_UNKNOWN = &H200 'An array of IUnknown*.
Private Const FADF_DISPATCH = &H400 'An array of IDispatch*.
Private Const FADF_VARIANT = &H800 'An array of VARIANTs.
Private Const FADF_RESERVED = &HF008 'Bits reserved for future use.
Type IntegerPtr
Dimensions As Integer
MustBe0x96 As Integer
MustBe2 As Long
MustBeOne As Long
Pointer As Long
MustBeIntMax As Long
LBound As Long
Value() As Integer
End Type
Type LongPtr
Dimensions As Integer
MustBe0x96 As Integer
MustBe4 As Long
MustBeOne As Long
Pointer As Long
MustBeIntMax As Long
LBound As Long
Value() As Long
End Type
Type SinglePtr
Dimensions As Integer
MustBe0x96 As Integer
MustBe4 As Long
MustBeOne As Long
Pointer As Long
MustBeIntMax As Long
LBound As Long
Value() As Single
End Type
Type DoublePtr
Dimensions As Integer
MustBe0x96 As Integer
MustBe8 As Long
MustBeOne As Long
Pointer As Long
MustBeIntMax As Long
LBound As Long
Value() As Double
End Type
Sub IntegerPtr_Setup(Thing As IntegerPtr, ByVal InitPtr As Long)
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hDC As Long, pBitmapInfo As Any, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function ArrayPtr Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As Long)
Private Const DIB_RGB_COLORS = 0 ' color table in RGBs
Private Type RGB_t
B As Byte
G As Byte
R As Byte
End Type
Private Type RGBPtr_t
Dimensions As Integer
MustBe0x96 As Integer
MustBe3 As Long
MustBeOne As Long
Pointer As Long
MustBeIntMax As Long
LBound As Long
Value() As RGB_t
End Type
Private m_hDC_canv As Long '画布hDC
Private m_bmp_canv As Long '画布位图
Private m_bmp_canv_ptr As Long '位图指针
Private m_bmp_canv_pitch As Long '每行像素的字节数
'画布的钦定尺寸
Private Const m_canv_width As Long = 320
Private Const m_canv_height As Long = 240
Private Const m_fov As Single = 0.5
Private Const m_light_x As Single = 0.577350269189626
Private Const m_light_y As Single = -0.577350269189626
Private Const m_light_z As Single = 0.577350269189626
'每一行像素的指针
Private m_line_ptrs(m_canv_height - 1) As Long
Private Const Pi As Double = 3.14159265358979
'设置指针的函数
Private Sub RGBPtr_Setup(Thing As RGBPtr_t, ByVal InitPtr As Long)
Private Sub DrawTri(ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long, ByVal x3 As Long, ByVal y3 As Long, Optional ByVal R As Long, Optional ByVal G As Long, Optional ByVal B As Long)
'绘制三角形
If R < 0 Then R = 0
If G < 0 Then G = 0
If B < 0 Then B = 0
If R > 255 Then R = 255
If G > 255 Then G = 255
If B > 255 Then B = 255
Dim t As Long
Dim x4 As Long, y4 As Long
'排序，让点1在最上，点2在中间，点3在最下
If y2 < y1 Then
t = x1
x1 = x2
x2 = t
t = y1
y1 = y2
y2 = t
End If
If y3 < y1 Then
t = x1
x1 = x3
x3 = t
t = y1
y1 = y3
y3 = t
End If
If y2 > y3 Then
t = x2
x2 = x3
x3 = t
t = y2
y2 = y3
y3 = t
End If
'将这个三角形一分为二，得到上半部分和下半部分
'然后取交点，排序
y4 = y2
x4 = x1 + (x3 - x1) * (y2 - y1) \ (y3 - y1)
If x2 > x4 Then
t = x2
x2 = x4
x4 = t
t = y2
y2 = y4
y4 = t
End If
'现在的状况：
'p1在最上，p3在最下，p2和p4在同一行，p2靠左。
' * p1
' /\
' /" \
' / \
' /" \
' / \
' /" \
' / \
' /" \
' / \
' /" \
' p2 *-------------------------* p4
' ~-,_ \
' ~-,_ \
' ~-,_ \
' ~-,_ \
' ~-,_ \
' ~-,_ \
' ~-,_ \
' ~-,_ \
' ~-\
' * p3
Dim Pixels As RGBPtr_t '像素指针
Dim x As Long
RGBPtr_Setup Pixels, 0
Dim slices As Long, cur_slice As Long
Dim xleft As Long, xmove As Long, xwidth As Long, curwidth As Long
Private Sub DrawCube(ByVal c_x As Single, ByVal c_y As Single, ByVal c_z As Single, ByVal yaw As Single, ByVal pitch As Single, ByVal roll As Single, Optional ByVal box_width As Single = 1, Optional ByVal box_height As Single = 1, Optional ByVal box_depth As Single = 1)
's表示Sin，c表示Cos，r p y是roll pitch yaw的缩写
Dim sr As Single, cr As Single
Dim sp As Single, cp As Single
Dim sy As Single, cy As Single
sy = Sin(yaw)
cy = Cos(yaw)
sp = Sin(pitch)
cp = Cos(pitch)
sr = Sin(roll)
cr = Cos(roll)
'某些组合的乘积
Dim srcp As Single, srsp As Single
Dim crcp As Single, crsp As Single
srcp = sr * cp
srsp = sr * sp
crcp = cr * cp
crsp = cr * sp
'旋转矩阵
Dim dxx As Single, dxy As Single, dxz As Single 'x轴
Dim dyx As Single, dyy As Single, dyz As Single 'y轴
Dim dzx As Single, dzy As Single, dzz As Single 'z轴
Sub LongPtr_Setup(Thing As LongPtr, ByVal InitPtr As Long)，可以把一个指针和数组绑定。
如何把3个数组中的2个绑定到另一个上？
dim a(10) as long,b() as long ,c() as long
a有11个数据，如何让b和C的地址都改成A的？改B就是A改了，改C也是A改了，b和A相同,C和A相同的内容。
或者只有2个数组时把B数组地址改成A的，目标就是改了B就是改了A，改了A，B也能读出变动的数据。
|Archiver|小黑屋|技术宅的结界
( 滇ICP备16008837号 )|网站地图
发表于 2017-10-18 05:10:34
发表于 2017-10-18 15:57:18
