Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long Declare Function GetCommState Lib "kernel32" (ByVal nCid As Long, lpDCB As DCB) As Long 'APIビューアで取得した宣言文のうち構造体は使用しないので"As SECURITY_ATTRIBUTES"を"As Long"に変える Type DCB DCBlength As Long '構造体のサイズ BaudRate As Long 'ボーレイト（bps）の設定 ' fBinary As Long '1:バイナリモードかどうか ' fParity As Long '1:パリティチェックの有無 ' fOutxCtsFlow As Long '1:CTSを監視するかどうか ' fOutxDsrFlow As Long '1:DSRを監視するかどうか ' fDtrControl As Long '2:DTRによるハンドシェーク ' fDsrSensitivity As Long '1:TrueのときDSRがオフのときの受信データを無視する ' fTXContinueOnXoff As Long '1:Xoff文字を送信した後も送信を続けるかどうか ' fOutX As Long '1:TrueのときXoff文字を受信すると送信を停止しXon文字で再開 ' fInX As Long '1:Trueのとき受信バッファの空きに応じてXoff、Xon文字が送信される ' fErrorChar As Long '1:Trueのときパリティエラーの処理をする ' fNull As Long '1:Trueのときヌル文字は破棄される ' fRtsControl As Long '2:RTSによるハンドシェーク ' fAbortOnError As Long '1:Trueのときエラーが発生したら読み書きを終了する ' fDummy2 As Long '1:未使用 DCBflgs As Long '上記のREM文にした部分は実際はビット単位の処理なので、まとめて新規に定義する 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 Declare Function GetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long Type COMMTIMEOUTS ReadIntervalTimeout As Long '文字の読み込みの待ち時間 ReadTotalTimeoutMultiplier As Long '読み込みの１文字あたりの時間 ReadTotalTimeoutConstant As Long '読み込みの定数時間 WriteTotalTimeoutMultiplier As Long '書き込みの１文字あたりの時間 WriteTotalTimeoutConstant As Long '書き込みの定数時間 End Type 'データの受信と送信（ファイルの読み書き） Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Long) As Long 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 Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Declare Function GetTickCount Lib "kernel32" () As Long Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public Const GENERIC_READ = &H80000000 Public Const GENERIC_WRITE = &H40000000 Public Const CREATE_NEW = 1 Public stDCB As DCB Public timeOut As COMMTIMEOUTS Public Running As Boolean Public OrgTime As Long Public hCommHandle As Long Public Sub COM_OPEN(RATE As Long) Const GENERIC_READ = &H80000000 Const GENERIC_WRITE = &H40000000 Const CREATE_NEW = 1 hCommHandle = CreateFile("COM1", GENERIC_READ Or GENERIC_WRITE, 0, 0, CREATE_NEW, 0, 0) If hCommHandle = -1 Then dmy = MsgBox(PortName & "ＣＯＭポート　オープンエラー", vbOKOnly, "Open port") Exit Sub End If dummy = GetCommState(hCommHandle, stDCB) 'DCBを読み込む stDCB.BaudRate = RATE '転送速度の指定 stDCB.ByteSize = 8 'ビット長を8ビットに指定 stDCB.DCBflgs = &H3001 'バイナリモードのフラグを有効にし 'RTSの制御を設定する（それ以外はFalseにする） stDCB.Parity = 0 'パリティなし stDCB.StopBits = 0 'ストップビット数を指定( 0=1ビット,1=1.5ビット,2=2ビット) dummy = SetCommState(hCommHandle, stDCB) '必要ば部分だけ書き換える End Sub Public Sub COM_CLOSE() dmy = CloseHandle(hCommHandle) End Sub Public Sub COM_IO(SEND As String, TIME1 As Integer, TIME2 As Integer, RCV As String, RLEN As Long) timeOut.ReadIntervalTimeout = TIME1 'タイムアウトの設定 timeOut.ReadTotalTimeoutMultiplier = 0 '今回は最大でも10文字程度なので送受信とも timeOut.ReadTotalTimeoutConstant = TIME2 '0.5秒にする timeOut.WriteTotalTimeoutMultiplier = 0 timeOut.WriteTotalTimeoutConstant = 500 dummy = SetCommTimeouts(hCommHandle, timeOut) 'データの送信（文字変数を使った場合） Dim wData As String '文字変数として定義 Dim wLen As Long Dim dLen As Long wData = SEND dLen = LenB(StrConv(wData, vbFromUnicode)) ' dLen = LenB(StrConv(wData, 128)) 'ANSI+DBCS文字でのバイト数に換算 rtn1 = WriteFile(hCommHandle, ByVal wData, dLen, wLen, 0) 'データの送信(Byvalをつける） Dim rData As String rData = Space(100) '100文字分(200バイト)の領域を確保する（spaceはUnicodeで2バイト） rtn2 = ReadFile(hCommHandle, ByVal rData, 100, RLEN, 0) RCV = RTrim(rData) '後ろの空白を削除する RLEN1 = RLEN End Sub Public Sub COM_IOB(bData() As Byte, slen As Integer, TIME1 As Integer, TIME2 As Integer, _ rData() As Byte, RLEN As Long) timeOut.ReadIntervalTimeout = TIME1 'タイムアウトの設定 timeOut.ReadTotalTimeoutMultiplier = 0 '今回は最大でも10文字程度なので送受信とも timeOut.ReadTotalTimeoutConstant = TIME2 '0.5秒にする timeOut.WriteTotalTimeoutMultiplier = 0 timeOut.WriteTotalTimeoutConstant = 500 dummy = SetCommTimeouts(hCommHandle, timeOut) Dim wLen As Long dLen = LenB(StrConv(wData, vbFromUnicode)) rtn1 = WriteFile(hCommHandle, bData(0), slen, wLen, 0) rtn2 = ReadFile(hCommHandle, rData(0), 100, RLEN, 0) End Sub