以文本方式查看主题

-  金字塔客服中心 - 专业程序化交易软件提供商  (http://weistock.com/bbs/index.asp)
--  高级功能研发区  (http://weistock.com/bbs/list.asp?boardid=5)
----  [求助]VBS中如何定义STRUCT  (http://weistock.com/bbs/dispbbs.asp?boardid=5&id=51927)

--  作者:yeyi
--  发布时间:2013/5/12 11:15:07
--  [求助]VBS中如何定义STRUCT

看见大侠们编的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

 


--  作者:王锋
--  发布时间:2013/5/12 17:55:57
--  

你想表达什么?

这段代码只是为了描述STRUCT结构随便抄录下来的一段,你想完整运行吗?


--  作者:yeyi
--  发布时间:2013/5/12 20:18:46
--  

对,我想完整运行一下