看见大侠们编的VBS调用TYPE的范例
但是如何在金子塔中模块中使用呢，老是通不过？
Set Wrap=CreateObject("DynamicWrapper")
Wrap.Register "User32.dll","GetCursorPos","f=s","i=l","r=l"
Set POINT=New Struct
With POINT
.Add "X", 4, 0
.Add "Y", 4, 0
End With
Wrap.GetCursorPos(POINT.Ptr)
WScript.Echo(POINT.GetItem("X") & vbCrLf & POINT.GetItem("Y"))
Class Struct ' v1.1 allow typedef with dynawrap calls
Public Property Get Ptr '******************************* Property Ptr
Ptr=GetBSTRPtr(sBuf)
End Property
Private oMM,oSCat,oAnWi 'objets wrapper API
Private dBuf,sBuf,iOffset
Public Sub Add(sItem,iSize,Data) '********************** Method Add
Dim lVSize,iD
iD="0"
lVSize = iSize
dBuf.Add sItem,lVSize
sBuf=sBuf & String(lVSize/2+1,Chr(0))
SetDataBSTR GetBSTRPtr(sBuf),lVSize,Data,iOffset
End Sub
Public Function GetItem(sItem)
'********************************************** Méthode GetItem
Dim lOf,lSi,aItems,aKeys,i
If dBuf.Exists(sItem) then
lSi=CLng(dBuf.Item(sItem))
aKeys=dBuf.Keys
aItems=dBuf.Items
lOf=0
For i=0 To dBuf.Count-1
If aKeys(i)=sItem Then Exit For
lOf=lOf+aItems(i)
Next
GetItem=GetDataBSTR(Ptr,lSi,lOf)
Else
GetItem=""
err.raise 10000,"Method GetItem","The item " & sItem & "don't exist"
End If
End Function
Public Function GetBSTRPtr(ByRef sData)
'retun the TRUE address (variant long) of the sData string BSTR
Dim pSource
Dim pDest
If VarType(sData)<>vbString Then 'little check
GetBSTRPtr=0
err.raise 10000, "GetBSTRPtr", "The variable is not a string"
Exit Function
End If
pSource=oSCat.lstrcat(sData,"") 'trick to return sData pointer
pDest=oSCat.lstrcat(GetBSTRPtr,"") 'idem
GetBSTRPtr=CLng(0) 'cast function variable
'l'adresse du contenu réel de sBuf (4octets) écrase le contenu de la variable GetBSTPtr
'les valeurs sont incrémentées de 8 octets pour tenir compte du Type Descriptor
oMM.RtlMovememory pDest+8,pSource+8,4
End Function
'************************************************* *************************** IMPLEMENTATION
Private Sub Class_Initialize 'Constructeur
Set oMM=CreateObject("DynamicWrapper")
oMM.Register "kernel32.dll","RtlMoveMemory","f=s","i=lll","r=l"
Set oSCat=CreateObject("DynamicWrapper")
oSCat.Register "kernel32.dll","lstrcat","f=s","i=ws","r=l"
Set oAnWi=CreateObject("DynamicWrapper")
oAnWi.Register "kernel32.dll","MultiByteToWideChar","f=s","i=llllll","r=l"
Set dBuf=CreateObject("Scripting.Dictionary")
sBuf=""
iOffset=0
End Sub
Private Sub SetDataBSTR(lpData,iSize,Data,ByRef iOfs)
'Place une valeur Data de taille iSize à l'adresse lpData+iOfs
Dim lW,hW,xBuf
Select Case iSize 'on commence par formater les valeurs numériques
Case 1
lW=Data mod 256 'formatage 8 bits
xBuf=ChrB(lW)
Case 2 'if any
lW=Data mod 65536 'formatage 16 bits
xBuf=ChrW(lW) 'formatage little-endian
Case 4
hW=Fix(Data/65536)'high word
lW=Data mod 65536 'low word
xBuf=ChrW(lW) & ChrW(hW) 'formatage little-endian
Case Else 'bytes array, size iSize
xBuf=Data
End Select
oMM.RtlMovememory lpData+iOfs,GetBSTRPtr(xBuf),iSize
iOfs=iOfs+iSize 'maj l'offset
End Sub
Private Function GetDataBSTR(lpData,iSize,iOffset)
'Read an iSize data to lpData+iOffset address
Const CP_ACP=0 'code ANSI
Dim pDest,tdOffset
'valeurs pour les données numériques
pDest=oSCat.lstrcat(GetDataBSTR,"")
tdOffset=8
Select Case iSize ' cast de la variable fonction
Case 1
GetDataBSTR=CByte(0)
Case 2
GetDataBSTR=CInt(0)
Case 4
GetDataBSTR=CLng(0)
Case Else 'a little bit more complicated with string data...
GetDataBSTR=String(iSize/2,Chr(0))
'la chaine variant BSTR stocke ses données ailleurs
pDest=GetBSTRPtr(GetDataBSTR)
tdOffset=0
End Select
'le contenu de la structure à l'offset iOffset écrase le contenu de la variable GetDataBSTR (tenir compte du TD)
oMM.RtlMovememory pDest+tdOffset,lpData+iOffset,iSize
if tdOffset=0 Then
oAnWi.MultiByteToWideChar CP_ACP,0,lpData+iOffset,-1,pDest,iSize 'don't forget conversion Ansi->Wide
GetDataBSTR=Replace(GetDataBSTR,Chr(0),"")
'clean the trailer
End If
End Function
End Class
你想表达什么？
这段代码只是为了描述STRUCT结构随便抄录下来的一段，你想完整运行吗？
对，我想完整运行一下