ht-comm.frm

HT系列掌机与电脑通讯VB软件（含源码）

    For i = LBound(cTemp1) To UBound(cTemp1)
      If cTemp1(i) >= 48 And cTemp1(i) <= 57 Then
           cTemp(j) = cTemp1(i)
           j = j + 1
        If j = 1 Then
            If cTemp1(i + 1) >= 48 And cTemp1(i + 1) <= 57 Then
               cTimer(4) = (cTemp(0) - 48) * 10 + cTemp1(i + 1) - 48
               i = i + 1
            Else
               cTimer(4) = (cTemp(0) - 48)
            End If
        End If
        If j = 2 Then
            If cTemp1(i + 1) >= 48 And cTemp1(i + 1) <= 57 Then
               cTimer(5) = (cTemp(1) - 48) * 10 + cTemp1(i + 1) - 48
               i = i + 1
            Else
               cTimer(5) = (cTemp(1) - 48)
            End If
        End If
        If j = 3 Then
            If cTemp1(i + 1) >= 48 And cTemp1(i + 1) <= 57 Then
               cTimer(6) = (cTemp(2) - 48) * 10 + cTemp1(i + 1) - 48
            Else
               cTimer(6) = (cTemp(2) - 48)
            End If
        End If
     End If
    Next
    
    
    
    'test
    'cTimer(0) = 1     'month
    'cTimer(1) = 1     'data
    'cTimer(2) = 209
    'cTimer(3) = 7
    'cTimer(4) = 1     'hour
    'cTimer(5) = 1     'minute
    
    TimerStr = cTimer

    result = WHTOCX21.SetHTNewTime(iPort, iBaud, TimerStr)
    If result >= 0 Then
         result = WHTOCX21.GetInfo(iPort, iBaud)
    End If
    htsettime.Enabled = True
    ReadHTInfo.Enabled = True
 
    End Sub

Private Sub NowPcTime_Click()
     Text2.Text = Format(Date, "yyyy/mm/dd")
     Text7.Text = Format(Time, "hh/mm/ss")
     
End Sub


Private Sub HTList21_FileCopyEnabled(iCode As Integer)
    Select Case iCode
    Case 0
        CM_COMM1.Enabled = False
        CM_COMM2.Enabled = False
        CM_COMM1.Caption = "OCX通讯(&C)"
        CM_COMM2.Caption = "DLL通讯(&T)"
    Case 1
        CM_COMM1.Enabled = True
        CM_COMM2.Enabled = True
        CM_COMM1.Caption = "OCX下装(&C)"
        CM_COMM2.Caption = "DLL下装(&T)"
    Case 2
        CM_COMM1.Enabled = True
        CM_COMM2.Enabled = True
        CM_COMM1.Caption = "OCX上装(&C)"
        CM_COMM2.Caption = "DLL上装(&T)"
    End Select
End Sub

Private Sub ReadHTInfo_Click()
    Dim result As Integer
    ReadHTInfo.Enabled = False
    htsettime.Enabled = False
       
    Call WHTOCX21_ShowHTinfo(" ", " ", " ", 0, 0, 0, 0, 0, 0)
    result = WHTOCX21.GetInfo(iPort, iBaud)
    ReadHTInfo.Enabled = True
    htsettime.Enabled = True
End Sub


Private Sub Label2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbRightButton Then
        If CB_Baud.ListIndex > 0 Then
          CB_Baud.ListIndex = CB_Baud.ListIndex - 1
        End If
    Else
        If CB_Baud.ListIndex < CB_Baud.ListCount - 1 Then
          CB_Baud.ListIndex = CB_Baud.ListIndex + 1
        End If
    End If
End Sub

Private Sub Label3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbRightButton Then
        If CB_Port.ListIndex > 0 Then
          CB_Port.ListIndex = CB_Port.ListIndex - 1
        End If
    Else
        If CB_Port.ListIndex < CB_Port.ListCount - 1 Then
          CB_Port.ListIndex = CB_Port.ListIndex + 1
        End If
    End If
