« 2009年1月 | トップページ | 2010年12月 »

2010年4月

Windowsシリアル制御VB6コードサンプル

Option Explicit
Option Base 0

Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" ( _
    ByVal lpFileName As String, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, _
    ByVal lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long _
    ) As Long

'About CreateFile
'lpFileName String ファイル名 "COM1","COM2"など
'dwDesiredAccess Long オープン方法 読み書き両用にする「&H80000000 OR &H40000000」
'dwShareMode Long 共有モード 共有しない「0」
'ByRef lpSecurityAttributes SECURITY_ATTRIBUTES→ByVal Longに変更する セキュリティ属性 使用しない(宣言文の型を変更して「0」)
'dwCreationDisposition Long 既存ファイルの処理 既存のファイルをオープン「&H3」を指定する
'dwFlagsAndAttributes Long ファイルの属性 なし「0」
'hTemplateFile Long テンプレートファイル 使わない「0」

Public Declare Function GetCommState Lib "kernel32" ( _
    ByVal nCid As Long, _
    ByRef lpDCB As DCB _
    ) As Long

Public Declare Function GetCommTimeouts Lib "kernel32" ( _
    ByVal hFile As Long, _
    ByRef lpCommTimeouts As COMMTIMEOUTS _
    ) As Long

Public Declare Function GetCommProperties Lib "kernel32" ( _
    ByVal hFile As Long, _
    ByRef lpCommProp As COMMPROP _
    ) As Long

Public Declare Function GetCommMask Lib "kernel32" ( _
    ByVal hFile As Long, _
    ByRef lpEvtMask As Long _
    ) As Long

Public Declare Function GetCommConfig Lib "kernel32" ( _
    ByVal hCommDev As Long, _
    ByRef lpCC As COMMCONFIG, _
    ByRef lpdwSize As Long _
    ) As Long

Public Declare Function SetCommState Lib "kernel32" ( _
    ByVal hCommDev As Long, _
    ByRef lpDCB As DCB _
    ) As Long

Public Declare Function SetCommTimeouts Lib "kernel32" ( _
    ByVal hFile As Long, _
    ByRef lpCommTimeouts As COMMTIMEOUTS _
    ) As Long

Public Declare Function SetCommBreak Lib "kernel32" ( _
    ByVal nCid As Long _
    ) As Long

Public Declare Function SetCommConfig Lib "kernel32" ( _
    ByVal hCommDev As Long, _
    ByRef lpCC As COMMCONFIG, _
    ByVal dwSize As Long _
    ) As Long

Public Declare Function SetCommMask Lib "kernel32" ( _
    ByVal hFile As Long, _
    ByVal dwEvtMask As Long _
    ) As Long

Public Declare Function CloseHandle Lib "kernel32" ( _
    ByVal hObject As Long _
    ) As Long

Public Declare Function WaitCommEvent Lib "kernel32" ( _
    ByVal hFile As Long, _
    ByRef lpEvtMask As Long, _
    ByRef lpOverlapped As OVERLAPPED _
    ) As Long

Public Declare Function EscapeCommFunction Lib "kernel32" ( _
    ByVal nCid As Long, _
    ByVal nFunc As Long _
    ) As Long

'About EscapeCommFunction nFunc Values
Public Const SETRTS As Long = 3     'RTSをオンにする
Public Const CLRRTS As Long = 4     'RTSをオフにする
Public Const SETDTR As Long = 5     'DTRをオンにする
Public Const CLRDTR As Long = 6     'DTRをオフにする
Public Const SETXOFF As Long = 1    'XOFFを受信したときの処理
Public Const SETXON As Long = 2     'XONを受信したときの処理
Public Const SETBREAK As Long = 8   '送信をブレーク状態にする
Public Const CLRBREAK As Long = 9   '送信のブレーク状態から復帰

Public Declare Function GetCommModemStatus Lib "kernel32" ( _
    ByVal hFile As Long, _
    ByRef lpModemStat As Long _
    ) As Long

'About mask of lpModemStat
Public Const MS_CRT_ON As Long = &H10&  'CTSがオン
Public Const MS_DSR_ON As Long = &H20&  'DSRがオン
Public Const MS_RING_ON As Long = &H40& 'リングがオン
Public Const MS_RLSD_ON As Long = &H80& 'RLSD(CD)がオン

