ab.com コミュニティ

　　
#N88BASIC

' DCB構造体の定義
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

Type COMSTAT
 fCoBitFlds As Long 'See Comment in Win32API.Txt
 cbInQue As Integer
 cbOutQue As Integer
End Type 

'シリアルポートの設定関数の定義
Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long,ByRef lpDCB As DCB) As Long

'タイムアウトの設定関数の定義
Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long,ByRef lpCommTimeouts As COMMTIMEOUTS) As Long

'エラー調査の関数の定義
Declare Function ClearCommError Lib "kernel32" (ByVal hCommDevs As Long, ByRef lpErrors As Long, ByRef lpStat As COMSTAT) As Integer 

'************************
'    グローバル変数
'************************
Dim hComm As Long                'COMポートハンドル
Dim stDCB As DCB                '通信ポート情報
Dim timeOut As COMMTIMEOUTS        '通信タイムアウト設定

Dim StrComNom As String
Dim StrComNo As BytePtr
Dim dummy As Integer
Dim dumm2 As Integer
Dim lpErrors As Long
Dim lpStat As COMSTAT
Dim i As Integer

StrComNom="COM7"

'StrComNo=VarPtr(StrComNom)
'Print StrComNo
'Print StrComNom

'COMポートオープン
    hComm = CreateFile("COM7", GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
    If hComm = -1 Then  
   		Print StrComNom; "が使えません"
'        MsgD = lstrcat(comname , "が使えません")            'ポートのオープン失敗時
'        MsgBox 0, MsgD  		'警告メッセージ アイコンを表示
    	dummy = CloseHandle(hComm)                              'シルアルポートを閉じる
		Sleep(7999)
        End                                                 '強制終了
    End If

		'通信規約の設定
        stDCB.BaudRate = 9600
        stDCB.ByteSize = 8                           'ビット長の指定
        stDCB.fBitFields = &H0001                    'バイナリモードのフラグを有効にし
                                                     'RTSの制御を設定する（それ以外はFalseにする）
        stDCB.Parity = 0                             'パリティの設定（パリティなし）
        stDCB.StopBits = 0                           'ストップビット数を指定(1ビット)
        dummy = SetCommState(hComm, stDCB)           '必要な部分だけ書き換える

        'タイムアウトの設定
        timeOut.ReadIntervalTimeout = 000            '文字の読み込み待ち時間（500ms）
        timeOut.ReadTotalTimeoutMultiplier = 30        '読み込みの１文字あたりの時間
        timeOut.ReadTotalTimeoutConstant = 1        '読み込みの定数時間（500ms）
        timeOut.WriteTotalTimeoutMultiplier = 0        '書き込みの１文字あたりの時間
        timeOut.WriteTotalTimeoutConstant = 500        '書き込みの定数時間（500ms）
        dummy = SetCommTimeouts(hComm, timeOut)        'タイムアウトの設定

'読んでみると？
Dim rChr As String
Dim rLen As Long

dummy  = ReadFile(hComm, VarPtr(rChr), 110, VarPtr(rLen), ByVal 0)    
 Print dummy ;rLen
dummy  = ReadFile(hComm, VarPtr(rChr), 110, VarPtr(rLen), ByVal 0)    
 Print dummy ;rLen

'発生しているエラーを消してみる

dummy=ClearCommError(hComm, lpErrors, lpStat)
Print dummy;"Zero is fail"
Print "lperrors";Hex$(lpErrors)
Print "cbinque";lpStat.cbInQue
Print "Bitfiels";Hex$(lpStat.fCoBitFlds)
Print "cboutque";lpStat.cbOutQue
dumm2= lpStat.cbInQue

dummy=ClearCommError(hComm, lpErrors, lpStat)
Print dummy;"Zero is fail"
Print "lperrors";Hex$(lpErrors)
Print "cbinque";lpStat.cbInQue
Print "Bitfiels";Hex$(lpStat.fCoBitFlds)
Print "cboutque";lpStat.cbOutQue
dumm2= lpStat.cbInQue
 

' rChrは受信した文字列が入ります。
'　110 は受信する文字数
' rLenには受信した文字数が入ります。

'エラー解消後。また読んでみると？

dummy  = ReadFile(hComm, VarPtr(rChr), 110, VarPtr(rLen), ByVal 0)    
 Print dummy ;rLen
dummy  = ReadFile(hComm, VarPtr(rChr), 110, VarPtr(rLen), ByVal 0)    
 Print dummy ;rLen

dummy = CloseHandle(hComm)                   'シルアルポートを閉じる
Sleep(799999)
End