End Sub

Private Sub TabStrip1_Click()
      If TabStrip1.SelectedItem.Index = 1 Then
           CM_COMM1.Enabled = oldcomm1
           CM_COMM2.Enabled = oldcomm2
           HTList21.Visible = True
           Frame6.Enabled = False
           Frame6.Visible = False
           Frame7.Visible = False
           Frame7.Enabled = False
      Else
           oldcomm1 = CM_COMM1.Enabled
           oldcomm2 = CM_COMM2.Enabled
           CM_COMM1.Enabled = False
           CM_COMM2.Enabled = False
           
           HTList21.Visible = False
           Frame6.Enabled = True
           Frame6.Visible = True
           Frame7.Visible = False
           Frame7.Enabled = False
      End If
     
End Sub

Private Sub TB_Serial_Change()
    Dim lSerial As Long
    If Len(TB_Serial.Text) = 0 Then
      TB_Serial.Text = "0"
    End If
    lSerial = CLng(TB_Serial.Text)
    If lSerial > 0 And lSerial < 65536 Then iSerial = lSerial
    WHTOCX21.ResetCommPort
End Sub
Private Sub CM_COMM1_Click()
    Dim r As Integer
    Dim i As Integer
    Dim j As Integer
    Dim iPC As String
    Dim iHT As String
    Dim Comresult As Integer
    
    Screen.MousePointer = vbHourglass
    If InStr(CM_COMM1.Caption, "下装") > 0 Then
        j = 0
        r = 0
        For i = 0 To HTList21.PCFileCount - 1
            If HTList21.PCFileSelected(i) = True Then
                iPC = Trim(HTList21.PCFilePath) + Trim(HTList21.PCFileList(i))
                iHT = ""
                Form1.Enabled = False
                r = WHTOCX21.ExFPut(iPC, iHT, iPort, iBaud, iSerial)
                j = j + 1
                Form1.Enabled = True
                If r < 0 Then
                    Exit For
                End If
            End If
        Next
        
        If j > 0 And r >= 0 Then HTListing
        
    Else
        For i = 0 To HTList21.HTFileCount - 1
            If HTList21.HTFileSelected(i) = True Then
                iHT = Trim(HTList21.HTFileList(i))
                iPC = Trim(HTList21.PCFilePath) + iHT
                Form1.Enabled = False
                r = WHTOCX21.ExFGet(iPC, iHT, iPort, iBaud, iSerial)
                Form1.Enabled = True
                If r < 0 Then
                    Exit For
                Else
                    HTList21.PCFileRefresh
                End If
            End If
        Next
    End If
    Screen.MousePointer = vbDefault
