ab.com コミュニティ

ざっとプログラムを見た感じ、

単純にシリアル(COM)通信の非同期処理をサブスレッドを使って処理するだけのようですから
わざわざTThreadクラスからTSerialThreadを派生して何たらというものは必要ないはずです。


とりあえずはRS232C通信の非同期処理をプログラムを作成し
そいつをCreateThread関数で作成したスレッド内に置けばよいかと思います。

と、いうことで、その辺の解説しているサイトを探したんですが、あんまりないですね。
初心者１３号さんが見つけたサイトが一番まともだと思います。

Threadオブジェクトですね。VCLを除いて見てみましたが解読は挫折しました。
しかしCreateThreadとセフォマでなんとかなりそうな感じです。

TSerialThreadクラスというものを使っていますが，これはBorland C++ Builder固有のものなので，ABでは使えないというわけです。やるとしたら，スレッドを作るという点でCreateThread関数が相当するものになりますが，TSerialThreadがどのような機能を持っているのかによって代替が難しいこともあると思います。

#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

RS232C通信のプログラムを書いています。
やりたいことはRS232Cで頻繁に受信するなかかなら、目的のデータを受信したら0.01秒で早く、（普段はあまりCPUに負荷をかけずに）処理したい。LF（&ha）受信でイベント処理をします。

実践コードモジュール　[AB4]RS232C通信プログラム（ソース）　kadushi様のコードではタイマーによるイベント受信になってしまうので使えませんでした。

理想的な解説したページを見つけました。
http://www.med.osaka-u.ac.jp/pub/anes/www/software/DataAcquisition.html

AB4に移植してみましたが、クラス処理の箇所で迷宮に入り、訳がわからなくなってしまいました。
色々試したりしたのですが、どうしても出来ませんでした。

本当にずうずうしいお願いなのですが、どなたか教えていただけませんか？

[hide][code]
#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
[/code][/hide]
C言語も、クラスもよくわからいので、極力オリジナルに近い様に書きました。
AB５で書けば、簡略化できたと思いますが、頻繁にハングし使えませんでした。