PSoCをExcelのマクロ機能(VBA)だけでUSB制御する


_DSC9082.JPG
前回前々回はUSBを内蔵したPSoC「CY8C24794-24FLXI」をヒューマンインターフェースデバイス(HID)としてUSB経由でのデータ送受信を行った。
USBポートにPSoCを接続すると自動的にドライバーがインストールされるという簡単なものだった。しかしデータ送受信プログラムはEXEファイル1つとは言え、Visual C++などで開発する必要があり敷居の高いものだった。そのためPC側のソフトをExcelで作成した。Excelのマクロ機能(VBA)を使い前回作成したPSoCのプログラムとデータ送受信をする。

excel_usb_01.gif
ファイルは「USB機器を制御するためのExcelファイル」のリンクでダウンロードできる。今回はMicrosoft Office 2007で開発したが、Office 2003以前のバージョン用のファイルも同梱してある(ただし動くかどうかは未確認)。

Excelのワークシート上で接続したいUSB機器のベンダーIDとデバイスIDを指定して「接続」ボタンを押す。するとPSoCと接続する。

excel_usb_02.gif
そして送信データを入力して「送信」ボタンを押すとPSoCへデータが送信される。

excel_usb_03.gif
PSoCからデータを受信したい場合は「受信」ボタンをクリックすればいい。

ソースコードは以下のようにした。基本的に前々回に紹介したVisual C++での処理と同じ流れになっている。ただしVBAの使い方がよく分からないためExcelを閉じるときの切断処理がないなど少し処理を省略している。



Private Const OPEN_EXISTING = 3
Private Const INVALID_HANDLE_VALUE = -1

Private Const DIGCF_PRESENT = &H2
Private Const DIGCF_DEVICEINTERFACE = &H10

Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_READ = &H80000000
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const CREATE_ALWAYS = 2
Private Const OPEN_ALWAYS = 4
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2

Private Const WAIT_OBJECT_0 = 0


Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type


Private Type HIDD_ATTRIBUTES
Size As Long
VendorID As Integer
ProductID As Integer
VersionNumber As Integer
End Type

Private Type HIDP_CAPS
Usage As Integer
UsagePage As Integer
InputReportByteLength As Integer
OutputReportByteLength As Integer
FeatureReportByteLength As Integer
Reserved(16) As Integer
NumberLinkCollectionNodes As Integer
NumberInputButtonCaps As Integer
NumberInputvalueCaps As Integer
NumberInputDataIndices As Integer
NumberOutputButtonCaps As Integer
NumberOutputvalueCaps As Integer
NumberOutputDataIndices As Integer
NumberFeatureButtonCaps As Integer
NumberFeaturevalueCaps As Integer
NumberFeatureDataIndices As Integer
End Type


Private Type HidP_value_Caps
UsagePage As Integer
ReportID As Byte
IsAlias As Long
BitField As Integer
LinkCollection As Integer
LinkUsage As Integer
LinkUsagePage As Integer
IsRange As Long
IsStringRange As Long
IsDesignatorRange As Long
IsAbsolute As Long
HasNull As Long
Reserved As Byte
BitSize As Integer
ReportCount As Integer
Reserved2 As Integer
Reserved3 As Integer
Reserved4 As Integer
Reserved5 As Integer
Reserved6 As Integer
LogicalMin As Long
LogicalMax As Long
PhysicalMin As Long
PhysicalMax As Long
UsageMin As Integer
UsageMax As Integer
StringMin As Integer
StringMax As Integer
DesignatorMin As Integer
DesignatorMax As Integer
DataIndexMin As Integer
DataIndexMax As Integer
End Type

Private Type SP_DEVICE_INTERFACE_DATA
cbSize As Long
InterfaceClassGuid As GUID
Flags As Long
Reserved As Long
End Type

Private Type SP_DEVICE_INTERFACE_DETAIL_DATA
cbSize As Long
devicepath1 As Byte
devicepath2 As Byte
End Type

Private Type SP_DEVINFO_DATA
cbSize As Long
ClassGuid As GUID
DevInst As Long
Reserved As Long
End Type


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

Private Declare Function HidD_GetHidGuid Lib "hid.dll" (ByRef HidGuid As GUID) As Long

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByRef lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByRef lpBuffer As Byte, ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, ByRef lpOverlapped As OVERLAPPED) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByRef lpBuffer As Byte, ByVal nNumberOfBytesToWrite As Long, ByRef lpNumberOfBytesWritten As Long, ByRef lpOverlapped As OVERLAPPED) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long