End Sub
Private Sub CM_COMM2_Click()
    Dim r As Integer
    Dim i As Integer
    Dim j As Integer
    Dim p1 As Integer
    Dim p2 As Integer
    Dim iPC As String
    Dim iHT As String
    Dim iPath As String
    Dim sLen As Integer
    
    WHTOCX21.ResetCommPort
    Screen.MousePointer = vbHourglass
    
    If InStr(CM_COMM2.Caption, "下装") > 0 Then
        j = 0
        r = 0
        For i = 0 To HTList21.PCFileCount - 1
            If HTList21.PCFileSelected(i) = True Then
                iHT = Trim(HTList21.PCFilePath) + Trim(HTList21.PCFileList(i))
                iPC = String(200, " ")
                sLen = GetShortPathName(iHT, iPC, 200)
                iPC = Trim$(iPC)
                iPC = Left(iPC, Len(iPC) - 1)
                p1 = 0
                p2 = InStr(1, iPC, "\", 0)
                Do
                   p1 = p2 + 1
                   p2 = InStr(p1, iPC, "\", 0)
                Loop Until p2 = 0
                iHT = Mid(iPath, p1)
                Form1.Enabled = False
                r = ExFPut(iPC, iHT, iPort - 1, iBaud, iSerial)
                j = j + 1
                Form1.Enabled = True
                If r < 0 Then
                    Exit For
                End If
            End If
        Next
        
        If j > 0 And r >= 0 Then HTListing
    Else
        For i = 0 To HTList21.HTFileCount - 1
            If HTList21.HTFileSelected(i) = True Then
                iHT = Trim(HTList21.HTFileList(i))
                iPath = String(200, " ")
                sLen = GetShortPathName(Trim(HTList21.PCFilePath), iPath, 200)
                iPath = Trim$(iPath)
                iPath = Left(iPath, Len(iPath) - 1)
                iPC = iPath + iHT
                Form1.Enabled = False
                r = ExFGet(iPC, iHT, iPort - 1, iBaud, iSerial)
                Form1.Enabled = True
                If r < 0 Then
                    Exit For
                Else
                    HTList21.PCFileRefresh
                End If
            End If
        Next
    End If
    Screen.MousePointer = vbDefault
End Sub
Private Sub GetCommandLine()
    On Error Resume Next
    Dim C, CmdLine, CmdLnLen, InArg, i, CmdType, CmdDrive
    Dim argNum As Long
    Dim lPort As Integer
    Dim lBaud As Long
    Dim lSerial As Long
    
    CmdLine = Command()
    CmdLnLen = Len(CmdLine)
    InArg = False
    CmdType = " "
    CmdDrive = ""
    argNum = 0
    lPort = -1
    lBaud = -1
    lSerial = -1
    For i = 1 To CmdLnLen + 1
        If i > CmdLnLen Then
           C = "/"
        Else
           C = Mid(CmdLine, i, 1)
        End If
        If CmdType = "D" Then
           If C = "/" Or C = " " Then
              CmdType = ""
           Else
              CmdDrive = CmdDrive + C
           End If
        Else
           Select Case C
           Case "/", " "
              Select Case CmdType
              Case "B"
                 lBaud = argNum
              Case "C"
                 lPort = argNum
              Case "S"
                 lSerial = argNum
              End Select
              CmdType = " "
              argNum = 0
           Case "B", "b"
              CmdType = "B"
           Case "C", "c"
              CmdType = "C"
           Case "S", "s"
              CmdType = "S"
           Case "D", "d"
              CmdType = "D"
           Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
              argNum = argNum * 10 + CInt(C)
           End Select
        End If
    Next
    
    If lSerial >= 0 And lSerial < 65536 Then
       TB_Serial.Text = CStr(lSerial)
       iSerial = lSerial
    End If
    If lPort > 0 And lPort < 3 Then
       CB_Port.ListIndex = lPort - 1
       iPort = lPort
    End If
    Select Case lBaud
    Case 9600
       CB_Baud.ListIndex = 0
       iBaud = 9600
    Case 19200
       CB_Baud.ListIndex = 1
       iBaud = 19200
    Case 38400
       CB_Baud.ListIndex = 2
       iBaud = 38400
    Case 57600
       CB_Baud.ListIndex = 3
       iBaud = 57600
    Case 115200
       CB_Baud.ListIndex = 4
       iBaud = 115200
    End Select
    If Len(CmdDrive) > 0 Then
       C = Mid(CmdDrive, 1, 1)
       If C >= "A" And C <= "Z" Or C >= "a" And C <= "z" Then
          HTList21.SetPath (CmdDrive)
       End If
    End If
    On Error GoTo 0
End Sub
Private Sub Form_Load()
    
    With CB_Port
        .AddItem "Com1"      '0
        .AddItem "Com2"      '1
        .AddItem "Com3"      '2
        .AddItem "Com4"      '3
        .ListIndex = 0
    End With
    With CB_Baud
        .AddItem "9600"      '0
        .AddItem "19200"     '1
        .AddItem "38400"     '2
        .AddItem "57600"     '3
        .AddItem "115200"    '4
        .ListIndex = 3
    End With
    

    WHTOCX21.logoinit ("广州兰德智科电子有限公司 手持电脑通讯程序 For Windows V2.3")
    iSerial = 0
    iPort = 1
    iBaud = 57600
    GetCommandLine

End Sub

Private Sub HTListing()
    Dim Comresult As Integer
        
    Screen.MousePointer = vbHourglass
    Form1.Enabled = False

    HTList21.HTFileClear
    Comresult = WHTOCX21.ExFList28(iPort, iBaud, iSerial, 1)
    If Comresult < 0 Then
        Comresult = WHTOCX21.ExFList(iPort, iBaud, iSerial, 1)
        If Comresult < 0 Then
            HTList21.HTFileClear
        Else
            iSerial = WHTOCX21.GetSerial(iPort, iBaud)
            If iSerial >= 0 Then
                 HTList21.ShowHTSerial (iSerial)
            End If
        End If
    Else
        iSerial = WHTOCX21.GetSerial(iPort, iBaud)
        If iSerial >= 0 Then
                 HTList21.ShowHTSerial (iSerial)
        End If
        Comresult = WHTOCX21.GetDir28(iPort, iBaud)
        If Comresult < 0 Then
           HTList21.HTFileClear
        End If
    End If
    
    Screen.MousePointer = vbDefault
    Form1.Enabled = True
End Sub


Private Sub WHTOCX21_ShowHTCurDir28(iPathName As String)
    Call HTList21.HTPathShow(iPathName)
End Sub
Private Sub WHTOCX21_ShowHTinfo(iHTSN As String, iHTtype As String, iHTprd As String, iYear As Integer, iMonth As Integer, iDate As Integer, iHours As Integer, iMinute As Integer, iSecond As Integer)
  Text4.Text = iHTSN
  Text5.Text = iHTtype
  Text6.Text = iHTprd
  Text1.Text = Str(iYear) + "年" + Str(iMonth) + "月" + Str(iDate) + "日   " + Str(iHours) + "小时" + Str(iMinute) + "分" + Str(iSecond) + "秒"
End Sub


Private Sub HTDeling()
    Dim i As Integer
    Dim j As Integer
    Dim DeleFileName As String
    Dim Comresult As Integer
   
    j = 0
    Screen.MousePointer = vbHourglass
    
    Form1.Enabled = False
    For i = 0 To HTList21.HTFileCount - 1
      If HTList21.HTFileSelected(i) = True Then
          DeleFileName = Trim(HTList21.HTFileList(i))
          Comresult = WHTOCX21.DeleteExFile(iPort, iBaud, DeleFileName)
          If Comresult < 0 Then
             Exit For
          Else
             j = j + 1
          End If
        End If
    Next
    Form1.Enabled = True
    Screen.MousePointer = vbDefault
    If j > 0 Then
         HTListing
    End If
End Sub
Private Sub HTList21_MdHTDirClicked(ihtnewpth As String)
    Call WHTOCX21.MdDir28(iPort, iBaud, ihtnewpth)
    HTListing
End Sub

Private Sub HTList21_TraceDirClicked(ihtpath As String)
    Dim result As Integer
    result = WHTOCX21.SetDir28(iPort, iBaud, ihtpath)
    HTListing
End Sub

Private Sub HTList21_ExFDelClicked()
    HTDeling
End Sub
Private Sub HTList21_ExFList28Clicked()
    HTListing
End Sub

Private Sub WHTOCX21_ShowExFList28(iFileName As String, iSize As Long, iDateTime As String, iFileAtt As String)
    Call HTList21.HTFileAdd28(iFileName, iSize, iDateTime, iFileAtt)
End Sub
Private Sub WHTOCX21_ShowExFList(iFileName As String, iSize As Long, iDateTime As String)
    Call HTList21.HTFileAdd(iFileName, iSize, iDateTime)
End Sub