ab.com コミュニティ

コード: 全て選択

'-----------------------------------------------------------------------------
'  イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [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                                                                                        'ポートのハンドル
Dim lpOverlapped As OVERLAPPED

'イベント処理Windowの作成
Dim comcl As WNDCLASSEX
    comcl.cbSize=Len(comcl)
    comcl.hInstance=GetModuleHandle(0)
    comcl.lpszClassName="DUMMY"
    comcl.lpfnWndProc=AddressOf(RS232C_INT)
RegisterClassEx(comcl)

CreateWindowEx(0,"DUMMY","dummy",0,0,0,0,0,0,0,GetModuleHandle(0),0)

Function RS232C_INT() As DWord
	'RS-232C 割り込みスタート
	'( EV_BREAK = &H40, EV_CTS = &H8 EV_DSR = &H10, EV_ERR = &H80 ,EV_EVENT1 = &H800 ,EV_EVENT2 = &H1000
	'  EV_PERR = &H200, EV_RING = &H100,EV_RLSD = &H20 ,EV_RX80FULL = &H400 ,EV_RXCHAR = &H1
	'  EV_RXFLAG = &H2, EV_TXEMPTY = &H4)
	Dim lpEvtMask As Long
	Dim dummy As Long
	SetCommMask(hComm, &h10) 'DSR変化でイベント発生
	dummy = WaitCommEvent(hComm,VarPtr(lpEvtMask),lpOverlapped)     'イベント監視
	If lpEvtMask = &h10 Then
	'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)
			RS232C_INT()
	EndIf
End Function

' ----------------------------------ここまで----------------------------------

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)
 '   dummy = CloseHandle(hComm)                              'シルアルポートを閉じる

End Sub

コード: 全て選択

'-----------------------------------------------------------------------------
'  イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [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