frmsetnodelocation.frm

无线传感器网络节点的定位引擎程序

    Exit Sub
End If


If (strNodeLocationX = "") Then
    MsgBox "请输入X坐标", vbOKOnly, "Error"
    Exit Sub
End If
If (Len(strNodeLocationX) > 2) Then
    MsgBox "请输入正确的X坐标信息(长度小于2)", vbOKOnly, "Error"
   
    Exit Sub
End If

If Not isHex(Left(strNodeLocationX, 1)) Then
    MsgBox "请输入正确的X坐标", vbOKOnly, "Error"
    
    Exit Sub

End If
If Not isHex(Right(strNodeLocationX, 1)) Then
    MsgBox "请输入正确的X坐标", vbOKOnly, "Error"
   
    Exit Sub
End If



If (strNodeLocationY = "") Then
    MsgBox "请输入Y坐标", vbOKOnly, "Error"
    Exit Sub
End If
If (Len(strNodeLocationY) > 2) Then
    MsgBox "请输入正确的Y坐标信息(长度小于2)", vbOKOnly, "Error"
   
    Exit Sub
End If

If Not isHex(Left(strNodeLocationY, 1)) Then
    MsgBox "请输入正确的Y坐标", vbOKOnly, "Error"
    
    Exit Sub

End If
If Not isHex(Right(strNodeLocationY, 1)) Then
    MsgBox "请输入正确的Y坐标", vbOKOnly, "Error"
   
    Exit Sub

End If



If (strNodeLocationZ = "") Then
    MsgBox "请输入Z坐标", vbOKOnly, "Error"
    Exit Sub
End If
If (Len(strNodeLocationZ) > 2) Then
    MsgBox "请输入正确的Z坐标信息(长度小于2)", vbOKOnly, "Error"
   
    Exit Sub
End If

If Not isHex(Left(strNodeLocationZ, 1)) Then
    MsgBox "请输入正确的Z坐标", vbOKOnly, "Error"
    
    Exit Sub

End If
If Not isHex(Right(strNodeLocationZ, 1)) Then
    MsgBox "请输入正确的Z坐标", vbOKOnly, "Error"
   
    Exit Sub

End If

'通过串口设置坐标
If MsgBox("确定写入节点?", vbOKCancel, "confirm") = vbOK Then
    If (isCommOpen = False) Then
        MsgBox "串口没有被正确打开，请检查配置文件"
        
        Exit Sub
    End If
    Command(0) = COMMAND_SET_LOCATION
    Command(1) = Command(0)
    Command(2) = Command(0)
    Command(3) = PC_ADDRESS
    Command(4) = "&H" & strNodeAddress
    seqno = seqno + 1
    
    '修改ini中seqno
    WritePrivateProfileString "SEQNO", "seqno", CStr(seqno), ConfigFilePath
    Int2BYTE seqno, Command(6), Command(5)
    Command(7) = "&H" & strNodeLocationX
    Command(8) = "&H" & strNodeLocationY
    Command(9) = "&H" & strNodeLocationZ
    
    MainForm.Text1.Text = MainForm.Text1.Text & Now & " " & "发送" & " "
    
    For i = 0 To UBound(Command)
    MainForm.Text1.Text = MainForm.Text1.Text + " "
    If Len(CStr(Hex(Command(i)))) = 1 Then
        MainForm.Text1.Text = MainForm.Text1.Text + "0"
    
    End If
        MainForm.Text1.Text = MainForm.Text1.Text + CStr(Hex(Command(i)))
    Next
    MainForm.Text1.Text = MainForm.Text1.Text + vbCrLf
    
    
    MainForm.MSComm1.Output = Command
    
    'waitting for response
    
    Dim txtBuff() As Byte
    



    MainForm.MSComm1.InBufferCount = 0 ' clear inBuffer
    Timer1.Enabled = True
    Timer1.Interval = UART_RADIO_RETRY_COUNT * UART_RADIO_HAL_TIME + 2000
    timeout = False
    

    Do
      DoEvents
      If timeout Then
        Exit Do
      End If
    Loop Until ((MainForm.MSComm1.InBufferCount = COMMAND_RESPONSE_LENGTH))
    Timer1.Enabled = False
    If (Not timeout) Then
         isreceived = True
          MainForm.Text1.Text = MainForm.Text1.Text & Now & " " & "接收" & " "
        txtBuff = MainForm.MSComm1.Input
        For i = 0 To COMMAND_RESPONSE_LENGTH - 1
        MainForm.Text1.Text = MainForm.Text1.Text + " "
        If Len(CStr(Hex(txtBuff(i)))) = 1 Then
            MainForm.Text1.Text = MainForm.Text1.Text + "0"
        
        End If
            MainForm.Text1.Text = MainForm.Text1.Text + CStr(Hex(txtBuff(i)))
        Next
        MainForm.Text1.Text = MainForm.Text1.Text + vbCrLf
        
        If (CStr(txtBuff(0) = CStr(COMMAND_SET_LOCATION_RESPONSE)) And Hex(txtBuff(0)) = Hex(txtBuff(1)) And Hex(txtBuff(1)) = Hex(txtBuff(2))) Then
            '检查设置是否成功
            If txtBuff(6) = SUCCESS_RESPONSE Then
                MsgBox "设置成功", , "success"
            Else
                msgErrorMessage CInt(CStr(txtBuff(7)))
            End If
            
        Else
            MsgBox "错误的响应格式", , "Error"
        End If
    Else
        MsgBox "定时器超时，请检查网关节点和PC串口是否连接完好"
        Timer1.Enabled = False
    End If
   
    
    
   
    
   
   