Private Declare Function HidD_GetPreparsedData Lib "hid.dll" (ByVal HidDeviceObject As Long, ByRef PreparsedData As Long) As Long
Private Declare Function HidP_GetCaps Lib "hid.dll" (ByVal PreparsedData As Long, ByRef Capabilities As HIDP_CAPS) As Long
Private Declare Function HidD_FreePreparsedData Lib "hid.dll" (ByRef PreparsedData As Long) As Long

Private Declare Function HidD_GetAttributes Lib "hid.dll" (ByVal HidDeviceObject As Long, ByRef Attributes As HIDD_ATTRIBUTES) As Long


Private Declare Function SetupDiCreateDeviceInfoList Lib "setupapi.dll" (ByRef ClassGuid As GUID, ByVal hwndParent As Long) As Long
Private Declare Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" (ByVal DeviceInfoSet As Long) As Long
Private Declare Function SetupDiEnumDeviceInterfaces Lib "setupapi.dll" (ByVal DeviceInfoSet As Long, ByVal DeviceInfoData As Long, ByRef InterfaceClassGuid As GUID, ByVal MemberIndex As Long, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA) As Long
Private Declare Function SetupDiGetClassDevs Lib "setupapi.dll" Alias "SetupDiGetClassDevsA" (ByRef ClassGuid As GUID, ByVal Enumerator As String, ByVal hwndParent As Long, ByVal Flags As Long) As Long

Private Declare Function SetupDiGetDeviceInterfaceDetail Lib "setupapi.dll" Alias "SetupDiGetDeviceInterfaceDetailW" (ByVal DeviceInfoSet As Long, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA, ByVal DeviceInterfaceDetailData As Long, ByVal DeviceInterfaceDetailDataSize As Long, ByRef RequiredSize As Long, ByVal DeviceInfoData As Long) As Long

