mcomrecevie.bas

RS485文件传送程序

Attribute VB_Name = "mComRecevie"
Option Explicit
Public mTools As New cSundries
Public mMath As New cExpressions

Const BlockSize As Long = 1000

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Const SendCMD_Host As String = "Host"
Public Const SendCMD_Sub As String = "Sub"

Public Const SendCMD_Data As String = "Data"
Public Const SendCMD_Over As String = "Over"

Public Const SendCMD_SubOk As String = "Ok"
Public Const SendCMD_SubNg As String = "Ng"
Public Const SendCMD_SubReSend As String = "Re"


Public Const SendCMD_SubReLen As Integer = 2

Public Const SendCMD_HostCmdLen As Integer = 4
Public Const SendCMD_HostBlockCountLen As Integer = 4
Public Const SendCMD_HostDataCRCLen As Integer = 4


Public Const AddressStrLen As Integer = 3
Public Const FileNameStrLen As Integer = 21

Public ReSendCount As Integer
Public Const ReSendMax As Integer = 5



Private FileNo As Integer
Private FileName As String
Private BlockCount As Long
Public ComSendErr As String




Enum Sub_State
    OK = 0
    NG
    RE
    TimeOut
    CmdErr
    AddrErr
    Over
End Enum



Public Function GetHostData(ByVal vPort As Long, ByVal vAddress As Integer, vReadDataVarr() As Byte, ByVal vTimeOut As Long) As Sub_State
    Dim oldtime As Long
    Dim newtime As Long
    Dim senddata, Buffer As String
    Dim aa As Integer
    Dim i As Integer
    Dim ll As Integer
    Dim FlagTime As Boolean
    Dim FlagEof As Boolean
    Dim DataByteCount As Long
    Dim ReadCRCHi As Integer
    Dim ReadCRCLo As Integer
    Dim ComputeCRCHi As Integer
    Dim ComputeCRCLo As Integer
    Dim ReadDataVarr() As Integer
    Dim OverFlag As Boolean

    '查看缓冲区
    oldtime = timeGetTime
    FlagTime = False
    FlagEof = False
    Do
        DoEvents
        aa = sio_iqueue(vPort)
        newtime = timeGetTime
        If (newtime < oldtime) Then
            oldtime = 0
        Else
            If (newtime - oldtime) > vTimeOut Then
                FlagTime = True
            End If
        End If
    Loop While (aa <> (Len(SendCMD_Host) + AddressStrLen + SendCMD_HostBlockCountLen + (BlockSize * 2) + SendCMD_HostDataCRCLen)) And (FlagTime = False)
    
    If FlagTime = True Then
        '超时
        GetHostData = TimeOut
        GoTo Err
        
    End If
    
    Buffer = Space(aa)
    Call sio_read(vPort, Buffer, aa)
    
    OverFlag = False
    If ((UCase(Mid(Buffer, 1, Len(SendCMD_Data))) <> UCase(SendCMD_Data))) And ((UCase(Mid(Buffer, 1, Len(SendCMD_Over))) <> UCase(SendCMD_Over))) Then
        GetHostData = CmdErr
        GoTo Err
    ElseIf (UCase(Mid(Buffer, 1, Len(SendCMD_Over))) = UCase(SendCMD_Over)) Then
    
        OverFlag = True
        
    End If
     
    
    
    If (Val(Mid(Buffer, 1 + Len(SendCMD_Data), AddressStrLen)) <> vAddress) Then
        GetHostData = AddrErr
        GoTo Err
    End If
    
    DataByteCount = Val(Mid(Buffer, 1 + Len(SendCMD_Host) + AddressStrLen, SendCMD_HostBlockCountLen))
    
    If (DataByteCount <= 0) Then
        GetHostData = NG
        GoTo Err
    End If
    
    ReDim ReadDataVarr(DataByteCount - 1)
    
    For i = 0 To DataByteCount - 1
        ReadDataVarr(i) = Val("&H" & Mid(Buffer, 1 + Len(SendCMD_Host) + AddressStrLen + SendCMD_HostBlockCountLen + (i * 2), 1) & Mid(Buffer, 1 + Len(SendCMD_Host) + AddressStrLen + SendCMD_HostBlockCountLen + (i * 2) + 1, 1))
        
    Next i
    
    
    ReadCRCHi = Val("&H" & Mid(Buffer, 1 + Len(SendCMD_Host) + AddressStrLen + SendCMD_HostBlockCountLen + BlockSize * 2, 1) & Mid(Buffer, 1 + Len(SendCMD_Host) + AddressStrLen + SendCMD_HostBlockCountLen + BlockSize * 2 + 1, 1))
    ReadCRCLo = Val("&H" & Mid(Buffer, 1 + Len(SendCMD_Host) + AddressStrLen + SendCMD_HostBlockCountLen + BlockSize * 2 + 2, 1) & Mid(Buffer, 1 + Len(SendCMD_Host) + AddressStrLen + SendCMD_HostBlockCountLen + BlockSize * 2 + 3, 1))
    Call mMath.CheckSum_CRC_TwoByte(ReadDataVarr, ComputeCRCHi, ComputeCRCLo)
    
    If (ReadCRCHi <> ComputeCRCHi) Or (ReadCRCLo <> ComputeCRCLo) Then
        GetHostData = RE
        GoTo Err
    End If
    
    ReDim vReadDataVarr(DataByteCount - 1)
    For i = 0 To UBound(ReadDataVarr)
        vReadDataVarr(i) = ReadDataVarr(i) And &HFF
    Next i
    
    From1.Label1.Caption = DataByteCount + Val(From1.Label1.Caption)
    
    If OverFlag = False Then
        GetHostData = OK
    Else
        GetHostData = Over
    End If
    Exit Function
Err:

    Call sio_flush(vPort, 2)



End Function


Public Function RecevieFile(ByVal vPort As Long, ByVal vBaud As Long, ByVal vPortSetting As Long, ByVal vAddress As Long) As Boolean


    Dim oldtime As Long
    Dim newtime As Long
    Dim senddata, Buffer As String
    Dim dvalue As Single
    Dim ReturnStr As String * 256
    Dim Addr As Integer
    Dim aa As Integer
    Dim i As Integer
    Dim ll As Integer
    Dim FlagTime As Boolean
    Dim FlagEof As Boolean
    Dim kkk As Long
    Dim ReadByte As Byte
    Dim SubTakeState As Integer
    Dim SendFlag As Boolean
    
    Dim ReadDataVarr() As Byte
    Dim mCRC_Hi As Integer
    Dim mCRC_Lo As Integer
    Dim GetHostDataState As Integer
    
    
    RecevieFile = False
    
    
    
    
    
    kkk = sio_flush(vPort, 2) '清缓存区，KKK= -1 端口未打开
    
    If kkk = 0 Then
        GoTo PortIsOpen
    End If
    
    If sio_open(vPort) <> SIO_OK Then
        ComSendErr = "端口打开失败！"
        Exit Function
    End If
    
    
PortIsOpen:
    
    '确定波特率
    If sio_ioctl(vPort, vBaud, vPortSetting) <> SIO_OK Then
        ComSendErr = "端口设置失败！"
        GoTo Err
    End If
    
    FileName = CheckHostTake(vPort, vAddress, 1000)
    If FileName = "" Then
        GoTo Err
    End If
    
    
    If FileSystem.Dir(mTools.JoinPath(App.Path, FileName)) <> "" Then
        Call FileSystem.Kill(mTools.JoinPath(App.Path, FileName))
    End If
    
    Call mTools.CreateAfile(mTools.JoinPath(App.Path, FileName))
    
    
    FileNo = FreeFile()
    
    
    Open mTools.JoinPath(App.Path, FileName) For Binary Lock Write As #FileNo
    
    
    senddata = SendCMD_Sub
    senddata = senddata & Format(Left(CStr(vAddress), AddressStrLen), "000")
    
    senddata = senddata & SendCMD_SubOk
    
    Call sio_write(vPort, senddata, Len(senddata))
    
    From1.Label3.Caption = "开始接收数据......."
    
    ReDim ReadDataVarr(0) As Byte
    Seek #FileNo, 1
    
    Do
    
        DoEvents
        
        senddata = SendCMD_Sub
        senddata = senddata & Format(Left(CStr(vAddress), AddressStrLen), "000")
    
        GetHostDataState = GetHostData(vPort, vAddress, ReadDataVarr, 2000)
        
        If (GetHostDataState <> Sub_State.OK) And (GetHostDataState <> Sub_State.Over) Then
        
            If GetHostDataState <> Sub_State.RE Then
                senddata = senddata & SendCMD_SubNg
                Call sio_write(vPort, senddata, Len(senddata))
                GoTo Err
            Else
                senddata = senddata & SendCMD_SubReSend
            End If
            
        Else
            Put #FileNo, , ReadDataVarr
            senddata = senddata & SendCMD_SubOk
            
            
            If (GetHostDataState = Sub_State.Over) Then
                Call sio_write(vPort, senddata, Len(senddata))
                Exit Do
            End If
            
            
        End If
        
        
        Call sio_write(vPort, senddata, Len(senddata))

    Loop
    

    
    RecevieFile = True
    Close #FileNo
    Exit Function
Err:
    
    
    If (FileName <> "") And (FileSystem.Dir(mTools.JoinPath(App.Path, FileName)) <> "") Then
        Close #FileNo
        Call FileSystem.Kill(mTools.JoinPath(App.Path, FileName))
        From1.Label1.Caption = "0 "
    End If


End Function









Public Function CheckHostTake(ByVal vPort As Long, ByVal vAddress As Integer, ByVal vTimeOut As Long) As String


    Dim oldtime As Long
    Dim newtime As Long
    Dim senddata As String
    Dim Buffer As String
    Dim aa As Integer
    Dim i As Integer
    Dim ll As Integer
    Dim FlagTime As Boolean
    Dim FlagEof As Boolean
    
    
    CheckHostTake = ""
    
    aa = sio_flush(vPort, 2)
    
    '把命令发送
'    aa = sio_write(vPort, senddata, Len(senddata))
    
    
    '查看缓冲区
    oldtime = timeGetTime
    FlagTime = False
    FlagEof = False
    Do
        DoEvents
        aa = sio_iqueue(vPort)
        newtime = timeGetTime
        If (newtime < oldtime) Then
            oldtime = 0
        Else
            If (newtime - oldtime) > vTimeOut Then
                FlagTime = True
            End If
        End If
    Loop While (aa <> (Len(SendCMD_Host) + AddressStrLen + FileNameStrLen)) And (FlagTime = False)
    
    If FlagTime = True Then
        '超时
        GoTo Err
        
    End If
    
    Buffer = Space(aa)
    Call sio_read(vPort, Buffer, aa)
    
    If (UCase(Mid(Buffer, 1, Len(SendCMD_Host))) <> UCase(SendCMD_Host)) Then
        GoTo Err
    End If
    
    
    
    If (Val(Mid(Buffer, 1 + Len(SendCMD_Host), AddressStrLen)) <> vAddress) Then
        GoTo Err
    End If
    
    
    
    

    CheckHostTake = Trim(Mid(Buffer, 1 + Len(SendCMD_Host) + AddressStrLen, FileNameStrLen))
    Exit Function
Err:
    CheckHostTake = ""
    Call sio_flush(vPort, 2)

End Function