各位达人帮个忙，UP有分,急ING

Question

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
   Dim Data As String
   Dim strData As String
   Dim buffer() As Byte
   Dim i As Integer
   Dim BufBound As Integer
  Winsock1.GetData strData
  Data = Data & strData
  buffer() = StrToHex(Data)
End Sub
Public Function StrToHex(ByVal S As String) As String
On Error Resume Next
Dim ByteArr() As Byte
ByteArr = StrConv(S, vbFromUnicode)
Dim Temps As String
Dim Temp As Byte
Dim i As Long
Dim outs As String
For i = 0 To UBound(ByteArr)
Temp = ByteArr(i)
Temps = Hex(Temp)
Temps = Right("00" & Temps, 2)
outs = outs & Temps
Next
StrToHex = outs
End Function
'''''''''''上面是利用Winsock控件来接收硬件发来的数据，接收16进制数据，数据能接收了，接收的数据如下：
2A 04 14 FE FE FE FE FE FE FE FE FE FE FE FE 00 FE FE FE FE FE 00 FE 2A 
2A 02 0C 04 2B 30 32 38 2E 35 30 6F 43 40 30 35 37 2E 34 38 25 
2A 02 12 04 2B 30 32 38 2E 34 37 6F 43 40 30 35 37 2E 33 32 25 
现在有个问题：怎么把上面的不同长度的数据帧分别在不同的文本框中显示
麻烦各位帮忙改下，非常感谢各位..
  Dim Data As String
   Dim strData As String
   Dim buffer() As Byte
   Dim i As Integer
   Dim BufBound As Integer
Do
  Do
 DoEvents
  Winsock1.GetData strData
  Data = Data & strData
  buffer() = StrToHex(Data)
  buffer() = Data
  MsgBox buffer() 'buffer(UBound(buffer()))
  Loop Until UBound(buffer()) <> -1 And buffer(UBound(buffer())) = &H2A''我先检测数据头2A
  BufBound = UBound(buffer())
  While BufBound >= 18
    If BufBound > 19 Then '判断长度
         If buffer(BufBound - 19) = &H2 Then 
'取2A 02 0C 04 2B 30 32 38 2E 35 30 6F 43 40 30 35 37 2E 34 38 25数据帧 
           Text4.Text = Text4.Text & CStr(buffer)
           BufBound = BufBound - 21
         End If
    End If
     If BufBound > 23 Then
        If buffer(BufBound - 22) = &H4 Then
'取2A 04 14 FE FE FE FE FE FE FE FE FE FE FE FE 00 FE FE FE FE FE 00 FE 2A 数据帧
            Text5.Text = Text5.Text & CStr(buffer)
            BufBound = BufBound - 33
        End If
     End If
  Data = ""
 Wend
Loop
End Sub

Answer 1

各位帮忙看下，在线等
非常感谢
Loop Until UBound(buffer()) <> -1 And buffer(UBound(buffer())) = &H2A''我先检测数据头2A
是不是这里问题？
提示下标越界

Answer 2

有可能buffer里面根本没有东西

Answer 3

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
   Dim Data As String
   Dim strData As String
   Dim buffer() As Byte
   Dim i As Integer
   Dim BufBound As Integer
  Winsock1.GetData strData
  Data = Data & strData
  buffer() = StrToHex(Data)
  Text4.Text= Text4.Text & CStr(buffer)
End Sub
''''''''''''buffer() 有数据的
Text4.Text能接收到数据：
2A 04 14 FE FE FE FE FE FE FE FE FE FE FE FE 00 FE FE FE FE FE 00 FE 2A 
2A 02 0C 04 2B 30 32 38 2E 35 30 6F 43 40 30 35 37 2E 34 38 25 
2A 02 12 04 2B 30 32 38 2E 34 37 6F 43 40 30 35 37 2E 33 32 25 

Answer 4

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
   Dim Data As String
   Dim strData As String
   Dim buffer() As Byte
   Dim BufBound As Integer
Do
  Do
 DoEvents
  Winsock1.GetData strData
  Data = Data & strData
  buffer() = StrToHex(Data)
  Loop Until UBound(buffer()) <> -1 And buffer(UBound(buffer())) = &H2A
  BufBound = UBound(buffer())
  While BufBound >= 18
    If BufBound > 19 Then
         If buffer(BufBound - 19) = &H2 Then
           Text4.Text = Text4.Text & CStr(buffer)
           BufBound = BufBound - 21
         End If
    End If
     If BufBound > 28 Then
        If buffer(BufBound - 31) = &H4 Then
            Text5.Text = Text5.Text & CStr(buffer)
            BufBound = BufBound - 33
        End If
     End If
  Data = ""
 Wend
Loop
End Sub
给位帮忙看看

Answer 5

请问下就是在buffer()数组中查找2A数据如何找呢
大家给点提示吧
谢谢

Answer 6

各位UP下也行哇
没人用VB了吗？

Answer 7

请问下就是在buffer()数组中查找2A数据如何找呢
//如果只是这个,那很简单啊用个循环......for i=0 to ubound(buffer)
   if buffer(i)=&H2A then
       '咋么咋么的代码........
   end if 
next i

Answer 8

各位帮忙看下，在线等
非常感谢
Loop Until UBound(buffer()) <> -1 And buffer(UBound(buffer())) = &H2A''我先检测数据头2A
是不是这里问题？
提示下标越界
//////////////// 如果BUFFER是EMPTY，一执行代码就会越界的
要查找A2，没有好办法自能循环

Answer 9

你没有数据怎么办呢？你可以if ubound(buffer())...

Answer 10

2A 04 14 FE FE FE FE FE FE FE FE FE FE FE FE 00 FE FE FE FE FE 00 FE 2A 拓扑帧
2A 02 0C 04 2B 30 32 38 2E 35 30 6F 43 40 30 35 37 2E 34 38 25 数据帧
怎么把这2种数据在2个文本框显示啊
首先都要判断帧头都是2A的然后判断04和02

Answer 11

我的buffer()里有2A 04 14 FE FE FE FE FE FE FE FE FE FE FE FE 00 FE FE FE FE FE 00 FE 2A 和
2A 02 0C 04 2B 30 32 38 2E 35 30 6F 43 40 30 35 37 2E 34 38 25 数据的哇

Answer 12

UBound(buffer()) 能这样写吗?
用IsEmpty()测试,可能存在Empty值的对像

Answer 13

如果是loop那里提示下标越界,应该是buffer(UBound(buffer())) = &H2A这里的问题
自己慢慢调吧,这个看上去不是什么大问题啊

Answer 14

Dim strTmp(2) As String
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim strData As String
        
    Winsock1.GetData strData, vbString
    TextBoxTmp = TextBoxTmp & strData
    
End SubPrivate Sub TextBoxTmp_Change()
    Dim iPos, iPos02, iPos04 As Integer
    '假如累计接受小于40字节不做处理,具体长度你可以按合理的字节设置
    If Len(TextBoxTmp) < 40 Then Exit Sub
    
    If InStr(TextBoxTmp, Chr(&H2A)) = 0 Then
        TextBoxTmp = vbNullString   '假如40字节里都不包含收到 2A,清空，在第一次接收时可能会发生
    End If
    
    '把格式调整为以2A开始的字符串。
    If Mid(TextBoxTmp, 1) <> Chr(&H2A) Then
        iPos = InStrRev(TextBoxTmp, Chr(&H2A)) '检查2A字符出现的第一个位置
        TextBoxTmp = Mid(TextBoxTmp, iPos)  '2A以前的字符舍弃，在第一次接收时可能会发生
    End If
    
    '40字节里会出现两处2A
    iPos = InStrRev(TextBoxTmp, Chr(&H2A), 3) '检查2A字符出现的第2个位置
    If Mid(TextBoxTmp, 2) = Chr(&H2) Then      '假如收到 2A,02
        strTmp(0) = Mid(TextBoxTmp, 1, iPos - 1)    '截取第二个2A以前的数据
        '此处添加把字符串strTmp(0)分离出16进制码然后写入Text4的代码，自己完成
    ElseIf Mid(TextBoxTmp, 2) = Chr(&H4) Then   '假如收到 2A,04
        strTmp(1) = Mid(TextBoxTmp, 1, iPos - 1)    '截取第二个2A以前的数据
        '此处添加把字符串strTmp(1)分离出16进制码然后写入Text5的代码，自己完成
    Else
        '此处写如果出现其他现象错误的处理代码，自己完成
    End If
    TextBoxTmp = Mid(TextBoxTmp, iPos)      '保留第二个2A位置以后的数据
End Sub

Answer 15

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim strData As String
    Winsock1.GetData strData, vbString
    TextBoxTmp = TextBoxTmp & strData
End Sub
Private Sub TextBoxTmp_Change()
    Dim iPos As Integer
    Dim strTmp As String
    '假如累计接受小于40字节不做处理,具体长度你可以按合理的字节设置
    If Len(TextBoxTmp) < 40 Then Exit Sub
    If InStr(TextBoxTmp, Chr(&H2A)) = 0 Then
        TextBoxTmp = vbNullString   '假如40字节里都不包含收到2A,清空，在第一次接收时可能会发生
    End If
    '把格式调整为以2A开始的字符串。
    If Mid(TextBoxTmp, 1) <> Chr(&H2A) Then
        iPos = InStrRev(TextBoxTmp, Chr(&H2A)) '检查2A字符出现的第一个位置
        TextBoxTmp = Mid(TextBoxTmp, iPos)  '2A以前的字符舍弃，在第一次接收时可能会发生
    End If
    '40字节里会出现两处2A
    iPos = InStrRev(TextBoxTmp, Chr(&H2A), 3) '检查2A字符出现的第2个位置
    If Mid(TextBoxTmp, 2) = Chr(&H2) Then      '假如收到 2A,02
        strTmp = Mid(TextBoxTmp, 1, iPos - 1)    '截取第二个2A以前的数据
        '此处添加把字符串strTmp分离出16进制码然后写入Text4的代码，自己完成
    ElseIf Mid(TextBoxTmp, 2) = Chr(&H4) Then   '假如收到 2A,04
        strTmp = Mid(TextBoxTmp, 1, iPos - 1)    '截取第二个2A以前的数据
        '此处添加把字符串strTmp分离出16进制码然后写入Text5的代码，自己完成
    Else
        '此处写如果出现其他现象错误的处理代码，自己完成
    End If
    TextBoxTmp = Mid(TextBoxTmp, iPos)      '保留第二个2A位置以后的数据
End Sub

Answer 16

不好意思，增加两个语句
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim strData As String
    Winsock1.GetData strData, vbString
    TextBoxTmp = TextBoxTmp & strData
End Sub
Private Sub TextBoxTmp_Change()
    Dim iPos As Integer
    Dim strTmp As String
    '累计接收小于40字节退出,具体长度你可以按合理的字节设置,40字节里会出现两处2A
    If Len(TextBoxTmp) < 40 Then Exit Sub
    If InStr(TextBoxTmp, Chr(&H2A)) = 0 Then
        TextBoxTmp = vbNullString   '40字节里不包含2A,清空,首次接收时用
        Exit Sub
    End If    
    If Mid(TextBoxTmp, 1) <> Chr(&H2A) Then   '格式调整为以2A开始的字符串。
        iPos = InStrRev(TextBoxTmp, Chr(&H2A)) '检查2A字符出现的第一个位置
        TextBoxTmp = Mid(TextBoxTmp, iPos)  '2A以前的字符舍弃,首次接收时用
        Exit Sub
    End If    
    iPos = InStrRev(TextBoxTmp, Chr(&H2A), 3) '检查2A字符出现的第2个位置
    If Mid(TextBoxTmp, 2) = Chr(&H2) Then      '假如收到 2A,02
        strTmp = Mid(TextBoxTmp, 1, iPos - 1)    '截取第二个2A以前的数据
        '此处添加把字符串strTmp分离出16进制码然后写入Text4的代码，自己完成
    ElseIf Mid(TextBoxTmp, 2) = Chr(&H4) Then   '假如收到 2A,04
        strTmp = Mid(TextBoxTmp, 1, iPos - 1)    '截取第二个2A以前的数据
        '此处添加把字符串strTmp分离出16进制码然后写入Text5的代码，自己完成
    Else
        '此处写如果出现其他现象错误的处理代码，自己完成
    End If
    TextBoxTmp = Mid(TextBoxTmp, iPos)      '保留第二个2A位置以后的数据
End Sub

Answer 17

其实用byte数组代替字符串 就好了

Answer 18

LZ的题目有讨论空间，大家提供的都是一个编程思想，你慢慢调试吧，要补的逻辑漏洞很多很多，首先是我们不明你的通信格式，只是从你列出的数据分析其格式。这点很重要，或许你也是在摸索其数据格式，那么就有很多事情要做了。
比如我说“累计接收小于40字节退出,具体长度你可以按合理的字节设置,40字节里会出现两处2A”，实际接收中，可能不止两处字符码为2A的，那么问题就出来了，到底哪个2A才是真正的下一帧的首字呢？要补充更多的分析判断代码。
哈哈，投入了思想的话题，更在乎其思想有多少可取，希望大家一起来完善，至于结贴不是要考虑的。

Answer 19

请问下mmyyxx88() 
TextBoxTmp这个是自己定义的一个变量还是个文本框？？

Answer 20

http://community.csdn.net/Expert/topic/5699/5699500.xml?temp=9.670657E-02
谁能解决不各位
我知道分不重要，但是我除了感激之外只能多送分咯一共200分

Answer 21

文本框，你看有Sub TextBoxTmp_Change()这个过程。

Answer 22

Option Explicit
  Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Dim buffer() As Byte
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim Data() As Byte
   Dim strData As String
   Dim buffer2() As Byte
   Dim i As Integer
   Dim BufBound As Integer
   buffer = ""
    Winsock1.GetData Data, vbArray Or vbByte
    If UBound(Data()) < 0 Then
        MsgBox "exit"
        Exit Sub
    End If
   
    If UBound(buffer) < 0 Then
      buffer = Data
    Else
      ReDim buffer2(UBound(buffer) + UBound(Data) + 1) As Byte
      CopyMemory ByVal VarPtr(buffer2(0)), ByVal VarPtr(buffer(0)), UBound(buffer) + 1
      CopyMemory ByVal VarPtr(buffer2(UBound(buffer) + 1)), ByVal VarPtr(Data(0)), UBound(Data) + 1
      buffer = buffer2
    End If
   'If buffer(UBound(buffer())) = 42 Then
    BufBound = UBound(buffer())
    'MsgBox buffer(BufBound - 19)
    'CopyMemory VarPtr(buffer(UBound(buffer))), VarPtr(strData()), UBound(strData)
   'MsgBox buffer(BufBound - 12)
   ' MsgBox strData(1)
   ' MsgBox UBound(strData())
    'MsgBox DECtoHEX(strData(1))
    'TextTmp = TextTmp & StrConv(strData(), vbUnicode)
    'buffer() = StrToHex(TextTmp)
    
   If BufBound > 12 Then
     If buffer(BufBound - 12) = &H4 Then
      Text4.Text = StrToHex(StrConv(buffer(), vbUnicode))
       BufBound = BufBound - 14
    'ext5.Text = TextTmp
    End If
   End If
  If BufBound > 19 Then
    If buffer(BufBound - 19) = &H2 Then
       Text5.Text = StrToHex(StrConv(buffer(), vbUnicode))
       BufBound = BufBound - 21    End If
  End If 
End Sub
Public Function StrToHex(ByVal s As String) As String
On Error Resume Next
Dim ByteArr() As Byte
ByteArr = StrConv(s, vbFromUnicode)
Dim Temps As String
Dim Temp As Byte
Dim i As Long
Dim outs As String
For i = 0 To UBound(ByteArr)
Temp = ByteArr(i)
Temps = Hex(Temp)
Temps = Right("00" & Temps, 2)
outs = outs & Temps
Next
StrToHex = outs
End Function