Public Type DCB
    DCBlength As Long       '構造体のサイズ
    BaudRate As Long        'ボーレート(bps)の設定・・・直接値を代入する。
                            '例:110, 150, 300, 600, 1200, 2400, 4800, 9600, 14400, 19200, 38400
    fBitFields As Long      'See About fBitFields bit position
    wReserved As Integer    'wReserved Integer 予約(0をセットする)
    XonLim As Integer       '受信バッファ中のデータが何バイトになったらXon文字を送るかを指定
    XoffLim As Integer      '受信バッファの空きが何バイトになったらXoff文字を送るかを指定
    ByteSize As Byte        '1データのビット数を指定・・・7または8
    Parity As Byte          'パリティの方式を指定
                            '0・・・NOPARITY   (パリティなし)
                            '1・・・ODDPARITY (奇数パリティ)
                            '2・・・EVENPARITY (偶数パリティ)
                            '3・・・MARKPARITY (常にマーク)
    StopBits As Byte        'ストップビット数を指定
                            '0・・・ONESTOPBIT     (1ビット)
                            '1・・・ONE5STOPBITS  (1.5ビット)
                            '2・・・TOSTOPBITS   (2ビット)
    XonChar As Byte         'Xon文字を指定
    XoffChar As Byte        'Xoff文字を指定
    ErrorChar As Byte       'パリティエラーの場合に使う文字を指定
    EofChar As Byte         '非バイナリモードの場合のデータ終了文字の指定
    EvtChar As Byte         'イベントを生成する文字を指定
    wReserved1 As Integer   '(未使用)
End Type

'About fBitFields bit position
'0 fBinary バイナリモードかどうか
'1 fParity パリティチェックの有無
'2 fOutxCtsFlow CTSを監視するかどうか
'3 fOutxDsrFlow DSRを監視するかどうか
'4,5 fDtrControl DTRによるハンドシェーク(2ビット)
'6 fDsrSensitivity TrueのときDSRがオフのときの受信データを無視する
'7 fTXContinueOnXoff Xoff文字を送信した後も送信を続けるかどうか
'8 fOutX TrueのときXoff文字を受信すると送信を停止し、Xon文字で再開
'9 fInX Trueのとき受信バッファの空きに応じてXoff、Xon文字が送信される
'10 fErrorChar Trueのときパリティエラーの処理をする
'11 fNull Trueのときヌル文字は破棄される
'12,13 fRtsControl RTSによるハンドシェーク(2ビット)
'14 fAbortOnError Trueのときエラーが発生したら読み書きを終了する
'15 fDummy2 未使用

Public Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Public Type COMMTIMEOUTS
    ReadIntervalTimeout As Long         '文字の読み込みの待ち時間
    ReadTotalTimeoutMultiplier As Long  '読み込みの1文字あたりの時間
    ReadTotalTimeoutConstant As Long    '読み込みの定数時間
    WriteTotalTimeoutMultiplier As Long '書き込みの1文字あたりの時間
    WriteTotalTimeoutConstant As Long   '書き込みの定数時間
End Type

Public Type COMMPROP
    wPacketLength As Integer        '構造体のサイズ
    wPacketVersion As Integer       '構造体のバージョン
    dwServiceMask As Long           '実装されているサービス
    dwReserved1 As Long             '予約
    dwMaxTxQueue As Long            '最大送信バッファサイズ
    dwMaxRxQueue As Long            '最大受信バッファサイズ
    dwMaxBaud As Long               '最大ボーレート
    dwProvSubType As Long           'デバイスの種類
    dwProvCapabilities As Long      'サポートされている機能
    dwSettableParams As Long        '変更可能なパラメータ
    dwSettableBaud As Long          '許されるボーレート
    wSettableData As Integer        '許されるバイトサイズ
    wSettableStopParity As Integer  '許されるストップビット/パリティの設定
    dwCurrentTxQueue As Long        '送信バッファサイズ
    dwCurrentRxQueue As Long        '受信バッファサイズ
    dwProvSpec1 As Long             'プロバイダ用
    dwProvSpec2 As Long             'プロバイダ用
    wcProvChar(1) As Integer        'プロバイダ用
End Type

'dwProvSpec2 Long
'wcProvChar(1) Integer

'About dwProvCapabilities
Public Const PCF_DTRDSR As Long = &H1&          'DTR/DSR機能
Public Const PCF_RTSCTS As Long = &H2&          'RTS/CTS機能
Public Const PCF_RLSD As Long = &H4&            'CD機能
Public Const PCF_PARITY_CHECK As Long = &H8&    'パリティチェック
Public Const PCF_XONXOFF As Long = &H10&        'XON/XOFFのフロー制御
Public Const PCF_SETXCHAR As Long = &H20&       'XON/XOFF機能の設定
Public Const PCF_TOTALTIMEOUTS As Long = &H40&  '経過時間のタイムアウト
Public Const PCF_INTTIMEOUTS As Long = &H80&    'インターバルタイムアウト
Public Const PCF_SPECIALCHARS As Long = &H100&  '特殊文字
Public Const PCF_16BITMODE As Long = &H200&     '16ビットのデータモード

