Public Const GENERIC_READ           As Long = &H80000000    ' 読み取り
Public Const GENERIC_WRITE          As Long = &H40000000    ' 書き込み
Public Const OPEN_EXISTING          As Long = 3             ' 既存ファイルを開く
Public Const INVALID_HANDLE_VALUE   As Long = -1            ' 失敗

' タイムアウト構造体
Public Type COMMTIMEOUTS
    ReadIntervalTimeout         As Long ' 連続受信時の間隔
    ReadTotalTimeoutMultiplier  As Long ' １文字受信の時間
    ReadTotalTimeoutConstant    As Long ' 受信時間の定数
    WriteTotalTimeoutMultiplier As Long ' １文字送信の時間
    WriteTotalTimeoutConstant   As Long ' 送信時間の定数
End Type


' 通信リソース開く
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

' ポートから入力
Public Declare Function ReadFile Lib "kernel32" ( _
    ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToRead As Long, _
    lpNumberOfBytesRead As Long, _
    ByVal lpOverlapped As Long _
) As Long

' ポートへ出力
Public Declare Function WriteFile Lib "kernel32" ( _
    ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToWrite As Long, _
    lpNumberOfBytesWritten As Long, _
    ByVal lpOverlapped As Long _
) As Long

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

' 通信リソース閉じる
Public Declare Function CloseHandle Lib "kernel32" ( _
    ByVal hObject As Long _
) As Long

' COMポート開く
Public Function CommOpen(ByVal strPort As String) As Long
CommOpen = CreateFile( _
                strPort, _
                GENERIC_READ Or GENERIC_WRITE, _
                0, 0, _
                OPEN_EXISTING, _
                0, 0 _
            )
End Function

' COMポートから受信
Public Function CommInput(ByVal hCom As Long, strBuffer As String, ByVal lngLen As Long) As Long
Dim lngRead As Long
Call ReadFile(hCom, ByVal strBuffer, lngLen, lngRead, 0)
CommInput = lngRead
End Function

' COMポートへ送信
Public Function CommOutput(ByVal hCom As Long, ByVal strBuffer As String, ByVal lngLen As Long) As Long
Dim lngWrite As Long
Call WriteFile(hCom, ByVal strBuffer, lngLen, lngWrite, 0)
CommOutput = lngWrite
End Function

' COMポート閉じる
Public Function CommClose(ByVal hCom As Long) As Boolean
CommClose = CloseHandle(hCom)
End Function

' タイムアウトの設定
Public Function SetCommTimeout(ByVal hCom As Long, typTimeout As COMMTIMEOUTS) As Boolean
SetCommTimeout = SetCommTimeouts(hCom, typTimeout)
End Function

Private hCom As Long


Private Sub Command1_Click()
Dim buf As String

' 送信する文字列を取得
' 終端にキャリッジリターンを付ける
buf = Text2.Text & vbCr

' 送信する
If CommOutput(hCom, buf, Len(buf)) = 0 Then
    Call MsgBox("送信に失敗しました", vbOKOnly Or vbCritical)
End If

End Sub

Private Sub Command2_Click()
Dim buf As String * 256 ' あらかじめ領域を確保しなければならない

' 200バイト受信する
If CommInput(hCom, buf, 200) = 0 Then
    Call MsgBox("受信に失敗しました", vbOKOnly Or vbCritical)
End If

' ターミナルへ表示
Text1.Text = Text1.Text & buf
End Sub

Private Sub Form_Load()
Dim cto As COMMTIMEOUTS


' COMポートを開く
hCom = CommOpen("COM3")
If hCom = INVALID_HANDLE_VALUE Then
    Call MsgBox("COMポートが開けません", vbOKOnly Or vbCritical)
    Unload Me
    Exit Sub
End If

' タイムアウトを設定
cto.ReadTotalTimeoutConstant = 1000
Call SetCommTimeout(hCom, cto)

End Sub

Private Sub Form_Unload(Cancel As Integer)
' COMポートを閉じる
Call CommClose(hCom)
End Sub