Private Declare Function RtlMoveMemory Lib "kernel32" (dest As Any, src As Any, ByVal Count As Long) As Long

Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (lpEventAttributes As Long, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long
Private Declare Function GetOverlappedResult Lib "kernel32.dll" (ByVal hFile As Integer, ByRef lpOverlapped As OVERLAPPED, ByRef lpNumberOfBytesTransferred As Long, ByVal bWait As Boolean) As Integer
Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Dim g_hDevice As Long
Dim g_nInputSize As Long
Dim g_nOutputSize As Long


Private Sub Destroy()

If g_hDevice <> INVALID_HANDLE_VALUE And g_hDevice <> 0 Then
CloseHandle g_hDevice
End If
g_hDevice = INVALID_HANDLE_VALUE
g_nInputSize = 0
g_nOutputSize = 0

End Sub

Sub Connect()

Dim nVendorID As Long
Dim nDeviceID As Long
Dim ret As Long
Dim dwIndex As Long
Dim hDevInfo As Long
Dim sDeviceInterfaceData As SP_DEVICE_INTERFACE_DATA
Dim DetailData As Long
Dim sDeviceInterfaceDetailData As SP_DEVICE_INTERFACE_DETAIL_DATA
Dim Needed As Long
Dim strDevicePath As String
Dim hDevice As Long
Dim sHidpCaps As HIDP_CAPS
Dim NumMax As Integer
Dim guidHid As GUID
Dim PreparsedData As Long
Dim dwCount As Long
Dim strBuff As String

Destroy

strBuff = Cells(11, 2)
nVendorID = Hex2Long(strBuff)
strBuff = Cells(11, 3)
nDeviceID = Hex2Long(strBuff)

ret = HidD_GetHidGuid(guidHid)

hDevInfo = SetupDiGetClassDevs(guidHid, vbNullString, 0, (DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE))

dwIndex = 0
sDeviceInterfaceData.cbSize = LenB(sDeviceInterfaceData)
Do While (SetupDiEnumDeviceInterfaces(hDevInfo, 0, guidHid, dwIndex, sDeviceInterfaceData))
dwIndex = dwIndex + 1
ret = SetupDiGetDeviceInterfaceDetail(hDevInfo, sDeviceInterfaceData, 0, 0, Needed, 0)

Dim DetailDataBuffer() As Byte

DetailData = Needed
sDeviceInterfaceDetailData.cbSize = Len(sDeviceInterfaceDetailData)

ReDim DetailDataBuffer(Needed)

RtlMoveMemory DetailDataBuffer(0), sDeviceInterfaceDetailData, 4
ret = SetupDiGetDeviceInterfaceDetail(hDevInfo, sDeviceInterfaceData, VarPtr(DetailDataBuffer(0)), DetailData, Needed, 0)

If ret Then

Dim pBuff() As Byte
ReDim pBuff(Needed - 6)

For i = 0 To Needed - 6
pBuff(i) = DetailDataBuffer(i + 4)
Next
strDevicePath = pBuff

hDevice = CreateFile(strDevicePath, GENERIC_READ Or GENERIC_WRITE, (FILE_SHARE_READ Or FILE_SHARE_WRITE), 0, OPEN_EXISTING, 0, 0)

If hDevice <> INVALID_HANDLE_VALUE Then

Dim sHiddAttributes As HIDD_ATTRIBUTES

ret = HidD_GetAttributes(hDevice, sHiddAttributes)
If ret And sHiddAttributes.VendorID = nVendorID And sHiddAttributes.ProductID = nDeviceID Then

ret = HidD_GetPreparsedData(hDevice, PreparsedData)
If ret Then
ret = HidP_GetCaps(PreparsedData, sHidpCaps)
If ret Then
g_nInputSize = sHidpCaps.InputReportByteLength
g_nOutputSize = sHidpCaps.OutputReportByteLength

For i = 0 To g_nOutputSize - 1
Cells(5, 5 + i) = "00"
Next
For i = g_nOutputSize To g_nOutputSize + 5
Cells(5, 5 + i) = ""
Next

For i = 0 To g_nInputSize + 5
Cells(7, 5 + i) = ""
Next
End If
HidD_FreePreparsedData PreparsedData

If ret Then
g_hDevice = hDevice
Cells(15, 2) = "接続に成功しました。" & vbCrLf & "PC->デバイスへのデータサイズは" & g_nOutputSize & "バイト" & vbCrLf & "デバイス->PCへのデータサイズは" & g_nInputSize & "バイトです。"
SetupDiDestroyDeviceInfoList hDevInfo
Exit Sub
End If
End If
End If
CloseHandle hDevice
g_hDevice = INVALID_HANDLE_VALUE
End If
End If
Loop
SetupDiDestroyDeviceInfoList hDevInfo
Cells(15, 2) = "接続に失敗しました。"

End Sub

Sub Send()

Dim sOverlapped As OVERLAPPED

If g_hDevice = INVALID_HANDLE_VALUE Or g_hDevice = 0 Then
Exit Sub
End If


sOverlapped.hEvent = CreateEvent(0, False, True, "")

Dim dwWait As Long
Dim dwWritten As Long
Dim pBuff() As Byte
Dim strSendedData As String

ReDim pBuff(g_nOutputSize)


For i = 0 To g_nOutputSize
pBuff(i) = Hex2Long(Cells(5, 5 + i))
strSendedData = strSendedData & " " & Byte2Hex(pBuff(i))
Next

pBuff(0) = 0

ret = WriteFile(g_hDevice, pBuff(0), g_nOutputSize, dwWritten, sOverlapped)

ret = False

dwWait = WaitForSingleObject(sOverlapped.hEvent, 1000)
If dwWait = WAIT_OBJECT_0 Then
ret = GetOverlappedResult(g_hDevice, sOverlapped, dwWritten, True)
If ret Then
Cells(15, 2) = "送信に成功しました。" & vbCrLf & "1バイト目は「00」固定です。" & vbCrLf & strSendedData
End If
End If

End Sub


Sub Recv()

Dim sOverlapped As OVERLAPPED

If g_hDevice = INVALID_HANDLE_VALUE Or g_hDevice = 0 Then
Exit Sub
End If

sOverlapped.hEvent = CreateEvent(0, False, True, "")

Dim dwWait As Long
Dim dwRead As Long
Dim pBuff() As Byte

ReDim pBuff(g_nInputSize)


pBuff(0) = 0
ret = ReadFile(g_hDevice, pBuff(0), g_nInputSize, dwRead, sOverlapped)

ret = False
dwWait = WaitForSingleObject(sOverlapped.hEvent, 1000)
If dwWait = WAIT_OBJECT_0 Then
ret = GetOverlappedResult(g_hDevice, sOverlapped, dwWritten, True)
If ret Then

For i = 0 To g_nInputSize - 1
Cells(7, 5 + i) = Byte2Hex(pBuff(i))
Next
Cells(15, 2) = "受信に成功しました。" & vbCrLf & "1バイト目は「00」固定です。"
End If
End If

End Sub


Private Function Hex2Long(strHex As String) As Long
Hex2Long = Val(IIf(Left(strHex, 1) = "&", "", "&H") & strHex)
End Function

Private Function Byte2Hex(cbData As Byte) As String
If cbData < &H10 Then
Byte2Hex = "0" & Hex(cbData)
Else
Byte2Hex = Hex(cbData)
End If
End Function

Sub Test()

Connect

Send
Recv

Destroy

End Sub


カテゴリー「電子工作」 のエントリー