?? zlgcomport.bas
字號:
Attribute VB_Name = "ZlgComPort_Module"
' /*
' ************************************************************************
' *
' * Copyright(c) 2002, 周立功單片機發展有限公司
' * All rights reserved.
' *
' * 文 件: ZlgComPort_Module.bas
' *
' * 摘 要: 本程序主要是演示ZmpCom.dll API函數調用方法
' *
' *
' * 創建日期: 2002年10月26日
' *
' *************************************************************************
' */
'*************************************************************************
'* 聲明引用 ZlgComPort API函數
'*************************************************************************
'------------------------------------------------------------
'說明: 設置通信波特率
'參數: Baud 波特率(bit)
'返回: True 設置波特率成功、False 設置波特率失敗
'------------------------------------------------------------
Declare Function SetCommBaud Lib "ZlgComPort.dll" (ByVal Baud As Integer) As Boolean
'------------------------------------------------------------
'說明: 設置通信端口
'參數: Port 通信端口號(1-4)
'返回: True 設置通信端口成功、False 設置通信端口失敗
'------------------------------------------------------------
Declare Function SetCommPort Lib "ZlgComPort.dll" (ByVal Port As Integer) As Boolean
'------------------------------------------------------------
'說明: 打開通信端口
'參數: 無
'返回: 0 打開通信端口成功、非0打開通信端口失敗
'------------------------------------------------------------
Declare Function OpenPort Lib "ZlgComPort.dll" () As Integer
'------------------------------------------------------------
'說明: 關閉當前通信端口
'參數: 無
'返回: 0 關閉當前通信端口成功、非0關閉當前通信端口失敗
'------------------------------------------------------------
Declare Function ClosePort Lib "ZlgComPort.dll" () As Integer
'------------------------------------------------------------
'說明: 發送數據命令
'參數: pOrderBuff 發送數據首地址、pAckBuff 接收數據首地址、
' nTimeOuts 發送命令超時
'返回: 0 發送數據成功、非0發送數據失敗
'------------------------------------------------------------
Declare Function SendOrder Lib "ZlgComPort.dll" (ByRef pOrderBuff As Byte, ByRef pAckBuff As Byte, ByVal nTimeOuts As Integer) As Integer
'*************************************************************************
'* 聲明引用系統API函數
'*************************************************************************
'------------------------------------------------------------
'說明: 掛起當前線程
'參數: dwMilliseconds 掛起時間(毫秒)
'返回: 無
'------------------------------------------------------------
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'*************************************************************************
'* 聲明全局變量
'*************************************************************************
Public st As Long '接收發送數據命返回值
Public PortOpen As Boolean '串口打開標致
Public stbl As Boolean '接收端口設置狀態
'*************************************************************************
'* 程序函數定義
'*************************************************************************
'------------------------------------------------------------
'說明: 讀E2PRom數據
'參數: BgnAdr_L 開始讀數據低地址、BgnAdr_H 開始讀數據高地址、
' nLen 讀數據長度
'返回: 有字符串返回表示讀數據成功，1為讀數據失敗
'------------------------------------------------------------
Function ReadE2PRom(ByVal BgnAdr_L As Integer, ByVal BgnAdr_H As Integer, ByVal nLen As Integer)
Dim nFrameLen As Integer '幀長度變量
Dim nFrameNum As Integer '幀數
Dim nFrameLeave As Integer '最后一帳數據長度
Dim cAFrameOrder(6) As Byte '發送數據緩沖區
Dim cAFrameAck(13) As Byte '接收數據緩沖區
Dim nBgnAdr_l As Integer '讀數據低地址
Dim nBgnAdr_h As Integer '讀數據高地址
Dim Str As String '返回字符串
Dim i As Integer
Dim j As Integer
ReadE2PRom = ""
nFrameLen = 8 '每幀接收八個數據
nBgnAdr_l = BgnAdr_L
nBgnAdr_h = BgnAdr_H
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) = &H20
cAFrameOrder(2) = &H4
cAFrameOrder(3) = nBgnAdr_l '取發送地址
cAFrameOrder(4) = nBgnAdr_h
cAFrameOrder(5) = 8
cAFrameOrder(6) = 0 '計算校驗和
For j = 0 To 5
cAFrameOrder(6) = cAFrameOrder(6) 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
For j = 1 To nFrameLen
Str = Str + Chr(cAFrameAck(2 + j))
Next j
Else
ReadE2PRom = ""
Exit Function
End If
Else
ReadE2PRom = ""
Exit Function
End If
Next i
If nFrameLeave > 0 Then
cAFrameOrder(0) = &H12 '發最后一幀數據
cAFrameOrder(1) = &H20
cAFrameOrder(2) = &H4
cAFrameOrder(3) = nBgnAdr_l '取發送地址
cAFrameOrder(4) = nBgnAdr_h
cAFrameOrder(5) = nFrameLeave
cAFrameOrder(6) = 0 '計算校驗和
For j = 0 To 5
cAFrameOrder(6) = cAFrameOrder(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
For j = 1 To nFrameLeave
Str = Str + Chr(cAFrameAck(2 + j))
Next j
Else
ReadE2PRom = ""
Exit Function
End If
Else
ReadE2PRom = ""
Exit Function
End If
End If
ReadE2PRom = Str
'返回字符串
End Function
'------------------------------------------------------------
'說明: 向寫E2PRom數據
'參數: BgnAdr_L 開始寫數據低地址、BgnAdr_H 開始寫數據高地址、
' WriteDate 所寫數據
'返回: 0 為發送數成功，1為發送數據失敗
'------------------------------------------------------------
Function WriteE2PRom(ByVal BgnAdr_L As Integer, ByVal BgnAdr_H As Integer, ByVal WriteDate As String)
Dim nFrameLen As Integer '幀長度變量
Dim nFrameNum As Integer '幀數
Dim nFrameLeave As Integer '最后一帳數據長度
Dim cAFrameOrder(13) As Byte '發送數據緩沖區
Dim cAFrameAck(4) As Byte '回應幀數據緩沖區
Dim nBgnAdr_l As Integer '發送數據低地址
Dim nBgnAdr_h As Integer '發送數據高地址
Dim nLen As Integer '發送數據長度
Dim i As Integer
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) = &HB
cAFrameOrder(3) = nBgnAdr_l '取發送地址
cAFrameOrder(4) = nBgnAdr_h
For j = 1 To nFrameLen '取發送數據
cAFrameOrder(4 + j) = Asc(Mid(WriteDate, (i - 1) * 8 + j, 1))
Next j
cAFrameOrder(13) = 0 '計算校驗和
For j = 0 To 12
cAFrameOrder(13) = cAFrameOrder(13) 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
WriteE2PRom = 1
Exit Function
End If
Else
WriteE2PRom = 1
Exit Function
End If
Next i
If nFrameLeave > 0 Then
cAFrameOrder(0) = &H12 '發最后一幀數據
cAFrameOrder(1) = &H21
cAFrameOrder(2) = 3 + nFrameLeave
cAFrameOrder(3) = nBgnAdr_l '取發送地址
cAFrameOrder(4) = nBgnAdr_h
For j = 1 To nFrameLeave '取發送數據
cAFrameOrder(4 + j) = Asc(Mid(WriteDate, nFrameNum * 8 + j, 1))
Next j
cAFrameOrder(nFrameLeave + 5) = 0 '計算校驗和
For j = 0 To nFrameLeave + 4
cAFrameOrder(nFrameLeave + 5) = cAFrameOrder(nFrameLeave + 5) 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
WriteE2PRom = 1
Exit Function
End If
Else
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -