シリアル回線のDRSを監視して変化が有ればイベント処理を行うプログラムを作成しています。
WaitCommEventを使うとできそうなのですが、イベントを取得する方法がわかりません。
途中まで書いてみましたが、この先が書けません。
イベント発生時にRS232C_INT()へ飛ばす予定です。
[ここをクリックすると内容が表示されます]
送／受信を行わないのでSetCommState()は行わなくても、GetCommModemStatus()で状態は見れる様です。コード: 全て選択
'-----------------------------------------------------------------------------
' イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数
Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。
' イベントプロシージャの呼び出しを行います。
MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。
' ----------------------------------ここから----------------------------------
'制御線の制御関数の定義
Declare Function EscapeCommFunction Lib "kernel32" (ByVal nCid As HANDLE, ByVal nFunc As Long) As Long
'制御線の監視関数の定義
Declare Function GetCommModemStatus Lib "kernel32" (ByVal hFile As HANDLE, lpModemStat As VoidPtr) As Long
'RS232Cイベントのマスク値設定
Declare Function SetCommMask Lib "kernel32" (ByVal hFile As HANDLE, ByVal dwEvtMask As Long) As Long
'RS232Cイベントの定義
Declare Function WaitCommEvent Lib "kernel32.dll" (ByVal hFile As HANDLE, lpEvtMask As VoidPtr,ByRef lpOverlapped As OVERLAPPED ) As Long
Dim hComm As HANDLE 'ポートのハンドル
' ----------------------------------ここまで----------------------------------
Sub MainWnd_Destroy()
RS232C_DestroyObjects()
PostQuitMessage(0)
End Sub
Sub MainWnd_CommandButton1_Click()
Dim dummy As Long
dim comname[10] As Byte
dim MsgD As BytePtr
comname[0] = 0
lstrcpy(comname,"COM1") '使用するポートの選択
'ポートのオープン
hComm = CreateFile(comname, GENERIC_READ , 0, ByVal 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
If hComm = -1 Then
MsgD = lstrcat(comname , "が使えません") 'ポートのオープン失敗時
MsgBox 0, MsgD '警告メッセージ アイコンを表示
End '強制終了
End If
'RS232C 制御線 DTR = NO
dummy = EscapeCommFunction(hComm, 5)
'RS-232C 割り込みスタート
Dim lpEvtMask As Long
SetCommMask(hComm, &h10) 'DSR変化でイベント発生
WaitCommEvent(hComm,VarPtr(lpEvtMask), OVERLAPPED) 'イベント監視スタート
' dummy = CloseHandle(hComm) 'シルアルポートを閉じる
End Sub
Sub RS232C_INT()
'RS232C 制御線 を確認(&H10=CTS, &H20= DSR, &H40= リング, &H80= RLSD(CD))
Dim cSTATUS As Long
dummy = GetCommModemStatus(hComm, VarPtr(cSTATUS))
cSTATUS = cSTATUS And &h20 'DSR のBit 以外をマスク
MessageBox(hMainWnd,Str$(cSTATUS),"",MB_OK)
End Sub
間違えだらけで＆中途半端＆過去ログのパクリで、お見せできる様なコードでは無いのですがよろしくお願いします。