蓝牙编程VB资料，高手请转成DELPHI，供给大家学习！加上注释哦(100分)

Attribute VB_Name = "mdlCSRUSB"
'/////////////////////////////////////////////////////////
'USB 常量定义
Public Const CSRUSB_MAX = 10

Public Const FILE_FLAG_OVERLAPPED = &H40000000
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const OPEN_EXISTING = 3
Public Const INVALID_HANDLE_VALUE = -1
Public Const ERROR_IO_PENDING = 997
Public Const ERROR_INVALID_PARAMETER = 87

Public Const IOCTL_CSRBC01_SEND_HCI_COMMAND = 2228226
Public Const IOCTL_CSRBC01_GET_HCI_EVENT = 2228228
Public Const IOCTL_CSRBC01_GET_VERSION = 2228232
Public Const IOCTL_CSRBC01_DRIVER_NAME = 2228236
Public Const IOCTL_CSRBC01_GET_CONFIG_DESCRIPTOR = 2228224
Public Const IOCTL_CSRBC01_GET_DEVICE_DESCRIPTOR = 2228228
Public Const IOCTL_CSRBC01_RESET_DEVICE = 2228232
Public Const IOCTL_CSRBC01_RESET_PIPE = 2228236
Public Const IOCTL_CSRBC01_BLOCK_HCI_EVENT = 2228224
Public Const IOCTL_CSRBC01_BLOCK_HCI_DATA = 2228228

'/////////////////////////////////////////////////////////
'API 结构体定义
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type

Public Type OVERLAPPED
Internal As Long
InternalHigh As Long
Offset As Long
OffsetHigh As Long
hEvent As Long
End Type

'/////////////////////////////////////////////////////////
'USB 结构体定义
'Public Type CSRUSB_HCI_COMMAND '命令
' OpCode(1) As Byte
' TotalLength As Byte
' CommandParaeter(254) As Byte
'End Type
Public Type CSRUSB_HCI_EVENT '事件
EventParameter(1 To 255) As Byte
End Type
'Public Type CSRUSB_HCI_ACL_DATA 'ACL数据
' HandlePBBC(1) As Byte
' TotalLength(1) As Byte
' ACLData(&H7FFF) As Byte
'End Type
'Public Type CSRUSB_HCI_SCO_DATA 'SCO数据
' Connection_Handle(1) As Byte
' Total_Length(1) As Byte
' SCO_Data(&H7FFF) As Byte
'End Type

'/////////////////////////////////////////////////////////
'变量定义
Public Handle As Long

'/////////////////////////////////////////////////////////
'函数定义
Public Function CSRUSB_Test(PortID As Long) As Boolean
Dim StrCSRUSB As String
Dim MyHandle As Long
Dim MyLP As SECURITY_ATTRIBUTES

MyLP.nLength = 0
MyLP.lpSecurityDescriptor = 0
MyLP.bInheritHandle = False

If Handle <> INVALID_HANDLE_VALUE Then
CSRUSB_Close
End If

StrCSRUSB = "//./csr" & PortID
MyHandle = CreateFile _
( _
StrCSRUSB, _
GENERIC_READ Or GENERIC_WRITE, _
0, _
MyLP, _
OPEN_EXISTING, _
0, _
0 _
)
If MyHandle <> INVALID_HANDLE_VALUE Then
MyHandle = CloseHandle(MyHandle)
MyHandle = INVALID_HANDLE_VALUE
CSRUSB_Test = True
Else
CSRUSB_Test = False
End If

End Function

Public Function CSRUSB_Open(Device_Name As String) As Boolean
Dim MySEC_ATT As SECURITY_ATTRIBUTES

With MySEC_ATT
.nLength = 0
.lpSecurityDescriptor = 0
.bInheritHandle = False
End With

If Handle <> INVALID_HANDLE_VALUE Then
Handle = CloseHandle(Handle)
Handle = INVALID_HANDLE_VALUE
MDIFrmBS20.Caption = "BlueStack 2.0 [USB][" & BTModule & "][关闭]"
End If

Handle = CreateFile _
( _
Device_Name, _
GENERIC_READ Or GENERIC_WRITE, _
0, _
MySEC_ATT, _
OPEN_EXISTING, _
FILE_FLAG_OVERLAPPED, _
0 _
)

If Handle = INVALID_HANDLE_VALUE Then
MDIFrmBS20.Caption = "BlueStack 2.0 [USB][" & BTModule & "][关闭]"
CSRUSB_Open = False
Else
With MDIFrmBS20
.tmrHCIEVENT.Enabled = True
.tmrHCIACLDATA.Enabled = True
.Caption = "BlueStack 2.0 [USB][" & BTModule & "][" & Device_Name & "]"
End With
CSRUSB_Open = True
End If

End Function

Public Function CSRUSB_Is_Open() As Boolean

If Handle = INVALID_HANDLE_VALUE Then
PortType = UNKNOWN_PORT
CSRUSB_Is_Open = False
Else
PortType = USB_PORT
CSRUSB_Is_Open = True
End If

