module1.vb

USB2I2C USB2SPI USB2ISP资料开发包

Option Strict Off
Option Explicit On
Module Module1
	
	Structure arrRBuffer
		<VBFixedArray(mMAX_BUFFER_LENGTH - 1)> Dim buf() As Byte
		
		'UPGRADE_TODO: 必须调用“Initialize”来初始化此结构的实例。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="B4BFF9E0-8631-45CF-910E-62AB3970F27B"”
		Public Sub Initialize()
			ReDim buf(mMAX_BUFFER_LENGTH - 1)
		End Sub
	End Structure
	
	Public Const WM_KEYUP As Short = &H101s
	Public Const BN_CLICK As Short = &H101s
	Public eepromid As USBIOXDLL.EEPROM_TYPE 'eeprom型号
	Public Declare Function PostMessage Lib "user32"  Alias "PostMessageA"(ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
	
	Public mIndex As Integer
	Public mOpen As Boolean
	
	
	Public Function mCharToBcd(ByVal iChar As String) As Byte ' 输入的ASCII字符
		Dim mBCD As Byte
		If iChar >= "0" And iChar <= "9" Then
			mBCD = CDbl(iChar) - CDbl("0")
		ElseIf iChar >= "A" And iChar <= "F" Then 
			mBCD = Asc(iChar) - Asc("A") + &HAs
		ElseIf iChar >= "a" And iChar <= "f" Then 
			mBCD = Asc(iChar) - Asc("a") + &HAs
		Else
			mBCD = &HFFs
		End If
		mCharToBcd = mBCD
	End Function
	
	'UPGRADE_NOTE: str 已升级到 str_Renamed。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="A9E4979A-37FA-4718-9994-97DD76ED70A7"”
	Sub mStrtoVal(ByRef str_Renamed As String, ByRef strOut As arrRBuffer, ByRef strleng As Integer)
		Dim i As Object
		Dim j As Integer
		Dim mLen As Integer
		Dim strRev(mMAX_BUFFER_LENGTH - 1) As Byte
		mLen = strleng * 2
		j = 0
		For i = 0 To mLen - 1 Step 2
			'UPGRADE_WARNING: 未能解析对象 i 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"”
			If (mCharToBcd(Mid(str_Renamed, i + 1, 1)) = &HFFs Or mCharToBcd(Mid(str_Renamed, i + 2, 1)) = &HFFs) Then
				GoTo con
			End If
			'   strRev(j) = mCharToBcd(Mid(str, i + 1, 1)) * 16 + mCharToBcd(Mid(str, i + 2, 1))
			'UPGRADE_WARNING: 未能解析对象 i 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"”
			strRev(j) = mCharToBcd(Mid(str_Renamed, i + 1, 1)) * 16 + mCharToBcd(Mid(str_Renamed, i + 2, 1))
			Debug.Print(Hex(strRev(j)))
			j = j + 1
con: Next 
		j = 0
		While (j < strleng)
			strOut.buf(j) = strRev(j)
			j = j + 1
		End While
	End Sub
	
	Function Hex2bit(ByRef var As Byte) As String
		If var < 16 Then
			Hex2bit = "0" & Hex(var)
		Else
			Hex2bit = Hex(var)
		End If
	End Function
	'UPGRADE_NOTE: str 已升级到 str_Renamed。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="A9E4979A-37FA-4718-9994-97DD76ED70A7"”
	Function HexToBcd(ByRef str_Renamed As String) As Integer '将文本框中输入的十六进制值转换成BCD码
		Dim Length As Short
		Dim X As String
		Dim i As Integer
		str_Renamed = Trim(str_Renamed)
		Length = Len(str_Renamed)
		For i = 0 To Length - 1
			X = Mid(str_Renamed, Length - i, 1)
			Select Case X
				Case "a", "A"
					HexToBcd = HexToBcd + 10 * (16 ^ i)
				Case "b", "B"
					HexToBcd = HexToBcd + 11 * (16 ^ i)
				Case "c", "C"
					HexToBcd = HexToBcd + 12 * (16 ^ i)
				Case "d", "D"
					HexToBcd = HexToBcd + 13 * (16 ^ i)
				Case "e", "E"
					HexToBcd = HexToBcd + 14 * (16 ^ i)
				Case "f", "F"
					HexToBcd = HexToBcd + 15 * (16 ^ i)
				Case "0" To "9"
					HexToBcd = HexToBcd + Val(X) * 16 ^ i
				Case Else
					'MsgBox "非十六进制数", vbCritical, "信息提示"
					HexToBcd = 0
			End Select
		Next i
	End Function
	Public Sub mUSBIO_NOTIFY_ROUTINE(ByVal iEventStatus As Integer)
		PostMessage(frmMain.USBIO_NOTIFY_ROUTINE.Handle.ToInt32, WM_KEYUP, iEventStatus, 0) '将接收到的插拔事件值发到插拔处理程序中
	End Sub
End Module