Public Type COMMCONFIG
    dwSize As Long
    wVersion As Integer
    wReserved As Integer
    dcbx As DCB
    dwProviderSubType As Long
    dwProviderOffset As Long
    dwProviderSize As Long
    wcProviderData As Byte
End Type

Public Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type

Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

Public Const INVALID_HANDLE_VALUE = -1
Public Const OPEN_EXISTING = 3

'ユーザ定義
Public Const LONGBITSLEN As Integer = 32
Public Type LONGBITS
    blnBits(0 To LONGBITSLEN - 1) As Boolean
    'MSB:bnlBits(31), LSB:blnBits(0)
End Type

Public Const PORT_COM1 As String = "COM1"

Public Function ConvertLongToBits(ByVal value As Long) As LONGBITS
    Dim i As Integer
    Dim bits As LONGBITS
    Dim msb As Long
    Dim wk As Long
    msb = value And &H80000000
    wk = value And &H7FFFFFFF

    If msb <> 0 Then
        bits.blnBits(LONGBITSLEN - 1) = True
    Else
        bits.blnBits(LONGBITSLEN - 1) = False
    End If
   
    For i = 0 To LONGBITSLEN - 2
        If ((wk \ 2 ^ i) And 1) = 1 Then
            bits.blnBits(i) = True
        Else
            bits.blnBits(i) = False
        End If
    Next
    ConvertLongToBits = bits
End Function

Public Function ConvertBitsToLong(ByRef bits As LONGBITS) As Long
    Dim i As Integer
    Dim value As Long
    Dim wk As Long
   
    wk = 0
    For i = 0 To LONGBITSLEN - 2
        If bits.blnBits(i) Then
            wk = wk + 2 ^ i
        End If
    Next
   
    If bits.blnBits(LONGBITSLEN - 1) Then
        value = wk Or &H80000000
    Else
        value = wk
    End If
       
    ConvertBitsToLong = value
End Function

Public Function CheckComm(ByVal strPort As String)
    Const GENERIC_READ = &H80000000
    Const GENERIC_WRITE = &H40000000
    Const OPEN_EXISTING = 3
    Dim lpPortName As String
    Dim hComm As Long
    Dim stDCB As DCB
    Dim lngResult As Long
    Dim timeOut As COMMTIMEOUTS
    Dim nFunc As Long
    Dim lpModemState As Long
   
    'シリアルポートを開く
    lpPortName = PORT_COM1
    hComm = CreateFile(lpPortName, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, 0, 0)
   
    If hComm = -1 Then
        MsgBox lpPortName & "が使えません", vbCritical
        Exit Function
    End If
   
    'シリアル通信の設定
    'stDCB.BaudRate = 9600
    'stDCB.ByteSize = 8
    'stDCB.fBitFields = &H3001
    'stDCB.Parity = 0
    'stDCB.StopBits = 0
    'lngResult = SetCommState(hComm, stDCB)
   
    'タイムアウトの設定
    'timeOut.ReadIntervalTimeout = 500       '文字の読み込み待ち時間(500ms)
    'timeOut.ReadTotalTimeoutMultiplier = 0  '読み込みの1文字あたりの時間
    'timeOut.ReadTotalTimeoutConstant = 500  '読み込みの定数時間(500ms)
    'timeOut.WriteTotalTimeoutMultiplier = 0 '書き込みの1文字あたりの時間
    'timeOut.WriteTotalTimeoutConstant = 500 '書き込みの定数時間(500ms)
    'lngResult = SetCommTimeouts(hComm, timeOut)
   
   
    '信号直接制御
    nFunc = SETRTS      'RTSをオンにする
    'nFunc = CLRRTS      'RTSをオフにする
    'nFunc = SETDTR      'DTRをオンにする
    'nFunc = CLRDTR      'DTRをオフにする
    'nFunc = SETXOFF     'XOFFを受信したときの処理
    'nFunc = SETXON      'XONを受信したときの処理
    'nFunc = SETBREAK    '送信をブレーク状態にする
    'nFunc = CLRBREAK    '送信のブレーク状態から復帰
    lngResult = EscapeCommFunction(hComm, nFunc)
   
    '信号状態取得
    lngResult = GetCommModemStatus(hComm, lpModemState)
   
    If lpModemState And MS_CRT_ON Then
        'CTSがオン
    End If
    If lpModemState And MS_DSR_ON Then
        'DSRがオン
    End If
    If lpModemState And MS_RING_ON Then
        'リングがオン
    End If
    If lpModemState And MS_RLSD_ON Then
        'RLSD(CD)がオン
    End If

    'シルアルポートを閉じる
    lngResult = CloseHandle(hComm)

End Function

|

« 2009年1月 | トップページ | 2010年12月 »