やりたいことはRS232Cで頻繁に受信するなかかなら、目的のデータを受信したら0.01秒で早く、（普段はあまりCPUに負荷をかけずに）処理したい。LF（&ha）受信でイベント処理をします。
実践コードモジュール [AB4]RS232C通信プログラム（ソース） kadushi様のコードではタイマーによるイベント受信になってしまうので使えませんでした。
理想的な解説したページを見つけました。
http://www.med.osaka-u.ac.jp/pub/anes/w ... ition.html
AB4に移植してみましたが、クラス処理の箇所で迷宮に入り、訳がわからなくなってしまいました。
色々試したりしたのですが、どうしても出来ませんでした。
本当にずうずうしいお願いなのですが、どなたか教えていただけませんか？
[ここをクリックすると内容が表示されます]
C言語も、クラスもよくわからいので、極力オリジナルに近い様に書きました。コード: 全て選択
#console
'3-1-1.初期設定
'最初にWin32APIのコントロールとデータ入出力に必要なデータ領域を確保します．
Type DCB
DCBlength As Long '構造体のサイズ
BaudRate As Long 'ボーレイト（bps）の設定
fBitFields As Long 'ビット単位のフィールド定義
wReserved As Integer '予約（0をセットする）
XonLim As Integer '受信バッファ中のデータが何バイトになったらXon文字を送るかを指定
XoffLim As Integer '受信バッファの空きが何バイトになったらXoff文字を送るかを指定
ByteSize As Byte '1データのビット数を指定
Parity As Byte 'パリティの方式を指定
StopBits As Byte 'ストップビット数を指定
XonChar As Byte 'Xon文字を指定
XoffChar As Byte 'Xoff文字を指定
ErrorChar As Byte 'パリティエラーの場合に使う文字を指定
EofChar As Byte '非バイナリモードの場合のデータ終了文字の指定
EvtChar As Byte 'イベントを生成する文字を指定
End Type
' COMMTIMEOUTS構造体の定義
Type COMMTIMEOUTS
ReadIntervalTimeout As Long '文字の読み込みの待ち時間
ReadTotalTimeoutMultiplier As Long '読み込みの１文字あたりの時間
ReadTotalTimeoutConstant As Long '読み込みの定数時間
WriteTotalTimeoutMultiplier As Long '書き込みの１文字あたりの時間
WriteTotalTimeoutConstant As Long '書き込みの定数時間
End Type
' COMSTAT構造体の定義
Type COMSTAT
fCoBitFlds As Long 'See Comment in Win32API.Txt
cbInQue As Integer
cbOutQue As Integer
End Type
Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (lpEventAttributes As *SECURITY_ATTRIBUTES, bManualReset As Long, bInitialState As Long, lpName As *Char) As Long
Declare Function GetCommState Lib "kernel32" Alias "GetCommState" (nCid As HANDLE,ByRef lpDCB As DCB) As Long
Declare Function GetCommTimeouts Lib "kernel32" Alias "GetCommTimeouts" (hFile As HANDLE,ByRef lpCommTimeouts As COMMTIMEOUTS) As Long
Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String,ByRef lpDCB As DCB) As Long
Declare Function BuildCommDCBAndTimeouts Lib "kernel32" Alias "BuildCommDCBAndTimeoutsA" (ByVal lpDef As String,ByRef lpDCB As DCB,ByRef lpCommTimeouts As COMMTIMEOUTS) As Long
Declare Function SetCommState Lib "kernel32" (hCommDev As HANDLE,ByRef lpDCB As DCB) As Long
Declare Function SetCommTimeouts Lib "kernel32" (hFile As HANDLE,ByRef lpCommTimeouts As COMMTIMEOUTS) As Long
Declare Function GetOverlappedResult Lib "kernel32" Alias "GetOverlappedResult" (hFile As HANDLE,ByRef lpOverlapped As OVERLAPPED,lpNumberOfBytesTransferred As VoidPtr, ByVal bWait As Long) As Long
Declare Function ResetEvent Lib "kernel32" (hEvent As HANDLE) As Long
Declare Function ClearCommError Lib "kernel32" Alias "ClearCommError" (hFile As HANDLE, lpErrors As Long,ByRef lpStat As COMSTAT) As Long
Declare Function SetCommMask Lib "kernel32" Alias "SetCommMask" (hFile As HANDLE, ByVal dwEvtMask As Long) As Long
Declare Function WaitCommEvent Lib "kernel32" Alias "WaitCommEvent" (hFile As HANDLE, lpEvtMask As Long,ByRef lpOverlapped As OVERLAPPED) As Long
Declare Function PurgeComm Lib "kernel32" Alias "PurgeComm" (hFile As HANDLE, ByVal dwFlags As Long) As Long
' Error Flags
Const CE_RXOVER = &H1 ' Receive Queue overflow
Const CE_OVERRUN = &H2 ' Receive Overrun Error
Const CE_RXPARITY = &H4 ' Receive Parity Error
Const CE_FRAME = &H8 ' Receive Framing error
Const CE_BREAK = &H10 ' Break Detected
Const CE_TXFULL = &H100 ' TX Queue is full
Const CE_PTO = &H200 ' LPTx Timeout
Const CE_IOE = &H400 ' LPTx I/O Error
Const CE_DNS = &H800 ' LPTx Device not selected
Const CE_OOP = &H1000 ' LPTx Out-Of-Paper
Const CE_MODE = &H8000 ' Requested mode unsupported
' Events
Const EV_RXCHAR = &H1 ' Any Character received
Const EV_RXFLAG = &H2 ' Received certain character
Const EV_TXEMPTY = &H4 ' Transmitt Queue Empty
Const EV_CTS = &H8 ' CTS changed state
Const EV_DSR = &H10 ' DSR changed state
Const EV_RLSD = &H20 ' RLSD changed state
Const EV_BREAK = &H40 ' BREAK received
Const EV_ERR = &H80 ' Line status error occurred
Const EV_RING = &H100 ' Ring signal detected
Const EV_PERR = &H200 ' Printer error occured
Const EV_RX80FULL = &H400 ' Receive buffer is 80 percent full
Const EV_EVENT1 = &H800 ' Provider specific event 1
Const EV_EVENT2 = &H1000 ' Provider specific event 2
'WaitForSingleObjectの戻り値
Const WAIT_OBJECT_0 = &h00000000 ' オブジェクトがシグナル状態になったことを示します。
Const WAIT_ABANDONED = &h00000080 ' 放棄されたためにミューテックスオブジェクトがシグナル状態になったことを示します。
Const WAIT_FAILED = &hFFFFFFFF 'エラーが発生したことを示します。拡張エラー情報を取得するには、 GetLastError 関数を使います。
'PurgeCommの引数
Const PURGE_TXABORT = 1
Const PURGE_RXABORT = 2
Const PURGE_TXCLEAR = 4
Const PURGE_RXCLEAR = 8
'*****************************************************************************************************
'*****************************************************************************************************
Const BUFFERSIZE = 1024
Const LineMax = 256
Const TIMEOUT_MUL = 50
'------------------------------------------------------------------------------------------
Dim ser_hdl As HANDLE
Dim dcb As DCB
Dim comstat As COMSTAT
Dim timeout As COMMTIMEOUTS
Dim SerialEvent As DWORD
Dim o_send As OVERLAPPED
Dim o_receive As OVERLAPPED
Dim o_event As OVERLAPPED
Dim ByteRead As DWord
Dim ByteWrite As DWord
Dim DataLength As DWord
Dim ErrorMask As DWord
Dim IOBuf[BUFFERSIZE] As Byte
Dim RingBuf[BUFFERSIZE] As Byte
Dim DataBuf[BUFFERSIZE] As Byte
Dim OutBuf[256] As Byte
Dim WritePoint As Integer
Dim ReadPoint As Integer
Dim DataCount As DWord
Dim ev_chr As Byte
Dim Terminated As Byte
Terminated = 1
''Main()
'3-2-2. Threadの開始方法
'Threadを開始するにはC++のnewメソッドで行います．
SerialThread = new TSerialThread(THREAD_PRIORITY_NORMAL , 3)
'3-2-5. Threadとメインプログラムの間でデータの受け渡しをする方法
'通常Threadではデータの取得のみを請け負い，取得されたデータの処理は別Threadもしくはメインプログラム側で行うことが多いと思います．このような場合２つのThread間で安全にデータの受け渡しができるように工夫する必要があります．このような場合にはEventとCRITICAL_SECTIONを利用します．これらを使用する場合には予めこれらのメモリー領域を確保しておく必要があります．
Dim CritSec_Serial As CRITICAL_SECTION
Dim hGet_event As HANDLE
'と宣言しておいてメインフォームのOnCreate関数の中で
'// Critical Section Initialize
InitializeCriticalSection(CritSec_Serial)
hGet_event = CreateEvent(NULL, FALSE, FALSE, NULL) As VoidPtr
''メイン処理は寝ている
Sleep(9999999)
'なおEventやCRITICAL_SECTIONはメインプログラムの終了時にはその領域を開放しなければなりません．
'これは以下のようにメインフォームのFormDestroy関数に書いておきます．
'//---------------------------------------------------------------------------
'void __fastcall TForm1::FormDestroy(TObject *Sender)
'// Close Event Handle
CloseHandle(hGet_event)
'// Delete Critical Section
'3-2-3. Threadの終了
'Threadを終了させるにはTerminateメソッドを使用します．
if SerialThread Then
SerialThread.Terminate()
EndIf
End
'*****************************************************************************************************
'*****************************************************************************************************
'3-2-1. Threadのヘッダ
'class TSerialThread : public TThread
class TSerialThread
public
'//---------------------------------------------------------------------------
'__fastcall TSerialThread::TSerialThread(TThreadPriority StartPriority) : TThread(true)
Sub TSerialThread(TThreadPriority As Byte , StartPriority As Byte) As void
Priority = StartPriority
FreeOnTerminate = TRUE
Resume()
End Sub
'//---------------------------------------------------------------------------
'__fastcall TSerialThread::~TSerialThread(void)
Sub ~TSerialThread() As void
if ser_hdl <> NULL Then
COMclose()
ser_hdl = NULL
EndIf
End Sub
'//---------------------------------------------------------------------------
private
Dim Message As String
Sub Execute() As Void
While
WaitForSingleObject(hGet_event, INFINITE)
if Terminate Then
Exit While
End If
EnterCriticalSection( CritSec_Serial )
'// Data 取得ルーチンをここに書く
LeaveCriticalSection( CritSec_Serial )
'// 演算ルーチンをここに書く
Wend
End Sub
'3-2-4. Threadから画面にデータを表示される方法
'先に書きましたようにここではUpdateLine関数と UpdateDispLine関数を追加しています．
Sub UpdateLine(s As String)
Message = s
Synchronize(UpdateDispLine)
End Sub
Sub UpdateDispLine() As Void
'' Form1.eEdit.Text = Message
End Sub
End Class
'*****************************************************************************************************
'*****************************************************************************************************
Sub COMsetup() As Void
o_send.Internal = 0
o_send.InternalHigh = 0
o_send.Offset = 0
o_send.OffsetHigh = 0
o_send.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL)
o_receive.Internal = 0
o_receive.InternalHigh = 0
o_receive.Offset = 0
o_receive.OffsetHigh = 0
o_receive.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL)
o_event.Internal = 0
o_event.InternalHigh = 0
o_event.Offset = 0
o_event.OffsetHigh = 0
o_event.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL)
'// Initialize COM port
ser_hdl = CreateFile("COM1", GENERIC_READ Or GENERIC_WRITE,0,ByVal 0,OPEN_EXISTING,FILE_FLAG_OVERLAPPED, 0 )
GetCommState(ser_hdl, dcb)
GetCommTimeouts(ser_hdl, timeout)
BuildCommDCB("baud=9600 parity=N data=8 stop=1",dcb)
'// BuildCommDCBAndTimeouts("baud=9600 parity=N data=8 stop=1",dcb,timeout)
' DCB構造体fBitFieldsにBit指定されているメンバだが一気に設定する。
'dcb.fRtsControl = RTS_CONTROL_DISABLE
'dcb.fOutxDsrFlow = FALSE
'dcb.fAbortOnError = FALSE
dcb.fBitFields = &H0000
dcb.EvtChar = ev_chr
timeout.WriteTotalTimeoutConstant = 0
timeout.WriteTotalTimeoutMultiplier = TIMEOUT_MUL
timeout.ReadIntervalTimeout = &HFFFFFFFF
timeout.ReadTotalTimeoutConstant = 0
timeout.ReadTotalTimeoutMultiplier = TIMEOUT_MUL
SetCommState(ser_hdl,dcb)
SetCommTimeouts(ser_hdl,timeout)
ReadPoint = 0 : WritePoint = 0 : DataCount = 0
End Sub
'*****************************************************************************************************
'*****************************************************************************************************
'
'3-1-2. ASCIIデータの受信
'データの読み込みにはReadFile関数を用います．OVERLAP構造体を用いたbackground読み込みのためにRead_BackGround関数を作成しています．以下にはThreadオブジェクトのExecute関数も示しています．
'
'// Get and Fill RingBuf from System Buffer
Sub Read_BackGround(cnt As DWord) As void
Dim endtime As DWord
if ReadFile(ser_hdl, IOBuf, cnt,VarPtr(ByteRead), o_receive) <> 0 Then
ByteRead = 0
if GetLastError() = ERROR_IO_PENDING Then
endtime = GetTickCount() + 200
while GetOverlappedResult(ser_hdl, o_receive,VarPtr(ByteRead), 0 ) <> 0
if( GetTickCount() > endtime ) Then
Exit While
EndIf
Wend
else
GetLastError()
EndIf
EndIf
ResetEvent(o_receive.hEvent As HANDLE)
End Sub
'// Get and Fill RingBuf from System Buffer
Sub COMread_line() As void
Dim i As Word
ClearCommError(ser_hdl, &ErrorMask, comstat)
if comstat.cbInQue = 0 Then
Exit Sub
End If
if comstat.cbInQue > BUFFERSIZE - DataCount Then
Read_BackGround( BUFFERSIZE - DataCount )
else
Read_BackGround(comstat.cbInQue)
End If
if DataLength = 0 Then
Exit Sub
End If
for i=0 To i<DataLength Step 1
RingBuf( WritePoint = WritePoint + 1 ) = IOBuf(i)
DataCount++
if WritePoint >= BUFFERSIZE Then
WritePoint = 0
EndIf
Next i
End Sub
'// Get 1 line from RingBuf if exist then return TRUE
'// else return FALSE
Function get_COM_line(ByRef buf As Byte)Integer
Dim i As DWord
Dim j As Integer
COMread_line()
j=ReadPoint
For i=0 To i<DataCount Step 1
SetByte(buf,RingBuf[j])
if GetByte(buf) = ev_chr Then
SetByte(buf,0)
Exit For
End If
'// ignore control code ( <0x20 )
if GetByte(buf) >= &h20 Then
buf++
else
SetByte(buf,0)
End If
if ++j = BUFFERSIZE Then
j=0
EndIf
Next i
if i >= DataCount Then
get_COM_line = FALSE : Exit Sub
EndIf
if ++j = BUFFERSIZE Then
j = 0
EndIf
ReadPoint = j
DataCount -= (i+1)
get_COM_line = TRUE : Exit Sub
End Function
'//---------------------------------------------------------------------------
Sub TSerialThread() As void
'void __fastcall TSerialThread::Execute(void)
ev_chr = &h0a
COMsetup()
if ser_hdl = NULL Then
Exit Sub
End If
Do
SetCommMask(ser_hdl, EV_RXFLAG)
WaitCommEvent(ser_hdl, &SerialEvent As Long, o_event)
Do
if WaitForSingleObject(o_event.hEvent As VoidPtr,200) = WAIT_OBJECT_0 Then
ClearCommError(ser_hdl, &ErrorMask As Long, comstat)
ResetEvent(o_event.hEvent As VoidPtr)
'// if Serial communication error occured, then call PurgeComm
if ErrorMask or CE_IOE Then
' PurgeComm(ser_hdl,PURGE_REABORT);
PurgeComm(ser_hdl,PURGE_TXABORT Or PURGE_RXABORT)
EndIf
Exit Do
End If
if Terminated Then
Exit Sub
End If
Loop
Do
if get_COM_line(DataBuf) = FALSE Then
Exit Do
End If
'// Add DataBuf processing routines here !!
Loop
Loop
End Sub
'*****************************************************************************************************
'*****************************************************************************************************
'通信が終了したら回線を閉じます．回線を閉じるにはCloseHandle関数を用います．
'//---------------------------------------------------------------------------
'void __fastcall COMclose(void)
Sub COMclose() As Void
SetCommMask(ser_hdl, 0)
PurgeComm(ser_hdl, PURGE_RXCLEAR)
PurgeComm(ser_hdl, PURGE_TXCLEAR)
PurgeComm(ser_hdl, PURGE_RXABORT)
PurgeComm(ser_hdl, PURGE_TXABORT)
GetCommState(ser_hdl, dcb)
' DCB構造体fBitFieldsにBit指定されているメンバだが一気に設定する。
' dcb.fOutxCtsFlow = FALSE
' dcb.fRtsControl = RTS_CONTROL_DISABLE
' dcb.fAbortOnError = TRUE
' dcb.fOutxDsrFlow = FALSE
dcb.fBitFields = &HE000
SetCommState(ser_hdl, dcb)
CloseHandle(o_receive.hEvent As VoidPtr)
CloseHandle(o_send.hEvent As VoidPtr)
CloseHandle(o_event.hEvent As VoidPtr)
CloseHandle(ser_hdl as VoidPtr)
EndSub
AB５で書けば、簡略化できたと思いますが、頻繁にハングし使えませんでした。