?? zlgcomport.bas
字號:
Attribute VB_Name = "ZlgComPort_Module"
' /*
' ************************************************************************
' *
' * Copyright(c) 2002, 周立功單片機發(fā)展有限公司
' * All rights reserved.
' *
' * 文 件: ZlgComPort_Module.bas
' *
' * 摘 要: 本程序主要是演示ZmpCom.dll API函數(shù)調用方法
' *
' *
' * 創(chuàng)建日期: 2002年10月26日
' *
' *************************************************************************
' */
'*************************************************************************
'* 聲明引用 ZlgComPort API函數(shù)
'*************************************************************************
'------------------------------------------------------------
'說明: 設置通信波特率
'參數(shù): Baud 波特率(bit)
'返回: True 設置波特率成功、False 設置波特率失敗
'------------------------------------------------------------
Declare Function SetCommBaud Lib "ZlgComPort.dll" (ByVal Baud As Integer) As Boolean
'------------------------------------------------------------
'說明: 設置通信端口
'參數(shù): Port 通信端口號(1-4)
'返回: True 設置通信端口成功、False 設置通信端口失敗
'------------------------------------------------------------
Declare Function SetCommPort Lib "ZlgComPort.dll" (ByVal Port As Integer) As Boolean
'------------------------------------------------------------
'說明: 打開通信端口
'參數(shù): 無
'返回: 0 打開通信端口成功、非0打開通信端口失敗
'------------------------------------------------------------
Declare Function OpenPort Lib "ZlgComPort.dll" () As Integer
'------------------------------------------------------------
'說明: 關閉當前通信端口
'參數(shù): 無
'返回: 0 關閉當前通信端口成功、非0關閉當前通信端口失敗
'------------------------------------------------------------
Declare Function ClosePort Lib "ZlgComPort.dll" () As Integer
'------------------------------------------------------------
'說明: 發(fā)送數(shù)據(jù)命令
'參數(shù): pOrderBuff 發(fā)送數(shù)據(jù)首地址、pAckBuff 接收數(shù)據(jù)首地址、
' nTimeOuts 發(fā)送命令超時
'返回: 0 發(fā)送數(shù)據(jù)成功、非0發(fā)送數(shù)據(jù)失敗
'------------------------------------------------------------
Declare Function SendOrder Lib "ZlgComPort.dll" (ByRef pOrderBuff As Byte, ByRef pAckBuff As Byte, ByVal nTimeOuts As Integer) As Integer
'*************************************************************************
'* 聲明引用系統(tǒng)API函數(shù)
'*************************************************************************
'------------------------------------------------------------
'說明: 掛起當前線程
'參數(shù): dwMilliseconds 掛起時間(毫秒)
'返回: 無
'------------------------------------------------------------
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'*************************************************************************
'* 聲明全局變量
'*************************************************************************
Public st As Long '接收發(fā)送數(shù)據(jù)命返回值
Public PortOpen As Boolean '串口打開標致
Public stbl As Boolean '接收端口設置狀態(tài)
'*************************************************************************
'* 程序函數(shù)定義
'*************************************************************************
'------------------------------------------------------------
'說明: 讀E2PRom數(shù)據(jù)
'參數(shù): BgnAdr_L 開始讀數(shù)據(jù)低地址、BgnAdr_H 開始讀數(shù)據(jù)高地址、
' nLen 讀數(shù)據(jù)長度
'返回: 有字符串返回表示讀數(shù)據(jù)成功，1為讀數(shù)據(jù)失敗
'------------------------------------------------------------
Function ReadE2PRom(ByVal BgnAdr_L As Integer, ByVal BgnAdr_H As Integer, ByVal nLen As Integer)
Dim nFrameLen As Integer '幀長度變量
Dim nFrameNum As Integer '幀數(shù)
Dim nFrameLeave As Integer '最后一帳數(shù)據(jù)長度
Dim cAFrameOrder(6) As Byte '發(fā)送數(shù)據(jù)緩沖區(qū)
Dim cAFrameAck(13) As Byte '接收數(shù)據(jù)緩沖區(qū)
Dim nBgnAdr_l As Integer '讀數(shù)據(jù)低地址
Dim nBgnAdr_h As Integer '讀數(shù)據(jù)高地址
Dim Str As String '返回字符串
Dim i As Integer
Dim j As Integer
ReadE2PRom = ""
nFrameLen = 8 '每幀接收八個數(shù)據(jù)
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 '發(fā)送nFrameNum幀數(shù)據(jù)
cAFrameOrder(0) = &H12
cAFrameOrder(1) = &H20
cAFrameOrder(2) = &H4
cAFrameOrder(3) = nBgnAdr_l '取發(fā)送地址
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 '判斷發(fā)送數(shù)據(jù)是否正確
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 '發(fā)最后一幀數(shù)據(jù)
cAFrameOrder(1) = &H20
cAFrameOrder(2) = &H4
cAFrameOrder(3) = nBgnAdr_l '取發(fā)送地址
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 '判斷發(fā)送數(shù)據(jù)是否正確
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數(shù)據(jù)
'參數(shù): BgnAdr_L 開始寫數(shù)據(jù)低地址、BgnAdr_H 開始寫數(shù)據(jù)高地址、
' WriteDate 所寫數(shù)據(jù)
'返回: 0 為發(fā)送數(shù)成功，1為發(fā)送數(shù)據(jù)失敗
'------------------------------------------------------------
Function WriteE2PRom(ByVal BgnAdr_L As Integer, ByVal BgnAdr_H As Integer, ByVal WriteDate As String)
Dim nFrameLen As Integer '幀長度變量
Dim nFrameNum As Integer '幀數(shù)
Dim nFrameLeave As Integer '最后一帳數(shù)據(jù)長度
Dim cAFrameOrder(13) As Byte '發(fā)送數(shù)據(jù)緩沖區(qū)
Dim cAFrameAck(4) As Byte '回應幀數(shù)據(jù)緩沖區(qū)
Dim nBgnAdr_l As Integer '發(fā)送數(shù)據(jù)低地址
Dim nBgnAdr_h As Integer '發(fā)送數(shù)據(jù)高地址
Dim nLen As Integer '發(fā)送數(shù)據(jù)長度
Dim i As Integer
Dim j As Integer
WriteE2PRom = 1
nFrameLen = 8 '每幀發(fā)送八個數(shù)據(jù)
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 '發(fā)送nFrameNum幀數(shù)據(jù)
cAFrameOrder(0) = &H12
cAFrameOrder(1) = &H21
cAFrameOrder(2) = &HB
cAFrameOrder(3) = nBgnAdr_l '取發(fā)送地址
cAFrameOrder(4) = nBgnAdr_h
For j = 1 To nFrameLen '取發(fā)送數(shù)據(jù)
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 '判斷發(fā)送數(shù)據(jù)是否正確
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 '發(fā)最后一幀數(shù)據(jù)
cAFrameOrder(1) = &H21
cAFrameOrder(2) = 3 + nFrameLeave
cAFrameOrder(3) = nBgnAdr_l '取發(fā)送地址
cAFrameOrder(4) = nBgnAdr_h
For j = 1 To nFrameLeave '取發(fā)送數(shù)據(jù)
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 '判斷發(fā)送數(shù)據(jù)是否正確
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
'------------------------------------------------------------
'說明: 十六進制字符轉為十進制值
'參數(shù): 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
'------------------------------------------------------------
'說明: 把字符串轉為十六進制顯示
'參數(shù): 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
'------------------------------------------------------------
'說明: 把字符串轉為十六進制顯示
'參數(shù): 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 + -