基本信息
源码名称：vb USB通讯示例源码
源码大小：0.01M
文件格式：.rar
开发语言：ASP
更新时间：2018-09-14
友情提示：（无需注册或充值，赞助后即可获取资源下载链接）
嘿，亲！知识可是无价之宝呢，但咱这精心整理的资料也耗费了不少心血呀。小小地破费一下，绝对物超所值哦！如有下载和支付问题，请联系我们QQ(微信同号)：813200300
本次赞助数额为： 2 元×
微信扫码支付：2 元
×
请留下您的邮箱，我们将在2小时内将文件发到您的邮箱
源码介绍
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Form1"
ClientHeight = 6060
ClientLeft = 45
ClientTop = 435
ClientWidth = 9075
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
MousePointer = 1 'Arrow
ScaleHeight = 6060
ScaleMode = 0 'User
ScaleWidth = 9075
StartUpPosition = 3 '窗口缺省
Begin VB.ListBox List1
Height = 5820
ItemData = "Form1.frx":0000
Left = 2760
List = "Form1.frx":0002
TabIndex = 11
Top = 120
Width = 6255
End
Begin VB.Frame Frame3
Caption = "RWStart area"
Height = 1815
Left = 120
TabIndex = 8
Top = 4080
Width = 2535
Begin VB.CommandButton Command2
Caption = "结束"
Height = 495
Left = 360
TabIndex = 10
Top = 1200
Width = 1335
End
Begin VB.CommandButton Command1
Caption = "开启"
Height = 495
Left = 360
TabIndex = 9
Top = 240
Width = 1335
End
End
Begin VB.Frame Frame2
Caption = "Data receive area"
Height = 1935
Left = 120
TabIndex = 5
Top = 2160
Width = 2535
Begin VB.TextBox Text4
Height = 375
Left = 1440
TabIndex = 7
Top = 720
Width = 975
End
Begin VB.TextBox Text3
Height = 375
Left = 1440
TabIndex = 6
Top = 240
Width = 975
End
Begin VB.Label Label4
Caption = "接收高字节："
Height = 255
Left = 120
TabIndex = 13
Top = 720
Width = 1215
End
Begin VB.Label Label3
Caption = "接收低字节："
Height = 255
Left = 120
TabIndex = 12
Top = 360
Width = 1215
End
End
Begin VB.Frame Frame1
Caption = "Data send area"
Height = 1935
Left = 120
TabIndex = 0
Top = 120
Width = 2535
Begin VB.TextBox Text2
Height = 375
Left = 1440
TabIndex = 2
Top = 720
Width = 975
End
Begin VB.TextBox Text1
Height = 375
Left = 1440
TabIndex = 1
Top = 240
Width = 975
End
Begin VB.Label Label2
Caption = "发送高字节："
Height = 255
Left = 120
TabIndex = 4
Top = 720
Width = 1095
End
Begin VB.Label Label1
Caption = "发送低字节："
Height = 255
Left = 120
TabIndex = 3
Top = 360
Width = 1095
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit '程序中所有变量必须全部声明，否则编译出错
Dim bAlertable As Long
Dim Capabilities As HIDP_CAPS
Dim DataString As String
Dim DetailData As Long
Dim DetailDataBuffer() As Byte
Dim DeviceAttributes As HIDD_ATTRIBUTES
Dim DevicePathName As String
Dim DeviceInfoSet As Long
Dim ErrorString As String
Dim EventObject As Long
Dim HIDHandle As Long
Dim HIDOverlapped As OVERLAPPED
Dim LastDevice As Boolean
Dim MyDeviceDetected As Boolean
Dim MyDeviceInfoData As SP_DEVINFO_DATA
Dim MyDeviceInterfaceDetailData As SP_DEVICE_INTERFACE_DETAIL_DATA
Dim MyDeviceInterfaceData As SP_DEVICE_INTERFACE_DATA
Dim Needed As Long
Dim OutputReportData(7) As Byte
Dim PreparsedData As Long
Dim ReadHandle As Long
Dim Result As Long
Dim Security As SECURITY_ATTRIBUTES
Dim Timeout As Boolean
Dim Buffer() As Byte '转换字符串的缓冲区
Dim RWflage As Boolean
'这是厂商ID以及产品ID定义
'16进制定义
Const MyVendorID = &H925
Const MyProductID = &H1299
'系统初始化
Private Sub Form_Load()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
MyDeviceDetected = False
End Sub
'数据转换与发送
Private Sub Command1_Click()
RWflage = False
If Text1.Text = "" Or Text2.Text = "" Then
MsgBox "数据输入不能为空"
Else
If (Len(Text1.Text) > 2) Or (Len(Text1.Text) > 2) Then
MsgBox "输入数据范围超出"
Else
Call StrringToHex '字符串转换为16进制数进行发送
End If
End If
If RWflage = True Then
Call StartRW '调用函数进行数据发送与接收
RWflage = False
End If
End Sub
'字符串到16进制数转换函数
Private Sub StrringToHex()
Dim Stri(4) As String
Dim Store(4) As Byte
Dim Flageerror1 As Boolean
Dim Flageerror2 As Boolean
Dim Flageerror3 As Boolean
Dim Flageerror4 As Boolean
Flageerror1 = True
Flageerror2 = True
Flageerror3 = True
Flageerror4 = True
's首先转换低位数
Stri(0) = Mid$(Text1.Text, 1, 1)
If (Stri(0) >= "0") And (Stri(0) <= "9") Then
Store(0) = Asc(Stri(0)) - Asc("0")
Else
If (Stri(0) >= "A") And (Stri(0) <= "F") Then
Store(0) = Asc(Stri(0)) - Asc("A") 10
Else
If (Stri(0) >= "a") And (Stri(0) <= "f") Then
Store(0) = Asc(Stri(0)) - Asc("a") 10
Else
Flageerror1 = False
MsgBox "输入数据有错，不再范围内"
End If
End If
End If
Stri(1) = Mid$(Text1.Text, 2, 1)
If (Stri(1) >= "0") And (Stri(1) <= "9") Then
Store(1) = Asc(Stri(1)) - Asc("0")
Else
If (Stri(1) >= "A") And (Stri(1) <= "F") Then
Store(1) = Asc(Stri(1)) - Asc("A") 10
Else
If (Stri(1) >= "a") And (Stri(1) <= "f") Then
Store(1) = Asc(Stri(1)) - Asc("a") 10
Else
Flageerror2 = False
MsgBox "输入数据有错，不再范围内"
End If
End If
End If
Stri(2) = Mid$(Text2.Text, 1, 1)
If (Stri(2) >= "0") And (Stri(2) <= "9") Then
Store(2) = Asc(Stri(2)) - Asc("0")
Else
If (Stri(2) >= "A") And (Stri(2) <= "F") Then
Store(2) = Asc(Stri(2)) - Asc("A") 10
Else
If (Stri(2) >= "a") And (Stri(2) <= "f") Then
Store(2) = Asc(Stri(2)) - Asc("a") 10
Else
Flageerror3 = False
MsgBox "输入数据有错，不再范围内"
End If
End If
End If
Stri(3) = Mid$(Text2.Text, 2, 1)
If (Stri(3) >= "0") And (Stri(3) <= "9") Then
Store(3) = Asc(Stri(3)) - Asc("0")
Else
If (Stri(3) >= "A") And (Stri(3) <= "F") Then
Store(3) = Asc(Stri(3)) - Asc("A") 10
Else
If (Stri(3) >= "a") And (Stri(3) <= "f") Then
Store(3) = Asc(Stri(3)) - Asc("a") 10
Else
Flageerror4 = False
MsgBox "输入数据有错，不再范围内"
End If
End If
End If
If (Flageerror1 = True) And (Flageerror1 = True) And (Flageerror1 = True) And (Flageerror1 = True) Then
RWflage = True
OutputReportData(0) = (Store(0) * 16 Store(1))
OutputReportData(1) = (Store(2) * 16 Store(3))
End If
End Sub
Private Sub StartRW()
Dim count As Integer
List1.AddItem ""
List1.AddItem "***** HID Test Report *****"
List1.AddItem " " & Format(Now, "general date")
If MyDeviceDetected = False Then
MyDeviceDetected = FindtheHid
End If
If MyDeviceDetected = True Then '如果设备找到了，准备数据进行发送
'OutputReportData(0) = Val(Text1.Text)
'OutputReportData(1) = Val(Text2.Text)
Call WriteReport
Call ReadReport
End If
List1.ListIndex = List1.ListCount - 1
'清楚部分数据，最多显示300个列表
If List1.ListCount > 300 Then
For count = 1 To 100
List1.RemoveItem (count)
Next count
End If
End Sub
'系统退出函数
Private Sub Command2_Click()
Dim a As Integer
a = MsgBox("确定要退出?", 1 64 0)
If a = 1 Then
End
End If
End Sub
'查询HID函数
Function FindtheHid() As Boolean
Dim HidGuid As GUID
Dim MemberIndex As Long
Dim GUIDString As String
Dim count As Integer
LastDevice = False
MyDeviceDetected = False
Security.lpSecurityDescriptor = 0
Security.bInheritHandle = True
Security.nLength = Len(Security)
'*******************************************************
'HidD_GetHidGuid
'获得HID GUID
'Returns: the GUID in HidGuid.
'这个函数不从Result返回数值
'*******************************************************
Result = HidD_GetHidGuid(HidGuid)
Call DisplayResultOfAPICall("GetHidGuid")
GUIDString = Hex$(HidGuid.Data1) & "-" & _
Hex$(HidGuid.Data2) & "-" & _
Hex$(HidGuid.Data3) & "-"
For count = 0 To 7
If HidGuid.Data4(count) >= &H10 Then
GUIDString = GUIDString & Hex$(HidGuid.Data4(count))
Else
GUIDString = GUIDString & "0" & Hex$(HidGuid.Data4(count))
End If
Next count
List1.AddItem " GUID is:" & GUIDString
'*****************************************************
'SetupDiGetClassDevs
'返回值：是所有HID设备的借口的数组地址
'需要参数：HidD_GetHidGuid函数返回的HidGuid
'*****************************************************
DeviceInfoSet = SetupDiGetClassDevs _
(HidGuid, _
vbNullString, _
0, _
(DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE))
Call DisplayResultOfAPICall("SetupDiClassDevs")
DataString = GetDataString(DeviceInfoSet, 32)
List1.AddItem DataString
'*****************************************************
'SetupDiEnumDeviceInterfaces识别HID接口
'次函数每一次调用都必须传递一个数组索引值来指定一个接口，用于查询所需要的HID接口
'DeviceInfoSet是SetupDiGetClassDevs函数的返回值
'InterfaceClassGuid 是HidGuid
'DeviceInterfaceData是要传回的结构，来识别HID的一个接口
'*****************************************************
MemberIndex = 0
Do
MyDeviceInterfaceData.cbSize = LenB(MyDeviceInterfaceData)
Result = SetupDiEnumDeviceInterfaces _
(DeviceInfoSet, _
0, _
HidGuid, _
MemberIndex, _
MyDeviceInterfaceData)
If Result = 0 Then LastDevice = True '如果返回0则证明所有查询已经结束
If Result <> 0 Then
List1.AddItem " DeviceInfoSet for device #" & CStr(MemberIndex) & ": "
List1.AddItem " cbSize = " & CStr(MyDeviceInterfaceData.cbSize)
List1.AddItem " InterfaceclassGuid =" & GUIDString
List1.AddItem " Flage =" & Hex$(MyDeviceInterfaceData.Flags)
'******************************************************************************
'SetupDiGetDeviceInterfaceDetail取得设备的路径,这个函数需要调用两次才能传递成功
'返回值：SP_DEVICE_INTERFACE_DETAIL_DATA结构，包含设备的信息
'调用两次：第一次返回正确的DeviceInterfaceDetailDataSize（Needed）
' 第二次返回正确的结构体
'******************************************************************************
MyDeviceInfoData.cbSize = Len(MyDeviceInfoData)
Result = SetupDiGetDeviceInterfaceDetail _
(DeviceInfoSet, _
MyDeviceInterfaceData, _
0, _
0, _
Needed, _
0)
DetailData = Needed
Call DisplayResultOfAPICall("SetupDiGetDeviceInterfaceDetail")
List1.AddItem " (OK to say too small)"
List1.AddItem " Required buffer size for the data: " & Needed
'Store the structure's size.
MyDeviceInterfaceDetailData.cbSize = _
Len(MyDeviceInterfaceDetailData)
ReDim DetailDataBuffer(Needed) '分配给字节数组足够的内存来存储结构
'把cbSize存储在数组的前4个字节中
Call RtlMoveMemory _
(DetailDataBuffer(0), _
MyDeviceInterfaceDetailData, _
4)
'Call SetupDiGetDeviceInterfaceDetail again.
'This time, pass the address of the first element of DetailDataBuffer
'and the returned required buffer size in DetailData.
Result = SetupDiGetDeviceInterfaceDetail _
(DeviceInfoSet, _
MyDeviceInterfaceData, _
VarPtr(DetailDataBuffer(0)), _
DetailData, _
Needed, _
0)
Call DisplayResultOfAPICall(" Result of second call: ")
List1.AddItem " MyDeviceInterfaceDetailData.cbSize: " & _
CStr(MyDeviceInterfaceDetailData.cbSize)
'Convert the byte array to a string.
DevicePathName = CStr(DetailDataBuffer())
'Convert to Unicode.
DevicePathName = StrConv(DevicePathName, vbUnicode)
'Strip cbSize (4 bytes) from the beginning.
DevicePathName = Right$(DevicePathName, Len(DevicePathName) - 4)
List1.AddItem " Device pathname: "
List1.AddItem " " & DevicePathName
'*******************************************************************
'CreateFile取得设备的代号
'应用此函数获得设备的代号，以后使用设备的代号来与设备交换数据
'数据需求：SetupDiGetDeviceInterfaceDetail函数返回的设备路径
'*******************************************************************
HIDHandle = CreateFile _
(DevicePathName, _
GENERIC_READ Or GENERIC_WRITE, _
(FILE_SHARE_READ Or FILE_SHARE_WRITE), _
Security, _
OPEN_EXISTING, _
0&, _
0)
Call DisplayResultOfAPICall("CreateFile")
List1.AddItem " Returned handle: " & Hex$(HIDHandle) & "h"
'下面开始检测HID接口是否是我们需要的HID接口，通过判断厂商ID与产品ID来确定
'************************************************************************
'HidD_GetAttributes 获得厂商ID以及产品ID
'数据需求：HIDD_ATTRIBUTES结构的Size成员的大小
' 产品的HIDHandle(在CreatFile中的返回值)
'************************************************************************
DeviceAttributes.Size = LenB(DeviceAttributes)
Result = HidD_GetAttributes _
(HIDHandle, _
DeviceAttributes)
Call DisplayResultOfAPICall("HidD_GetAttributes")
If Result <> 0 Then
List1.AddItem " HIDD_ATTRIBUTES 结构文件读取无误 "
Else
List1.AddItem " HIDD_ATTRIBUTES 结构文件读取错误 "
End If
List1.AddItem " Structure size: " & DeviceAttributes.Size
List1.AddItem " Vendor ID: " & Hex$(DeviceAttributes.VendorID)
List1.AddItem " Product ID: " & Hex$(DeviceAttributes.ProductID)
List1.AddItem " Version Number: " & Hex$(DeviceAttributes.VersionNumber)
If (DeviceAttributes.VendorID = MyVendorID) And (DeviceAttributes.ProductID = MyProductID) Then
List1.AddItem " My device detected"
MyDeviceDetected = True
Else
MyDeviceDetected = False
'如果不是我们要找的HID接口，关闭此接口的代号
Result = CloseHandle _
(HIDHandle)
Call DisplayResultOfAPICall("CloseHandle")
End If
MemberIndex = MemberIndex 1 '查询下一个
End If
Loop Until (LastDevice = True) Or (MyDeviceDetected = True)
'释放SetupDiGetClassDevs函数获得的所有连接设备结构数组
Result = SetupDiDestroyDeviceInfoList _
(DeviceInfoSet)
Call DisplayResultOfAPICall("DestroyDeviceInfoList")
If MyDeviceDetected = True Then
FindtheHid = True '函数返回值
'获得设备的信息
Call GetDeviceCapabilities
'获得读的代号
ReadHandle = CreateFile _
(DevicePathName, _
(GENERIC_READ Or GENERIC_WRITE), _
(FILE_SHARE_READ Or FILE_SHARE_WRITE), _
Security, _
OPEN_EXISTING, _
FILE_FLAG_OVERLAPPED, _
0)
Call DisplayResultOfAPICall("CreateFile, ReadHandle")
List1.AddItem " Returned handle: " & Hex$(ReadHandle) & "h"
Else
List1.AddItem " Device not found."
FindtheHid = False '函数返回值
End If
End Function
'取得设备的信息
Private Sub GetDeviceCapabilities()
'***************************************************************
'HidD_GetPreparsedData
' HidDeviceObject 是前面CREATFILE函数获得的设备代号
' PreparsedData是函数返回值，使一个班汉数据的缓冲区的指针
'***************************************************************
Result = HidD_GetPreparsedData _
(HIDHandle, _
PreparsedData)
'***************************************************************
'HidP_GetCaps取得设备的能力
'是获得设备的报表描述符的一些基本内容，比如Usage、UsagePage、报表长度以及按钮能力、数值能力等的数目
'***************************************************************
Result = HidP_GetCaps _
(PreparsedData, _
Capabilities)
Call DisplayResultOfAPICall("HidP_GetCaps")
List1.AddItem " Last error: " & ErrorString
List1.AddItem " Usage: " & Hex$(Capabilities.Usage)
List1.AddItem " Usage Page: " & Hex$(Capabilities.UsagePage)
List1.AddItem " Input Report Byte Length: " & Capabilities.InputReportByteLength
List1.AddItem " Output Report Byte Length: " & Capabilities.OutputReportByteLength
List1.AddItem " Feature Report Byte Length: " & Capabilities.FeatureReportByteLength
List1.AddItem " Number of Link Collection Nodes: " & Capabilities.NumberLinkCollectionNodes
List1.AddItem " Number of Input Button Caps: " & Capabilities.NumberInputButtonCaps
List1.AddItem " Number of Input Value Caps: " & Capabilities.NumberInputValueCaps
List1.AddItem " Number of Input Data Indices: " & Capabilities.NumberInputDataIndices
List1.AddItem " Number of Output Button Caps: " & Capabilities.NumberOutputButtonCaps
List1.AddItem " Number of Output Value Caps: " & Capabilities.NumberOutputValueCaps
List1.AddItem " Number of Output Data Indices: " & Capabilities.NumberOutputDataIndices
List1.AddItem " Number of Feature Button Caps: " & Capabilities.NumberFeatureButtonCaps
List1.AddItem " Number of Feature Value Caps: " & Capabilities.NumberFeatureValueCaps
List1.AddItem " Number of Feature Data Indices: " & Capabilities.NumberFeatureDataIndices
'*****************************************************************
'HidP_GetValueCaps 取得设备的数值能力
'此函数传回一个报表中关于每个数值的信息的结构数组的指针
'NumberInputValueCaps属性是HidP_GetCaps函数返回结构中的Capabilities.NumberInputValueCaps属性
'*****************************************************************
Dim ValueCaps(1023) As Byte
Result = HidP_GetValueCaps _
(HidP_Input, _
ValueCaps(0), _
Capabilities.NumberInputValueCaps, _
PreparsedData)
Call DisplayResultOfAPICall("HidP_GetValueCaps")
'释放获得的设备能力的缓冲区指针
Result = HidD_FreePreparsedData _
(PreparsedData)
Call DisplayResultOfAPICall("HidD_FreePreparsedData")
End Sub
'写数据到设备
Private Sub WriteReport()
Dim count As Integer
Dim NumberOfBytesToSend As Long
Dim NumberOfBytesWritten As Long
Dim ReadBuffer() As Byte
Dim SendBuffer() As Byte
ReDim SendBuffer(Capabilities.OutputReportByteLength - 1)
SendBuffer(0) = 0 '这是报表ID号
For count = 1 To Capabilities.OutputReportByteLength - 1
SendBuffer(count) = OutputReportData(count - 1) '发送数据到发送缓冲区
Next count
NumberOfBytesWritten = 0
Result = WriteFile _
(HIDHandle, _
SendBuffer(0), _
CLng(Capabilities.OutputReportByteLength), _
NumberOfBytesWritten, _
0)
Call DisplayResultOfAPICall("WriteFile")
List1.AddItem " OutputReportByteLength = " & Capabilities.OutputReportByteLength
List1.AddItem " NumberOfBytesWritten = " & NumberOfBytesWritten
List1.AddItem " Report ID: " & SendBuffer(0)
List1.AddItem " Report Data:"
'UBound函数返回数组的长度（返回值是long型数据）
For count = 1 To UBound(SendBuffer)
List1.AddItem " " & Hex$(SendBuffer(count))
Next count
End Sub
'读取报表函数
Private Sub ReadReport()
Dim count
Dim NumberOfBytesRead As Long
Dim ReadBuffer() As Byte
Dim UBoundReadBuffer As Integer
Dim ByteValue As String
ReDim ReadBuffer(Capabilities.InputReportByteLength - 1)
'把列表框滚动到最低部
List1.ListIndex = List1.ListCount - 1
'建立一个事件对象来指示ReadFile的完成
If EventObject = 0 Then
EventObject = CreateEvent _
(Security, _
True, _
True, _
"")
End If
Call DisplayResultOfAPICall("CreateEvent")
HIDOverlapped.Offset = 0
HIDOverlapped.OffsetHigh = 0
HIDOverlapped.hEvent = EventObject
Result = ReadFile _
(ReadHandle, _
ReadBuffer(0), _
CLng(Capabilities.InputReportByteLength), _
NumberOfBytesRead, _
HIDOverlapped)
Call DisplayResultOfAPICall("ReadFile")
'等待数据取回完毕
List1.AddItem "waiting for ReadFile"
List1.ListIndex = List1.ListCount - 1
'****************************************************************
'WaitForSingleObject
'函数返回值代表是在规定时间内传回数据还是时间溢出
'****************************************************************
Result = WaitForSingleObject _
(EventObject, _
6000) '6000代表6000毫秒
Select Case Result
Case WAIT_OBJECT_0 '如果数据完成的话
List1.AddItem "ReadFile completed successfully."
Case WAIT_TIMEOUT '如果超时接收数据
'释放设备代号句柄
Result = CancelIo _
(ReadHandle)
Call DisplayResultOfAPICall("CancelIo")
'产生的原因可能是由于设备移除，所以应该释放设备代号
CloseHandle (HIDHandle)
Call DisplayResultOfAPICall("CloseHandle (HIDHandle)")
CloseHandle (ReadHandle)
Call DisplayResultOfAPICall("CloseHandle (ReadHandle)")
MyDeviceDetected = False
Case Else '其他情况下
List1.AddItem "Readfile undefined error"
MyDeviceDetected = False
End Select
List1.AddItem " Report ID: " & ReadBuffer(0)
List1.AddItem " Report Data:"
Text3.Text = ""
Text4.Text = ""
For count = 1 To UBound(ReadBuffer)
'Add a leading 0 to values 0 - Fh.
If Len(Hex$(ReadBuffer(count))) < 2 Then
ByteValue = "0" & Hex$(ReadBuffer(count))
Else
ByteValue = Hex$(ReadBuffer(count))
End If
List1.AddItem " " & ByteValue
'Display the received bytes in the text box.
Next count
If (ReadBuffer(1)) < 16 Then
Text3.Text = "0" & Hex$(ReadBuffer(1))
Else
Text3.Text = Hex$(ReadBuffer(1))
End If
If (ReadBuffer(2)) < 16 Then
Text4.Text = "0" & Hex$(ReadBuffer(2))
Else
Text4.Text = Hex$(ReadBuffer(2))
End If
Call ResetEvent(EventObject)
Call DisplayResultOfAPICall("ResetEvent")
End Sub
'添加头
Private Sub DisplayResultOfAPICall(FunctionName As String)
List1.AddItem ""
List1.AddItem FunctionName & ":"
List1.ListIndex = List1.ListCount - 1
End Sub
'获得字符串表述符
Private Function GetDataString _
(Address As Long, _
Bytes As Long) _
As String
Dim Offset As Integer
Dim Result$
Dim ThisByte As Byte
For Offset = 0 To Bytes - 1
Call RtlMoveMemory(ByVal VarPtr(ThisByte), ByVal Address Offset, 1)
If (ThisByte And &HF0) = 0 Then
Result$ = Result$ & "0"
End If
Result$ = Result$ & Hex$(ThisByte)
Next Offset
GetDataString = Result$
End Function