End Function

Public Function CSRUSB_Close()
Dim MyStatus As Long

If Handle <> INVALID_HANDLE_VALUE Then
MyStatus = CloseHandle(Handle)
End If

MDIFrmBS20.Caption = "BlueStack 2.0 [USB][" & BTModule & "][关闭]"

PortType = UNKNOWN_PORT
Handle = INVALID_HANDLE_VALUE

End Function

Public Function CSRUSB_Put_HCI_Command_Primitive(HCICommandPrimitive As HCI_COMMAND_PRIMITIVE, Length As Long) As Long
Dim Status As Long
Dim Written As Long
Static MyOVERLAPPED As OVERLAPPED

With MyOVERLAPPED
.hEvent = 0
.Internal = 0
.InternalHigh = 0
.Offset = 0
.OffsetHigh = 0
End With

If Handle <> INVALID_HANDLE_VALUE Then
Length = HCICommandPrimitive.Parameter_Total_Length + 3
Status = DeviceIoControl( _
Handle, _
IOCTL_CSRBC01_SEND_HCI_COMMAND, _
HCICommandPrimitive, _
Length, _
0, _
0, _
Written, _
MyOVERLAPPED _
)
'Length = Written
If (Status = 0) And (GetLastError() = ERROR_IO_PENDING) Then
Length = 0
Else
If Status = 0 Then
CSRUSB_Close
Length = 0
CSRUSB_Put_HCI_Command_Primitive = ERROR_PORT_CLOSED
Exit Function
End If

Status = GetOverlappedResult(Handle, MyOVERLAPPED, Written, 0)
If Status = 0 Then
Length = ERROR_ACTION_FAIL
Else
'None
End If
End If
CSRUSB_Put_HCI_Command_Primitive = Length
Else
Length = 0
CSRUSB_Put_HCI_Command_Primitive = ERROR_PORT_NOT_OPEN
End If

End Function

Public Function CSRUSB_Get_HCI_Event_Primitive(HCIEventPrimitive As HCI_EVENT_PRIMITIVE, Length As Long) As Long
Dim Status As Long
Dim Written As Long
Dim MyOVERLAPPED As OVERLAPPED

With MyOVERLAPPED
.hEvent = 0
.Internal = 0
.InternalHigh = 0
.Offset = 0
.OffsetHigh = 0
End With

If Handle <> INVALID_HANDLE_VALUE Then
Status = DeviceIoControl( _
Handle, _
IOCTL_CSRBC01_GET_HCI_EVENT, _
0, _
0, _
HCIEventPrimitive, _
16, _
Written, _
MyOVERLAPPED _
)
Length = Written
If (Status = 0) And (GetLastError() = ERROR_IO_PENDING) Then
Status = GetOverlappedResult(Handle, MyOVERLAPPED, Written, 0)
Else
If Status = 0 Then
CSRUSB_Close
CSRUSB_Get_HCI_Event_Primitive = ERROR_PORT_CLOSED
Exit Function
End If
End If

If Status = 0 Then
CSRUSB_Get_HCI_Event_Primitive = ERROR_ACTION_FAIL
Exit Function
End If

If Length > 0 Then
If Length = HCIEventPrimitive.Parameter_Total_Length + 2 Then
CSRUSB_Get_HCI_Event_Primitive = Length
Exit Function
Else
'事件没有接收完整
Dim TEventData As CSRUSB_HCI_EVENT
Dim Tlength As Long
Dim J As Long
Dim MyTimeOut As Long
While Length < (HCIEventPrimitive.Parameter_Total_Length + 2)
DoEvents
Status = DeviceIoControl( _
Handle, _
IOCTL_CSRBC01_GET_HCI_EVENT, _
0, _
0, _
TEventData, _
16, _
Written, _
MyOVERLAPPED _
)
Tlength = Written
If (Status = 0) And (GetLastError() = ERROR_IO_PENDING) Then
Status = GetOverlappedResult(Handle, MyOVERLAPPED, Written, 0)
Else
If Status = 0 Then
CSRUSB_Close
CSRUSB_Get_HCI_Event_Primitive = ERROR_PORT_CLOSED
Exit Function
End If
End If
If Status = 0 Then
CSRUSB_Get_HCI_Event_Primitive = ERROR_ACTION_FAIL
Exit Function
End If
If Tlength > 0 Then
For J = 1 To Tlength
HCIEventPrimitive.Event_Parameter(Length - 2 + J) = TEventData.EventParameter(J)
Next J
Length = Length + Tlength
Else
Sleep (50)
MyTimeOut = MyTimeOut + 1
If MyTimeOut > 20 Then
CSRUSB_Get_HCI_Event_Primitive = ERROR_HCI_EVENT_LOST
Exit Function
End If
End If
Wend
End If
CSRUSB_Get_HCI_Event_Primitive = Length
End If
Else
CSRUSB_Get_HCI_Event_Primitive = ERROR_PORT_NOT_OPEN
End If

End Function

