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


金字塔客服中心 - 专业程序化交易软件提供商金字塔软件高级功能研发区 → 关于DynamicWrapper请教

   

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


  共有4343人关注过本帖树形打印复制链接

主题:关于DynamicWrapper请教

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


加好友 发短信
等级:新手上路 帖子:93 积分:440 威望:0 精华:0 注册:2012/10/31 22:13:12
关于DynamicWrapper请教  发帖心情 Post By:2013/5/2 15:42:27 [只看该作者]

 请问高手,DynamicWrapper调用Win32 API时,如果API中类型是一个TYPE,应该用哪种变量类型,比如参数中有一个变量类型是是

Type WSAData
   wVersion       As Integer
   wHighVersion   As Integer
   szDescription  As String * WSADESCRIPTION_LEN
   szSystemStatus As String * WSASYS_STATUS_LEN
   iMaxSockets    As Integer
   iMaxUdpDg      As Integer
   lpVendorInfo   As Long
End Type

那我的i=对应的值是什么。这个也许跟金字塔本身关系不大,但我是VB初学者,一直没搞明白,期望高手帮忙解答,谢谢。


 回到顶部
帅哥哟,离线,有人找我吗?
王锋
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:罗宾汉 帖子:11809 积分:20695 威望:0 精华:10 注册:2009/8/18 8:15:13
  发帖心情 Post By:2013/5/2 16:27:50 [只看该作者]

网上帮你搜到的

 

代码测试功能为获取当前光标位置。

有关VBS调用API请参考http://blog.xcyh.org/life/vbs-call-api

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


金字塔—专业程序化软件提供商

金字塔-技术部

-----------------------------------------------------------------------------------------------------

工作时间:周一至周五 08:30 - 17:30   周末及法定节假日休息

Email:service@weistock.com
 回到顶部