VB6.0用掲示板の過去のログ(No.2)−VBレスキュー(花ちゃん)
[記事リスト]
[新規投稿]
[新着記事]
[ワード検索]
[管理用]
| 投稿日 | ： 2005/07/25(Mon) 12:31 |
| 投稿者 | ： チロル |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： MSCommのOn_Comm受信 |
こんにちは。
二度ほど質問させて頂いた続きなのですが,よろしくお願い致します。
NAK：6バイト固定で送信されるコマンド
セレクティング：TEXTへ入力されたバイナリー形式の文字列を送信する可変バイトのコマンド
の二つがあります。
コマンドはボタンを押し手動で送信をかける作りになっています。
環境的にはRS232Cには検査器が接続されており、送信されたバイナリーデータを目で確認することが
できます。
NAKに関して
コマンドは問題なく送信され、受信も問題ありません。
*ctlComm. はMSComm1.の事です。
以下送信プログラム
Private Sub cmdOutPutNak_Click()
' Nak送信
Dim Buffer(5) As Byte
Buffer(0) = COMM_CODE.DLE
Buffer(1) = COMM_CODE.NAK
Buffer(2) = COMM_CODE.DLE
Buffer(3) = COMM_CODE.UA
Buffer(4) = COMM_CODE.DLE
Buffer(5) = COMM_CODE.HA
ctlComm.Output = Buffer
End Sub
セレクティングに関して
コマンドは問題なく送信されています。
以下送信プログラム
Private Sub cmdOutPutSel_Click()
'セレクティング送信
Dim Buffer(0 To 2100) As Byte
Dim strData As String
Dim txtLen As Integer
Dim i As Integer
Dim j As Integer
Dim strTxtData As String
Dim bytBuf As Byte
Dim tempBuffer() As Byte
Dim bufLen As Integer
' 文字列から空白削除
strData = Replace(txtOutPutSel.Text, " ", "")
txtLen = Len(strData) / 2
' DLNGH・DLNGL設定
COMM_CODE.DLNGH = "&H" + Left(Format(txtLen, "0000"), 2)
COMM_CODE.DLNGL = "&H" + Right(Format(txtLen, "0000"), 2)
If COMM_CODE.DLNGL = 0 Then
MsgBox "送信データがありません"
Exit Sub
End If
' 送信バッファへ代入
Buffer(0) = COMM_CODE.DLE
Buffer(1) = COMM_CODE.SEL
Buffer(2) = COMM_CODE.DLE
Buffer(3) = COMM_CODE.HA
Buffer(4) = COMM_CODE.DLE
Buffer(5) = COMM_CODE.UA
Buffer(6) = COMM_CODE.DLE
Buffer(7) = COMM_CODE.STX
Buffer(8) = COMM_CODE.DLE
Buffer(9) = COMM_CODE.DLNGH
Buffer(10) = COMM_CODE.DLE
Buffer(11) = COMM_CODE.DLNGL
j = 0
For i = 0 To txtLen - 1 Step 1
strTxtData = Mid(strData, 1 + 2 * i, 2)
bytBuf = CByte("&H" & strTxtData)
Buffer(i + j + 12) = bytBuf
If bytBuf = &H10 Then
j = j + 1
Buffer(i + j + 12) = bytBuf
End If
Next i
Buffer(i + j + 12) = COMM_CODE.DLE
Buffer(i + j + 13) = COMM_CODE.ETX
COMM_CODE.BCC = "&H" & (txtLen + j + 6)
If COMM_CODE.BCC = COMM_CODE.DLE Then
Buffer(i + j + 14) = COMM_CODE.DLE
Buffer(i + j + 15) = COMM_CODE.BCC
bufLen = txtLen + 17
Else
Buffer(i + j + 14) = COMM_CODE.BCC
bufLen = txtLen + 16
End If
ReDim tempBuffer(0 To bufLen - 1)
For i = 0 To bufLen - 1
tempBuffer(i) = Buffer(i)
Next i
ctlComm.Output = tempBuffer
しかし、受信に問題があります。
Buffer(8)の照合の場所でエラーが出てしまいます。
実行時エラー’9’
インデックスが有効範囲にありません。
とエラーが出てしまいます。
おかしいと思う点は、突然、出はじめました。
一度目送信をかけると上手くいき、二度目送信をかけるとエラーとなり
さらに、それ以降はエラーが出続けます。この間プログラムの変更はしていません。
プログラムの変更なしに、上手くいく場合とエラーが出てしまう場合とがあります。
Dim Buffer() As Byte
Buffer = ctlComm.Input
この辺りが怪しいと思い Dim Buffer(0 To 2100) As Byte や Buffer() = ctlComm.Inputにしてみ
たり
色々やってみましたが、どれもエラーになり、手詰まりになってしまいました。
いくつか調べてもみましたが、どうしても解決できないので、またよろしくお願いします。
非常に長く見づらくなってしまっているがお許しください。
以下受信プログラム
Private Sub ctlComm_OnComm()
' 受信データ マトリックス
Dim Buffer() As Byte
Dim strData As String
Dim bufLen As Integer
Dim i As Integer
Dim j As Integer
Dim bufTxt(0 To 2100) As Byte
Dim lenBufTxt As Integer
Dim check As Integer
Dim lenH As Byte
Dim lenL As Byte
Dim Bcc As Byte
' 受信データを受信バッファへ格納
Buffer = ctlComm.Input
' データの有無確認
If ctlComm.CommEvent = comEvReceive Then
bufLen = UBound(Buffer)
Else
MsgBox "データがありません"
Exit Sub
End If
' 受信データを照合
If Buffer(0) <> COMM_CODE.DLE Then
MsgBox "DLEが一致しません。"
Exit Sub
End If
' バイナリーデータ表示
txtInPutSel.Text = ""
For i = 0 To bufLen
txtInPutSel.Text = txtInPutSel.Text + Format(Hex(Buffer(i)), "00") &
" "
Next i
Select Case Buffer(1)
' セレクティングと照合
Case COMM_CODE.SEL
' セレクティング受信処理
If Buffer(2) <> COMM_CODE.DLE Then
MsgBox "Err"
Exit Sub
End If
If Buffer(3) <> COMM_CODE.HA Then
MsgBox "Err"
Exit Sub
End If
If Buffer(4) <> COMM_CODE.DLE Then
MsgBox "Err"
Exit Sub
End If
If Buffer(5) <> COMM_CODE.UA Then
MsgBox "Err"
Exit Sub
End If
If Buffer(6) <> COMM_CODE.DLE Then
MsgBox "Err"
Exit Sub
End If
If Buffer(7) <> COMM_CODE.STX Then
MsgBox "Err"
Exit Sub
End If
If Buffer(8) <> COMM_CODE.DLE Then ←ここでエラーがでます。
MsgBox "Err"
Exit Sub
End If
lenH = Buffer(9)
If Buffer(10) <> COMM_CODE.DLE Then
MsgBox "Err"
Exit Sub
End If
lenL = Buffer(11)
j = 0
i = 0
Do
bufTxt(i) = Buffer(i + j + 12)
If Buffer(i + j + 12) = COMM_CODE.DLE And Buffer(i + j + 13) = COMM_CODE.DLE
Then
bufTxt(i) = Buffer(i + j + 13)
j = j + 1
End If
If Buffer(i + j + 12) = COMM_CODE.DLE And Buffer(i + j + 13) = COMM_CODE.ETX
Then
bufTxt(i) = Buffer(i + j + 12)
bufTxt(i + 1) = Buffer(i + j + 13)
If Buffer(i + j + 14) = COMM_CODE.DLE Then
bufTxt(i + 2) = Buffer(i + j + 14)
bufTxt(i + 3) = Buffer(i + j + 15)
' BCC取得
BCC = Buffer(i + j + 15)
check = 0
Else
bufTxt(i + 2) = Buffer(i + j + 14)
BCC = Buffer(i + j + 14)
check = 1
End If
Exit Do
End If
i = i + 1
Loop
Select Case check
Case 0
lenBufTxt = bufLen - 16
COMM_CODE.DLNGH = Hex(Left(Format(lenBufTxt, "0000"), 2))
COMM_CODE.DLNGL = Hex(Right(Format(lenBufTxt, "0000"), 2))
COMM_CODE.BCC = Hex(lenBufTxt + 6)
Case 1
lenBufTxt = bufLen - 15
COMM_CODE.DLNGH = Hex(Left(Format(lenBufTxt, "0000"), 2))
COMM_CODE.DLNGL = Hex(Right(Format(lenBufTxt, "0000"), 2))
COMM_CODE.BCC = Hex(lenBufTxt + 6)
Case Else
MsgBox "Err"
Exit Sub
End Select
If COMM_CODE.DLNGH <> lenH Then
MsgBox "lenH が一致しない"
Exit Sub
End If
If COMM_CODE.DLNGL <> lenL Then
MsgBox "lenL が一致しない"
Exit Sub
End If
If COMM_CODE.BCC <> BCC Then
MsgBox "BCC が一致しない"
Exit Sub
End If
' セレクティングデータ表示
txtInPutData.Text = ""
For i = 0 To bufLen
txtInPutData.Text = txtInPutData.Text + Format(Hex(bufTxt(i)), "00")
& " "
Next i
labInPutData.Caption = "セレクティング受信"
' NAKと照合
Case COMM_CODE.NAK
If Buffer(2) <> COMM_CODE.DLE Then
MsgBox "Err"
Exit Sub
End If
If Buffer(3) <> COMM_CODE.HA Then
MsgBox "Err"
Exit Sub
End If
If Buffer(4) <> COMM_CODE.DLE Then
MsgBox "Err"
Exit Sub
End If
If Buffer(5) <> COMM_CODE.UA Then
MsgBox "Err"
Exit Sub
Else
' 受信データ表示
txtInPutData.Text = ""
For i = 0 To bufLen
txtInPutData.Text = txtInPutData.Text + Format(Hex(Buffer(i)), "00&quo
t;) & " "
Next i
labInPutData.Caption = "NAK受信"
' RSP送信
End If
- 関連一覧ツリー
（★ をクリックするとツリー全体を一括表示します）
- 返信フォーム
（この記事に返信する場合は下記フォームから投稿して下さい）