Public Function CSRUSB_Put_ACL_Data_Primitive(MyHCIACL As Variant, MyLength As Long) As Long
Dim MyStatus As Long
Dim MyWritten As Long
Static MyOVERLAPPED As OVERLAPPED

With MyOVERLAPPED
.hEvent = 0
.Internal = 0
.InternalHigh = 0
.Offset = 0
.OffsetHigh = 0
End With

If Handle <> INVALID_HANDLE_VALUE Then
MyStatus = WriteFile( _
Handle, _
MyHCIACL, _
MyLength, _
MyWritten, _
MyOVERLAPPED _
)
If (MyStatus = 0) And (GetLastError() = ERROR_IO_PENDING) Then
MyWritten = 0
Else
If MyStatus <> 0 Then
CSRUSB_Close
MyWritten = 0
CSRUSB_Send_ACL_Data = MyWritten
Exit Function
End If

MyStatus = GetOverlappedResult(Handle, MyOVERLAPPED, MyWritten, 0)
If MyStatus = 0 Then
MyWritten = 0
End If
End If
CSRUSB_Put_ACL_Data_Primitive = MyWritten
Else
CSRUSB_Put_ACL_Data_Primitive = ERROR_PORT_NOT_OPEN
End If


End Function

Public Function CSRUSB_Get_HCI_ACL_Data_Primitive(MyHCIACLDataPrimitive As HCI_ACL_DATA_PRIMITIVE, MyLength As Long) As Long
Dim MyStatus As Long
Dim MyWritten As Long
Static MyOVERLAPPED As OVERLAPPED

With MyOVERLAPPED
.hEvent = 0
.Internal = 0
.InternalHigh = 0
.Offset = 0
.OffsetHigh = 0
End With

If Handle <> INVALID_HANDLE_VALUE Then
MyStatus = ReadFile( _
Handle, _
MyHCIACLDataPrimitive, _
Len(MyHCIACLDataPrimitive), _
MyWritten, _
MyOVERLAPPED _
)
MyLength = MyWritten
If (MyStatus = 0) And (GetLastError() = ERROR_IO_PENDING) Then
MyLength = 0
CSRUSB_Get_HCI_ACL_Data_Primitive = ERROR_ACTION_FAIL
Exit Function
Else
If MyStatus = 0 Then
CSRUSB_Close
CSRUSB_Get_HCI_ACL_Data_Primitive = ERROR_PORT_CLOSED
Exit Function
End If
MyStatus = GetOverlappedResult(Handle, MyOVERLAPPED, MyWritten, 0)
If MyStatus = 0 Then
CSRUSB_Get_HCI_ACL_Data_Primitive = ERROR_ACTION_FAIL
Exit Function
End If
End If

If MyLength > 0 Then
If MyLength = MyHCIACLDataPrimitive.Data_Total_Length + 4 Then
CSRUSB_Get_HCI_ACL_Data_Primitive = MyLength
Exit Function
Else
'ACL数据没有接收完整
Dim TACLData As CSRUSB_HCI_EVENT
Dim Tlength As Long
Dim J As Long
Dim MyTimeOut As Long
While MyLength < (MyHCIACLDataPrimitive.Data_Total_Length + 4)
DoEvents
Status = MyStatus = ReadFile( _
Handle, _
TACLData, _
Len(TACLData), _
MyWritten, _
MyOVERLAPPED _
)
Tlength = MyWritten
If (MyStatus = 0) And (GetLastError() = ERROR_IO_PENDING) Then
MyLength = 0
CSRUSB_Get_HCI_ACL_Data_Primitive = ERROR_ACTION_FAIL
Exit Function
Else
If MyStatus = 0 Then
CSRUSB_Close
MyLength = 0
CSRUSB_Get_HCI_ACL_Data_Primitive = ERROR_PORT_CLOSED
Exit Function
End If

MyStatus = GetOverlappedResult(Handle, MyOVERLAPPED, MyWritten, 0)
If MyStatus = 0 Then
MyLength = 0
CSRUSB_Get_HCI_ACL_Data_Primitive = ERROR_ACTION_FAIL
Exit Function
End If
End If

If Tlength > 0 Then
For J = 1 To Tlength
MyHCIACLDataPrimitive.Data(MyLength - 4 + J) = TACLData.EventParameter(J)
Next J
MyLength = MyLength + Tlength
Else
Sleep (50)
MyTimeOut = MyTimeOut + 1
If MyTimeOut > 20 Then
CSRUSB_Get_HCI_ACL_Data_Primitive = ERROR_HCI_ACL_DATA_LOST
Exit Function
End If
End If
Wend
End If
End If
CSRUSB_Get_HCI_ACL_Data_Primitive = MyLength
Else
CSRUSB_Get_HCI_ACL_Data_Primitive = ERROR_PORT_NOT_OPEN
End If

End Function

呵呵，全看懂，不过不会翻译啊，帮你定，顺带学习

资料不全，根本无法翻译
看了前面 2 个函数，已经发现
BTModule
PortType = USB_PORT
这些都没有给出定义部分的代码，下面的就没看了。

多人接受答案了。