Libre Calc Macro : シリアル通信で機器を制御する

シリアル通信が使えると、日常作業の自動化の幅がひろがります。
シリアル通信に対応している機器であれば、制御やデータ取得、加工などをLibreと連携することも可能です。
ただ、Libre自体にはシリアル通信する手段は用意されていないので、OSの力を借りる必要があります。
私が説明するまでもなく、色々なサイトで説明されていますが、自身の備忘録として記録しました。

■ Windowsにおけるシリアル通信の方法

テストマクロに入る前に軽くWindowsのシリアル通信方法を軽く解説します。
わかっている方は、読み飛ばしていただいてよいかと思います。

〇 シリアル通信でよく使用するAPI

一般的に使用頻度の高そうなAPIを記載します。

〇 API使用方法

上記APIを使用する際の流れを示します。
ここでは、通信相手にコマンドを送信し、レスポンスを受信するケースを示します。
流れとしては、通信条件設定があること以外は、普通のファイルIOと変わりません。

① CreateFile()でシリアルポートをオープン
② SetCommState()で通信条件の設定を行う
③ SetCommTimeouts()で適正な通信時間を設定する
④ WriteFile()で通信相手にコマンド（データ）を送信
⑤ ReadFile()でレスポンスを受信
⑥ CloseHandle()でシリアルポートをクローズする

■ BasicからのWindows APIのコール方法

先に御説明したWindows APIをBasicから呼び出すには、少しおまじないが必要です。
Libre Basicは、Windows APIについて情報を持っていませんので、インプットする必要があります。
インプットする情報は、APIのありかと呼び出し形式です。
下記は、先に説明したAPIをBasicで参照できるようにありかと呼び出し形式を定義した記述です。
このように定義をすれば、OSの機能も直接呼び出すことが可能となります。

'
' here's the defintion of kernel API to access com port.
'
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
	(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
	ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, _
	ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hObject As Long)
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByRef lpBuffer As String, _
	ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, _
	ByVal lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, _
	ByRef lpBuffer As String, ByVal nNumberOfBytesToWrite As Long, _
	lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function SetCommState Lib "kernel32" (ByVal hFile As Long, ByRef lpDCB As dcb) As Long
Private Declare Function GetCommState Lib "kernel32" (ByVal hFile As Long, ByRef lpDCB As dcb) As Boolean
Private Declare Sub SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS)
Private Declare Sub GetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS)

同様にAPI呼び出しに使用する構造体（データ形式）も以下のように定義して、BasicとAPIの間で設定や結果の取得を可能にします。

'
' Here's the type to set/get com status.
'
Private Type dcb
    DCBlength   As Long
    BaudRate    As Long
    Fields      As Long
    wReserved   As Integer
    XonLim      As Integer
    XoffLim     As Integer
    ByteSize    As Byte
    Parity      As Byte
    StopBits    As Byte
    XonChar     As Byte
    XoffChar    As Byte
    ErrorChar   As Byte
    EofChar     As Byte
    EvtChar     As Byte
    wReserved1  As Integer
End Type

'
' Here't the to set time out.
'
Private Type COMMTIMEOUTS
    ReadIntervalTimeout         As Long
    ReadTotalTimeoutMultiplier  As Long
    ReadTotalTimeoutConstant    As Long
    WriteTotalTimeoutMultiplier As Long
    WriteTotalTimeoutConstant   As Long
End Type

■ テストマクロ

〇 テストシート

設定されたシリアルポートをオープンし、送信データを接続機器に送付します。
その後、機器よりデータを受信し、受信データにセットします。

〇 Basicコード

ざっと、関数を説明します。

'
'   purpose :   entry to open port.
'   returns :   -1      ... fatal error
'           :   not -1  ... handle of port
'
private Function comm_open() As Long
    Dim setting As dcb
    Dim tout As COMMTIMEOUTS
    Dim port As String
    Dim h As Long

    port = "\\.\" & ThisComponent.Sheets.getbyname(cnf_sheet_this).getCellByPosition(cnf_col_port, cnf_row_port).String
    h = CreateFile(port, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, 0, 0)
    If (h = -1) Then
        comm_open = h
        Exit Function
    End If
    
    '
    ' 119200bps, 8bit, non parity, 1stop bit.
    ' no flow.
    '
    Call GetCommState(h, setting)
    setting.BaudRate = 115200
    setting.ByteSize = 8
    setting.Parity = 0
    setting.StopBits = 0
    setting.Fields = &H1    ' Binary mode  and no flow control.
    Call SetCommState(h, setting)
    
    '
    ' this sets time out 1s.
    '
    tout.ReadIntervalTimeout = 1000
    tout.ReadTotalTimeoutMultiplier = 1
    tout.ReadTotalTimeoutConstant = cnf_to * 1000
    tout.WriteTotalTimeoutMultiplier = 1
    tout.WriteTotalTimeoutConstant = 500
    Call SetCommTimeouts(h, tout)
    
    comm_open = h
End Function

'
'   purpose :   entry to close port
'
private Function comm_close(ByVal hFile As Long)
    Call CloseHandle(hFile)
End Function

'
'	purpose	:	entry to send data to port.
'	returns	:	0	...	sent normaly.
'		:	-1	...	fatal error
'
private Function comm_send(ByVal hFile As long, ByRef lpBuffer as string, ByVal nNumberOfBytesToWrite as Long, ByRef lpNumberOfBytesWritten as Long) as integer
	if (WriteFile(hFile, lpBuffer, nNumberOfBytesToWrite, lpNumberOfBytesWritten, 0) <> 0) then
		comm_send = 0
	else
		comm_send = -1
	end if
end function

'
'	purpose	:	entry to receive data from port.
'	returns	:	0	...	read normaly.
'		:	-1	...	fatal error.
'
private Function comm_recv(ByVal hFile As long, ByRef lpBuffer as string, ByVal nNumberOfBytesToRead as Long, ByRef lpNumberOfBytesRead as Long)
	if (ReadFile(hFile, lpBuffer, nNumberOfBytesToRead, lpNumberOfBytesRead, 0) <> 0) then
		comm_recv = 0
	else
		comm_recv = -1
	end if
end function


'
'	purpose	:	entry to do test.
'
sub test()
	Dim h as Long
	Dim l as Long
	Dim string_send as String
	Dim string_recv as String
	
	'
	'	115200bps, none parity 1stop bit, no flow control.
	'
	h = comm_open()
	if (h = -1) then
		MsgBox("Can't Open Comm Port")
		exit sub
	end if

	'
	'	データの送信を行う
	'
	string_send = ThisComponent.Sheets.getbyname(cnf_sheet_this).getCellByPosition(cnf_col_send, cnf_row_send).String + Chr$(13) + Chr$(10)
	if (comm_send(h, string_send, Len(string_send), l) <> 0) then
		MsgBox("send error")
	end if
	
	'
	'	データの受信を行う(CR/LFを取り除いてセット
	'
	string_recv = String(256)	' 256バイトの受信領域確保
	if (comm_recv(h, string_recv, len(string_recv), l) <> 0) then
		MsgBox("Recv error")
	end if
	ThisComponent.Sheets.getbyname(cnf_sheet_this).getCellByPosition(cnf_col_recv, cnf_row_recv).String = Replace(Replace(string_recv, Chr$(10), ""), Chr$(13), "")
	comm_close(h)
	
end sub

■ サンプルプログラム

上記で使用したサンプルプログラムです。
自己責任での御使用をお願いいたします。