欢迎使用金字塔普通技术服务论坛,您可以在相关区域发表技术支持贴。
我司技术服务人员将优先处理 VIP客服论坛 服务贴,普通区问题处理速度慢,请耐心等待。谢谢您对我们的支持与理解。


金字塔客服中心 - 专业程序化交易软件提供商金字塔软件高级功能研发区 → [求助]VBS中如何定义STRUCT

   

欢迎使用金字塔普通技术服务论坛,您可以在相关区域发表技术支持贴。
我司技术服务人员将优先处理 VIP客服论坛 服务贴,普通区问题处理速度慢,请耐心等待。谢谢您对我们的支持与理解。    


  共有3712人关注过本帖平板打印复制链接

主题:[求助]VBS中如何定义STRUCT

帅哥哟,离线,有人找我吗?
yeyi
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:论坛游民 帖子:253 积分:1742 威望:0 精华:0 注册:2010/8/12 13:04:52
[求助]VBS中如何定义STRUCT  发帖心情 Post By:2013/5/12 11:15:07 [只看该作者]

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

 


 回到顶部