End If







End Sub
Private Sub butQueryNodeLocation_Click()
  Dim strNodeAddress As String
  Dim i As Integer
  
  strNodeAddress = Trim(textNodeAddress)
  
  If (strNodeAddress = "") Then
    MsgBox "请输入节点地址", vbOKOnly, "Error"
    Exit Sub
End If
If (Len(strNodeAddress) > 2) Then
    MsgBox "请输入正确的节点地址信息(长度小于2)", vbOKOnly, "Error"
   
    Exit Sub
End If

If Not isHex(Left(strNodeAddress, 1)) Then
    MsgBox "请输入正确的节点地址", vbOKOnly, "Error"
    
    Exit Sub

End If
If Not isHex(Right(strNodeAddress, 1)) Then
    MsgBox "请输入正确的节点地址", vbOKOnly, "Error"
   
    Exit Sub
End If

'通过串口查询坐标
'If MsgBox("确定写入节点?", vbOKCancel, "confirm") = vbOK Then
    If (isCommOpen = False) Then
        MsgBox "串口没有被正确打开，请检查配置文件"
        
        Exit Sub
    End If
    Command(0) = COMMAND_QUERY_LOCATION
    Command(1) = Command(0)
    Command(2) = Command(0)
    Command(3) = PC_ADDRESS
    Command(4) = "&H" & strNodeAddress
    seqno = seqno + 1
    
    '修改ini中seqno
    WritePrivateProfileString "SEQNO", "seqno", CStr(seqno), ConfigFilePath
    Int2BYTE seqno, Command(6), Command(5)
    Command(7) = &H0
    Command(8) = &H0
    Command(9) = &H0
    
    MainForm.Text1.Text = MainForm.Text1.Text & Now & " " & "发送" & " "
    
    For i = 0 To UBound(Command)
    MainForm.Text1.Text = MainForm.Text1.Text + " "
    If Len(CStr(Hex(Command(i)))) = 1 Then
        MainForm.Text1.Text = MainForm.Text1.Text + "0"
    
    End If
        MainForm.Text1.Text = MainForm.Text1.Text + CStr(Hex(Command(i)))
    Next
    MainForm.Text1.Text = MainForm.Text1.Text + vbCrLf
    
    
    MainForm.MSComm1.Output = Command
    
    'waitting for response
    
    Dim txtBuff() As Byte
    



    MainForm.MSComm1.InBufferCount = 0 ' clear inBuffer
    Timer1.Enabled = True
    Timer1.Interval = UART_RADIO_RETRY_COUNT * UART_RADIO_HAL_TIME + 2000
    timeout = False
    

    Do
      DoEvents
      If timeout Then
        Exit Do
      End If
      'MsgBox MainForm.MSComm1.InBufferCount
    Loop Until ((MainForm.MSComm1.InBufferCount = COMMAND_RESPONSE_LENGTH))
    'MsgBox MainForm.MSComm1.InBufferCount
    Timer1.Enabled = False
    If Not timeout Then
        isreceived = True
        MainForm.Text1.Text = MainForm.Text1.Text & Now & " " & "接收" & " "
        txtBuff = MainForm.MSComm1.Input
        For i = 0 To COMMAND_RESPONSE_LENGTH - 1
        MainForm.Text1.Text = MainForm.Text1.Text + " "
        If Len(CStr(Hex(txtBuff(i)))) = 1 Then
            MainForm.Text1.Text = MainForm.Text1.Text + "0"
    
        End If
            MainForm.Text1.Text = MainForm.Text1.Text + CStr(Hex(txtBuff(i)))
        Next
        MainForm.Text1.Text = MainForm.Text1.Text + vbCrLf
    
        If (CStr(txtBuff(0) = CStr(COMMAND_QUERY_LOCATION_RESPONSE)) And Hex(txtBuff(0)) = Hex(txtBuff(1)) And Hex(txtBuff(1)) = Hex(txtBuff(2))) Then
            '检查设置是否成功
            If txtBuff(6) = SUCCESS_RESPONSE Then
                'MsgBox "查询成功", , "success"
                textX.Text = Hex(txtBuff(7))
                textY.Text = Hex(txtBuff(8))
                textZ.Text = Hex(txtBuff(9))
                
                labrssi.Caption = txtBuff(10)
                
                
            Else
                msgErrorMessage CInt(CStr(txtBuff(7)))
            End If
    
        Else
            MsgBox "错误的响应格式", , "Error"
        End If
    Else
         MsgBox "定时器超时，请检查网关节点和PC串口是否连接完好"
        Timer1.Enabled = False
    End If
    
   

    
    
   
  
'End If




End Sub




Private Sub butConvert16to10_Click()
    If Trim(textAfterConverted.Text) = "" Then
        MsgBox "要转换的16进制坐标不能为空", , "Error"
        Exit Sub
    End If
    textBeforeConverted.Text = CStr(Val("&H" & textAfterConverted.Text) / 4)
   
End Sub

Private Sub Form_Load()
'MsgBox (45 - Val("&HFF" & "81"))
If (queryorsetlocation = 1) Then
    '设置坐标
    butQueryNodeLocation.Enabled = False
    butConvert16to10.Enabled = False
    textAfterConverted.Enabled = False
Else
    '查询
    butSetNodeLocation.Enabled = False
      butConvert10to16.Enabled = False
    textBeforeConverted.Enabled = False
    textX.Enabled = False
    textY.Enabled = False
    textZ.Enabled = False
    
End If

    
End Sub

Private Sub Timer1_Timer()
'If Not isreceived Then
   
    
    timeout = True
'End If
    
End Sub