Dim j As Integer
       
    WriteE2PRom = 1
    nFrameLen = 8                            '每幀發送八個數據
    nBgnAdr_l = BgnAdr_L
    nBgnAdr_h = BgnAdr_H
      
    nLen = Len(WriteDate)                    '取字符串長度
    If nLen > 0 Then
        nFrameNum = Int(nLen / nFrameLen)
        nFrameLeave = nLen Mod nFrameLen
    End If
    
    
    For i = 1 To nFrameNum                   '發送nFrameNum幀數據
        cAFrameOrder(0) = &H12
        cAFrameOrder(1) = &H21
        cAFrameOrder(2) = &HD                '長度
        cAFrameOrder(3) = DpAdr              'DP-51地址
        cAFrameOrder(4) = nBgnAdr_l          '取發送地址
        cAFrameOrder(5) = nBgnAdr_h
        
        For j = 1 To nFrameLen                '取發送數據
           cAFrameOrder(5 + j) = Asc(Mid(WriteDate, (i - 1) * 8 + j, 1))
        Next j
        
           cAFrameOrder(14) = 0               '計算校驗和
        For j = 0 To 13
          cAFrameOrder(14) = cAFrameOrder(14) Xor cAFrameOrder(j)
        Next j
        
        nBgnAdr_l = nBgnAdr_l + 8             '計算下一個地址

        
        St = SendOrder(cAFrameOrder(0), cAFrameAck(0), 1000)
        Sleep 100                              '掛起100毫秒
        
        If St = 0 Then                         '判斷發送數據是否正確
              If cAFrameAck(1) = &HA0 Then
                  WriteE2PRom = 0
              Else
                  St = ErrManage(cAFrameAck(2), cAFrameAck(3), cAFrameAck(4)) '取返回錯誤幀數據
                  WriteE2PRom = 1              '向調用程序返回出錯信息
                   Exit Function
              End If
           
        Else
          St = ErrManage(cAFrameAck(2), cAFrameAck(3), cAFrameAck(4)) '取返回錯誤幀數據
          WriteE2PRom = 1              '向調用程序返回出錯信息
          Exit Function
        End If
    Next i
     
     
     
  If nFrameLeave > 0 Then
        cAFrameOrder(0) = &H12                '發最后一幀數據
        cAFrameOrder(1) = &H21
        cAFrameOrder(2) = 4 + nFrameLeave
        cAFrameOrder(3) = DpAdr               'DP-51地址
        cAFrameOrder(4) = nBgnAdr_l           '取發送地址
        cAFrameOrder(5) = nBgnAdr_h
        
        For j = 1 To nFrameLeave              '取發送數據
           cAFrameOrder(5 + j) = Asc(Mid(WriteDate, nFrameNum * 8 + j, 1))
        Next j
        
           cAFrameOrder(nFrameLeave + 6) = 0   '計算校驗和
        For j = 0 To nFrameLeave + 5
          cAFrameOrder(nFrameLeave + 6) = cAFrameOrder(nFrameLeave + 6) Xor cAFrameOrder(j)
        Next j
        
        
        St = SendOrder(cAFrameOrder(0), cAFrameAck(0), 1000)
        Sleep 100                              '掛起100毫秒
        
        If St = 0 Then                         '判斷發送數據是否正確
           If cAFrameAck(1) = &HA0 Then
                   WriteE2PRom = 0
           Else
                  St = ErrManage(cAFrameAck(2), cAFrameAck(3), cAFrameAck(4)) '取返回錯誤幀數據
                  WriteE2PRom = 1              '向調用程序返回出錯信息
                   Exit Function
           End If
        Else
          St = ErrManage(cAFrameAck(2), cAFrameAck(3), cAFrameAck(4)) '取返回錯誤幀數據
          WriteE2PRom = 1              '向調用程序返回出錯信息
          Exit Function
        End If
 End If
 
End Function
        '------------------------------------------------------------
        '說明:  十六進制字符轉為十進制值
        '參數:  HChar 十六進制字符(兩位)
        '
        '返回:  返回十進制值
        '------------------------------------------------------------
Function HtoD(ByVal HChar As String)
    Dim Ch1 As Long
    Dim Ch2 As Long
    
    Ch1 = Asc(Left$(HChar, 1))
    Ch2 = Asc(Right$(HChar, 1))
    Select Case Ch1
       Case 48 To 57
         Ch1 = Ch1 - 48
       Case 65 To 70
          Ch1 = Ch1 - 55
       Case 97 To 102
          Ch1 = Ch1 - 87
   End Select
   
    Select Case Ch2
       Case 48 To 57
         Ch2 = Ch2 - 48
       Case 65 To 70
          Ch2 = Ch2 - 55
       Case 97 To 102
          Ch2 = Ch2 - 87
   End Select
   Ch1 = Ch1 * 16 + Ch2
   HtoD = Ch1
End Function


        '------------------------------------------------------------
        '說明:  把字符串轉為十六進制顯示
        '參數:  Str字符串
        '
        '返回:  十六進制的字符串
        '------------------------------------------------------------
Function StoH(ByVal Str As String)
    Dim i As Integer
    Dim StrTem As String
    Dim StrTem2 As String
    
    If Len(Str) > 0 Then
     For i = 1 To Len(Str)
       StrTem2 = ""
       StrTem2 = Hex(Asc(Mid(Str, i, 1)))
       If Len(StrTem2) = 1 Then
          StrTem2 = "0" + StrTem2
       End If
       StrTem = StrTem + StrTem2 + " "
     Next i
       StoH = StrTem
    End If
End Function
        '------------------------------------------------------------
        '說明:  把字符串轉為十六進制顯示
        '參數:  Str十六進制字符
        '
        '返回:  字符串
        '------------------------------------------------------------
Function HtoS(ByVal Str As String)
    Dim i As Integer
    Dim StrTem As String
    Dim StrTem2 As String
    
    If Len(Trim(Str)) > 0 Then
     For i = 1 To Len(Trim(Str))
        If Asc(Mid(Trim(Str), i, 1)) <> 32 Then            '不為空格時
              StrTem2 = Mid(Trim(Str), i, 1)
              i = i + 1                                    '指向下一個
            If i <= Len(Trim(Str)) Then
              If Asc(Mid(Trim(Str), i, 1)) <> 32 Then
                 StrTem2 = StrTem2 + Mid(Trim(Str), i, 1)
              End If
            End If
            If Len(StrTem2) = 1 Then
              StrTem2 = "0" + StrTem2
            End If
              StrTem = StrTem + Chr(HtoD(StrTem2))
              StrTem2 = ""
        End If
     Next i
       HtoS = StrTem
    End If
End Function
        '------------------------------------------------------------
        '說明:  錯誤處理
        '參數:  Par1  為返回幀的cAFrameAck(2)、Par1  為返回幀的cAFrameAck(3)
        '       Par1  為返回幀的cAFrameAck(4)
        '返回:  無
        '------------------------------------------------------------
Function ErrManage(ByVal par1 As Byte, ByVal par2 As Byte, ByVal par3 As Byte)

   
   Select Case par1
          Case 0                                        '超時操作
                MsgBox "操作超時！", vbInformation, "提示"
                Exit Function
          Case 2                                        '讀數據操作
            If par2 = 0 Then
                MsgBox "命令或校驗出錯！", vbInformation, "提示"
                Exit Function
            End If
            
            If par2 = 1 Then
                MsgBox "讀數據出錯！", vbInformation, "提示"
                Exit Function
            Else
                MsgBox "其它未定義出錯！", vbInformation, "提示"
                Exit Function
            End If
          
          Case 3                                        '寫數據操作
                MsgBox "寫E2PROM出錯，出錯地址:" & Hex(par3) & ":" & Hex(par2) & "H", vbInformation, "提示"
                Exit Function
            
          Case Else                                     '其它出錯
                MsgBox "其它未定義出錯！", vbInformation, "提示"
                Exit Function
   End Select
   
End Function