sakashan wrote:
不然我丟個C++ 的書給你寫個麻將程式
寫得出來有鬼阿......(恕刪)
嘿嘿...你丟書給我..我也不會去看啦...
我怎可能傻傻的去看書哩.....
我一定會直接找現成的程式源碼......直接看並改成你要的比較快
ashyong wrote:
rs485只是工業其中一種通訊協定，但只規定硬體部分(使用差動訊號)，而軟體部分通訊封包沒特別規範通訊協定，由使用者自己制定協定所以沒得抄。...(恕刪)
他有提到三菱PLC啦...
三菱PLC有自己的協定....好像不同機型,有不同的協定...
可惜我沒有研究PLC.....
以前是有不小心抓過一些三菱PLC PC端的程式...但都沒研究.....不過不管要轉成MCU程式或是其他應用...演算法應該都雷同可用...可以照抄一下...只是程式語法不同要小改罷了....雖我程式也都不會或不熟,但都照其流程抄下去...有時VB成C...有時反過來....一般都不會遇到什麼問題....
下面是三菱Fx系列PLC通訊程式..
Option Explicit
Dim LoadComm As Boolean
Dim WritData As String
Dim Remainder As Integer
Dim GetData As String
Dim ComErr As Boolean
Dim TimOut As Boolean
Dim NotTimOut As Boolean
Dim K As Integer
Dim SenData As String
Private Sub Address_1_KeyPress(KeyAscii As Integer) '數字輸入.!
If Not ((KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 46 Or KeyAscii = 8) Then
KeyAscii = 0
End If
End Sub
Private Sub Address_2_KeyPress(KeyAscii As Integer) '數字輸入.!
If Not ((KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 46 Or KeyAscii = 8) Then
KeyAscii = 0
End If
End Sub
Private Sub ClsD_Click()
WRData.Text = 0
Call WriteD_Click
End Sub
Private Sub COMM_Change()
If LoadComm = False Then Exit Sub
Call LoadCom(Val(COMM.ListIndex + 1))
End Sub
Private Sub Comp_2_Change()
CxZt.Visible = False
End Sub
Private Sub Form_Load()
'=========================================
Dim i As Byte, X As Byte
For i = 1 To 10
'========================================= '加載串口號到列表
COMM.AddItem "COM" & i, i
OutTim.AddItem Str(i), i
'=========================================
Next i
OutTim.ListIndex = 0
'=========================================
LoadComm = True '加載完畢.!
COMM.ListIndex = 0
Hexad.AddItem "十進制"
Hexad.AddItem "十六進制"
Hexad.ListIndex = 0
Dbits.AddItem "16"
Dbits.AddItem "32"
Dbits.ListIndex = 0
Comp_1.AddItem "D(寄存器)"
Comp_1.AddItem "T(計時器)"
Comp_1.AddItem "C(計數器)"
Comp_1.ListIndex = 0
Comp_2.AddItem "Y"
Comp_2.AddItem "X"
Comp_2.AddItem "C"
Comp_2.AddItem "T"
Comp_2.AddItem "M"
Comp_2.AddItem "S"
Comp_2.ListIndex = 0
TmrCom.Interval = (OutTim.ListIndex + 1) * 1000 '通訊超時時間.!
'=========================================
End Sub
Private Sub FxCom_OnComm()
Dim GetData As String
Dim Data_1 As String, Data_2 As String
Dim Tim_1 As String, Tim_2 As String, Tim_3 As String, Tim_4 As String, Tim_5 As String, Tim_6 As String, Tim_7 As String, Tim_8 As String
Dim Median As Long, Binary As String, Signs As Boolean, i As Byte, Data As String
If FxCom.CommEvent = comEvReceive Then
TmrCom.Enabled = False
GetData = FxCom.Input
Tx.Caption = "通訊正常.!"
If NotTimOut = True And TimOut = False Then
If GetData = Chr(15) Then
MsgBox "指令錯誤,不能執行操作.!", vbExclamation, "System:"
NotTimOut = False
TimRw.Enabled = True
End If
Select Case WritData
Case "寄存器"
If Dbits.Text = "16" Then '16位讀
GetData = Mid(GetData, 2, 4) '讀回來的數據的順序是先低位後高位
GetData = Right(GetData, 2) & Left(GetData, 2)
If Hexad.Text = "十六進制" Then '如果是以十進制格式讀取數據
WRData.Text = (Right(Hex(Val("&H" + GetData)), 4)) '&H表示括號內為十六進制數據
'MsgBox WRData.Text
Else
GetData = Val("&H" + GetData)
'MsgBox Val("&H" + GetData)
WRData.Text = CStr(GetData)
End If
'DoEvents '轉交系統控制權.!
Else '32位讀
GetData = Mid(GetData, 2, 8) '讀回來的數據的順序是先低位後高位
Data_1 = Right(Right(GetData, 4), 2) & Left(Right(GetData, 4), 2)
Data_2 = Right(Left(GetData, 4), 2) & Left(Left(GetData, 4), 2)
GetData = "&H" & Data_1 & Data_2
If Hexad.Text = "十六進制" Then '如果是以十進制格式讀取數據
WRData.Text = Hex(Val(GetData))
Else
GetData = Val(GetData)
WRData.Text = CStr(GetData)
End If
End If
Case "時間"
Tim_1 = Hex2Dec(Mid(GetData, 2, 2))
Tim_2 = Hex2Dec(Mid(GetData, 5, 3))
Tim_3 = Hex2Dec(Mid(GetData, 8, 4))
Tim_4 = Hex2Dec(Mid(GetData, 12, 4))
Tim_5 = Hex2Dec(Mid(GetData, 16, 4))
Tim_6 = Hex2Dec(Mid(GetData, 20, 4))
Timer.Text = Tim_6 & "年" & Tim_5 & "月" & Tim_4 & "日" & Tim_3 & ":" & Tim_2 & ":" & Tim_1
Case "查詢"
Median = Val("&H" + Mid(GetData, 2, 2))
Binary = dectoBin(Median)
Binary = StrReverse(Binary)
If Mid(Binary, Remainder + 1, 1) = 1 Then
CxZt.Visible = True
Else
CxZt.Visible = False
End If
Case "讀密碼"
GetData = Mid(GetData, 2, 16)
Tim_1 = GetPws(Mid(GetData, 1, 2))
Tim_2 = GetPws(Mid(GetData, 3, 2))
Tim_3 = GetPws(Mid(GetData, 5, 2))
Tim_4 = GetPws(Mid(GetData, 7, 2))
Tim_5 = GetPws(Mid(GetData, 9, 2))
Tim_6 = GetPws(Mid(GetData, 11, 2))
Tim_7 = GetPws(Mid(GetData, 13, 2))
Tim_8 = GetPws(Mid(GetData, 15, 2))
If Val(Tim_1 & Tim_2 & Tim_3 & Tim_4 & Tim_5 & Tim_6 & Tim_7 & Tim_8) = 0 Then
Pws.Text = "未設置密碼"
Else
Pws.Text = Tim_1 & Tim_2 & Tim_3 & Tim_4 & Tim_5 & Tim_6 & Tim_7 & Tim_8
End If
Case "清密碼"
If GetData = Chr(6) Then
MsgBox "清除成功 ", vbExclamation, "系統提示.!"
Pws.Text = "密碼被清除.!"
Else
MsgBox "清除失敗 ", vbExclamation, "系統提示.!"
End If
Case "設密碼"
If GetData = Chr(6) Then
MsgBox "設置成功 ", vbExclamation, "系統提示.!"
Else
MsgBox "設置失敗 ", vbExclamation, "系統提示.!"
End If
Case Else
End Select
NotTimOut = False
TimRw.Enabled = True
Else
Dim Add(3) As Long, bits(3) As String
GetData = Mid(CleanStr(GetData), 2, 8) '根據協議,取出左起第二位開始的八位是需要的數據
Add(0) = Val("&H" & Mid(GetData, 1, 2)) '低位寄存器的低八位,並轉換為十進制
Add(1) = Val("&H" & Mid(GetData, 3, 2)) '低位寄存器的高八位,並轉換為十進制
Add(2) = Val("&H" & Mid(GetData, 5, 2)) '高位寄存器的低八位,並轉換為十進制
Add(3) = Val("&H" & Mid(GetData, 7, 2)) '高位寄存器的高八位,並轉換為十進制
For i = 0 To 3
bits(i) = dectoBin(Add(i)) '將讀取的數據轉換成二進制
Next i
Data = bits(3) & bits(2) & bits(1) & bits(0)
Data = StrReverse(Data)
For i = 1 To 32
If Mid(Data, i, 1) = 1 Then
If K = 0 Then
X(i - 1).BackColor = &HFF&
Else
Y(i - 1).BackColor = &HFF&
K = -1
End If
Else
If K = 0 Then
X(i - 1).BackColor = &HC0C0C0
Else
Y(i - 1).BackColor = &HC0C0C0
K = -1
End If
End If
Next i
K = K + 1
TimOut = False '實時監控通訊處理完畢
TimRw.Enabled = True
End If
End If
End Sub
Private Function GetPws(Pws As String) As String '密碼換算函數.!
If Mid(Pws, 1, 1) = 3 Then
GetPws = Mid(Pws, 2, 1)
ElseIf Mid(Pws, 1, 1) = 4 Then
Select Case Mid(Pws, 2, 1)
Case "1"
GetPws = "A"
Case "2"
GetPws = "B"
Case "3"
GetPws = "C"
Case "4"
GetPws = "D"
Case "5"
GetPws = "E"
Case "6"
GetPws = "F"
End Select
End If
End Function
Private Sub Pws_Click()
If Pws.Text = "未設置密碼" Or Pws.Text = "密碼被清除.!" Then Pws.Text = ""
End Sub
Private Sub Pws_KeyPress(KeyAscii As Integer)
If Not ((KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 46 Or KeyAscii = 8) Then
KeyAscii = 0
End If
End Sub
Private Sub Read_Click()
If ComErr = True Then
Tx.Caption = "通訊錯誤.無效端口.!"
Exit Sub
End If
If Address_1.Text = Empty Then Exit Sub
NotTimOut = True
Dim Address As String
WritData = "寄存器"
Select Case Comp_1.Text '元件標誌
Case "D(寄存器)"
If Val(Address_1) > 999 Then
MsgBox "元件號超限 ", vbCritical, "System:"
Address_1.Text = ""
Address_1.SetFocus
Exit Sub
Else
Address = Hex(Address_1.Text * 2 + 4096) ''轉換為16進制,(寄存器地址?算方法(ADDRESS=ADDRESS*2+1000H))
If Dbits.Text = 16 Then
Address = "0" + Address + "02" + Chr(3) '16位數據.!
Else
Address = "0" + Address + "04" + Chr(3) '32位數據
End If
End If
Case "T(計時器)" '計數器查詢.!
If Val(Address_1.Text) > 127 Then
MsgBox "元件號超限 ", vbCritical, "System:"
Address_1.Text = ""
Address_1.SetFocus
Exit Sub
Else
Address = "0" + Hex(Address_1.Text * 2 + 2048) '轉換為16進制,(寄存器地址?算方法(ADDRESS=ADDRESS*2+800H))
If Dbits.Text = 16 Then
Address = "0" + Address + "02" + Chr(3) '16位數據.!
Else
Address = "0" + Address + "04" + Chr(3) '32位數據
End If
End If
Case "C(計數器)"
If Val(Address_1.Text) > 127 Then
MsgBox "元件號超限 ", vbCritical, "System:"
Address_1.Text = ""
Address_1.SetFocus
Exit Sub
Else
Address = "0" + Hex(Address_1.Text * 2 + 2560) '轉換為16進制,(寄存器地址?算方法(ADDRESS=ADDRESS*2+800H))
If Dbits.Text = 16 Then
Address = "0" + Address + "02" + Chr(3) '16位數據.!
Else
Address = "0" + Address + "04" + Chr(3) '32位數據
End If
Address = Chr(2) & Address & SumChk(Address)
End If
End Select
SenData = Chr(2) & Address & SumChk(Address)
End Sub
Private Sub SET_Click()
If ComErr = True Then
Tx.Caption = "通訊錯誤.無效端口.!"
Exit Sub
End If
If Restrictions(Comp_2.Text, Address_2.Text) = True Then Exit Sub
If Address_2.Text = "" Then Address_2.SetFocus: Exit Sub
If InStr(Address_2.Text, 8) <> 0 Or InStr(Address_2.Text, 9) <> 0 Then
MsgBox "元件號錯誤.!", vbCritical, "系統提示："
Address_2.Text = Empty
Exit Sub
End If
Dim Address As String, Address_M As String
Select Case Comp_2.Text '元件標誌
Case "M"
Address_M = M_Address(Address_2.Text)
Case "T"
Address_M = T_Address(Address_2.Text)
Case "C"
Address_M = C_Address(Address_2.Text)
Case "Y"
Address_M = Y_Address(Address_2.Text)
Case "S"
Address_M = S_Address(Address_2.Text)
Case "X"
Address_M = X_Address(Address_2.Text)
Case Else
Exit Sub
End Select
If Restrictions(Comp_2.Text, Address_2.Text) = False Then
NotTimOut = True
WritData = "置位"
Address = "7" & Address_M & Chr(3)
SenData = Chr(2) & Address & SumChk(Address)
End If
End Sub
Public Function Restrictions(Address As String, Data As Long) As Boolean
'判斷元件地址是否超出.!Select Case Address '元件標誌
If Address = Empty Or Data = Empty Then Exit Function
Select Case Address '元件標誌
Case "M"
If Val(Data) > 1023 Then
Restrictions = True
Exit Function
Else
Restrictions = False
End If
Case "T"
If Val(Data) > 255 Then
Restrictions = True
Exit Function
Else
Restrictions = False
End If
Case "C"
If Val(Data) > 255 Then
Restrictions = True
Exit Function
Else
Restrictions = False
End If
Case "Y"
If Val(Data) > 177 Then
Restrictions = True
Exit Function
Else
Restrictions = False
End If
Case "S"
If Val(Data) > 999 Then
Restrictions = True
Exit Function
Else
Restrictions = False
End If
Case "X"
If Val(Data) > 177 Then
Restrictions = True
Exit Function
Else
Restrictions = False
End If
Case Else
Restrictions = False
Exit Function
End Select
End Function
'======================================================
'內部元件地址計算.!
Private Function M_Address(Dats As String) As String 'M地址計算，地址範圍是0800__0BFF,地址順序是先低位後高位
Dim Address1 As String, Address2 As String, Address3 As String, Address4 As String, Devadd As String
If Val(Dats) < 256 Then
M_Address = Right(("00" + Hex(Dats)), 2) & "08"
Else
M_Address = Right(Hex(Dats), 2) & "0" & Hex(Left(Hex(Dats), 1) + 8)
End If
End Function
Private Function T_Address(Dats As String) As String 'T地址計算，地址範圍是0600__06FF,地址順序是先低位後高位（1284）
T_Address = Right("00" & Hex(Dats), 2) & "06" 'T的地址
End Function
Private Function C_Address(Dats As String) As String 'C地址計算，地址範圍是0E00__0EFF,地址順序是先低位後高位（1284）
C_Address = Right("00" & Hex(Dats), 2) & "0E" 'C的地址
End Function
Private Function Y_Address(Dats As String) As String 'Y地址計算，地址範圍是0500__057F,地址順序是先低位後高位（1284）
Y_Address = Right("00" & Hex("&o" & Dats), 2) & "05" 'Y的地址
End Function
Private Function X_Address(Dats As String) As String 'X地址計算，地址範圍是0400__047F,地址順序是先低位後高位（1284）
X_Address = Right("00" & Hex("&o" & Dats), 2) & "04" 'Y的地址
End Function
Private Function S_Address(Dats As String) As String 'S地址計算，地址範圍是0000__03E7,地址順序是先低位後高位（1284）
If Val(Dats) > 255 Then
S_Address = "0" + Left(Hex(Dats), 1) & Right(Hex(Dats), 2) 'S的地址
Else
If Val(Dats) > 15 Then
S_Address = Hex(Dats) & "00"
Else
S_Address = "0" & Hex(Dats) & "00"
End If
End If
End Function
'=======================================================
Private Sub RST_Click()
If ComErr = True Then
Tx.Caption = "通訊錯誤.無效端口.!"
Exit Sub
End If
If Address_2.Text = "" Then Address_2.SetFocus: Exit Sub
If Right(Address_2.Text, 1) = 8 Or Right(Address_2.Text, 1) = 9 Then
MsgBox "元件號錯誤.!", vbCritical, "系統提示："
Address_2.Text = Empty
Address_2.SetFocus
Exit Sub
End If
Dim Address As String, Address_M As String
Select Case Comp_2.Text '元件標誌
Case "M"
Address_M = M_Address(Address_2.Text)
Case "T"
Address_M = T_Address(Address_2.Text)
Case "C"
Address_M = C_Address(Address_2.Text)
Case "Y"
Address_M = Y_Address(Address_2.Text)
Case "S"
Address_M = S_Address(Address_2.Text)
Case "X"
Address_M = X_Address(Address_2.Text)
Case Else
Exit Sub
End Select
If Restrictions(Comp_2.Text, Address_2.Text) = False Then
NotTimOut = True
WritData = "復位"
Address = "8" & Address_M & Chr(3)
SenData = Chr(2) & Address & SumChk(Address)
End If
End Sub
Private Function SumChk(Dats$) As String
'效驗.!
Dim i&
Dim CHK&
For i = 1 To Len(Dats)
CHK = CHK + Asc(Mid(Dats, i, 1))
Next i
'SumChk = Right(Hex$(CHK + 3), 2)
SumChk = Right(Hex$(CHK), 2)
End Function
Private Sub TimRw_Timer()
If ComErr = True Then
Tx.Caption = "通訊錯誤.無效端口.!"
Exit Sub
End If
If NotTimOut = True And TimOut = False Then
Select Case WritData
Case "寄存器" ', "查詢"
If Dbits.Text = "16" Then '16位
FxCom.RThreshold = 8 '設定產生OnComm事件的接收緩衝區字符數
Else
FxCom.RThreshold = 12 '設定產生OnComm事件的接收緩衝區字符數
End If
Case "寫", "置位", "復位", "設密碼", "停止", "運行", "清密碼"
FxCom.RThreshold = 1 '設定產生OnComm事件的接收緩衝區字符數
Case "讀密碼"
FxCom.RThreshold = 20
Case "時間"
FxCom.RThreshold = 31
Case "查詢"
FxCom.RThreshold = 8 '設定產生OnComm事件的接收緩衝區字符數
End Select
Else
FxCom.RThreshold = 12 '設定產生OnComm事件的接收緩衝區字符數
TimOut = True
If K = 0 Then ' 實時監控共需要二次才能完成一個實時監控通訊循環，每次K+1來判斷應該發送第幾次命令
SenData = "0008004" + Chr(3) '讀輸入(X)位狀態的命令字符
SenData = Chr(2) & SenData & SumChk(SenData)
ElseIf K = 1 Then
SenData = "000A004" + Chr(3) '讀輸出(Y)位狀態的命令字符
SenData = Chr(2) & SenData & SumChk(SenData)
End If
End If
FxCom.InBufferCount = 0
FxCom.OutBufferCount = 0
FxCom.Output = SenData
TimRw.Enabled = False
TmrCom.Enabled = True
End Sub
Function CleanStr(TextLine As String) As String
Dim i As Integer, RtnStr As String
RtnStr = ""
For i = 1 To Len(TextLine)
Select Case Asc(Mid$(TextLine, i, 1))
Case &H5D
RtnStr = RtnStr & "<ACK>"
Case &H5B
RtnStr = RtnStr & "<NAK>"
Case Is >= &H30
RtnStr = RtnStr & Mid$(TextLine, i, 1)
Case 13
RtnStr = RtnStr & "<CR>"
Case 10
RtnStr = RtnStr & "<LF>"
Case Else
RtnStr = RtnStr & "."
End Select
Next i
CleanStr = RtnStr
End Function
Private Sub TmrCom_Timer()
If ComErr = True Then
Tx.Caption = "通訊錯誤.無效端口.!"
Exit Sub
End If
Tx.Caption = "實時監控通訊錯誤.!" '通訊狀態指示
TimRw.Enabled = True '打開定時通訊掃瞄
End Sub
Private Sub WRData_KeyPress(KeyAscii As Integer)
If Hexad.Text = "十六進制" Then
If KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii >= Asc("A") And KeyAscii <= Asc("F") Or KeyAscii >= Asc("a") And KeyAscii <= Asc("f") Or KeyAscii = 8 Then
Else
KeyAscii = 0
End If
Else
If Not ((KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 46 Or KeyAscii = 8) Then
KeyAscii = 0
End If
End If
End Sub
Private Sub WriteD_Click()
If ComErr = True Then
Tx.Caption = "通訊錯誤.無效端口.!"
Exit Sub
End If
Dim Data_1 As String, Data_2 As String, Data_3 As String, Data_4 As String, Address As String
If Address_1.Text = Empty Then Exit Sub
NotTimOut = True
WritData = "寫"
Select Case Comp_1.Text '元件標誌
Case "D(寄存器)"
If Val(Address_1) > 999 Then
MsgBox ("元件號超限"), vbCritical, "系統提示.!"
Address_1.Text = ""
Address_1.SetFocus
Exit Sub
End If
If Dbits.Text = 16 Then
Address = "1" & Hex(Val(Address_1.Text) * 2 + 4096) & "02"
Else
Address = "1" & Hex(Val(Address_1.Text) * 2 + 4096) & "04"
End If
Case "T(計時器)" '計數器查詢.!
If Val(Address_1.Text) > 127 Then
Address_1.Text = ""
Address_1.SetFocus
Exit Sub
End If
If Dbits.Text = 16 Then
Address = "1" & ("0" & Hex(Val(Address_1.Text) * 2 + 2048)) & "02"
Else
Address = "1" & ("0" & Hex(Val(Address_1.Text) * 2 + 2048)) & "04"
End If
Case "C(計數器)"
If Val(Address_1.Text) > 127 Then
Address_1.Text = ""
Address_1.SetFocus
Exit Sub
End If
If Dbits.Text = 16 Then
Address = "1" & "0" & Hex(Val(Address_1.Text) * 2 + 2560) & "02"
Else
Address = "1" & "0" & Hex(Val(Address_1.Text) * 2 + 2560) & "04"
End If
Case Else
Exit Sub
End Select
If Hexad.Text = "十進制" Then '十進制方式
If Dbits.Text = 32 Then '雙字節D寫入
If CDbl(Val(WRData.Text)) > 2147483648# Then MsgBox "數值超限 ", vbCritical, "系統提示.!": Exit Sub
Data_1 = Right(("00000000" & Hex(Val(WRData.Text))), 8) '數據的寫入與讀出的格式為先低位後高位，如：D0的低八位，D0的高八位，D1的低八位，D1的高八位
Data_2 = Right(Right(Data_1, 4), 2) & Left(Right(Data_1, 4), 2)
Data_3 = Right(Left(Data_1, 4), 2) & Left(Left(Data_1, 4), 2)
Data_4 = Data_2 & Data_3
SenData = Address & Data_4 & Chr(3)
SenData = Chr(2) & SenData & SumChk(SenData)
Else
If CDbl(Val(WRData.Text)) > 32767 Then MsgBox "數值超限 ", vbCritical, "系統提示.!": Exit Sub
Data_1 = Right("00000000" & Hex(Val(WRData.Text)), 4) '數據的寫入與讀出的格式為先低位後高位，如：D0的低八位，D0的高八位
Data_1 = Right(Data_1, 2) & Left(Data_1, 2)
SenData = Address & Data_1 & Chr(3) '地址&數字
SenData = Chr(2) & SenData & SumChk(SenData)
End If
Else '十六進制方式
If Dbits.Text = 32 Then '雙字節D寫入
If Val("&H" & WRData.Text) > 2147483648# Then MsgBox "數值超限 ", vbCritical, "系統提示.!": Exit Sub
Data_1 = Right("00000000" & WRData.Text, 8)
Data_2 = Right(Right(Data_1, 4), 2) & Left(Right(Data_1, 4), 2)
Data_3 = Right(Left(Data_1, 4), 2) & Left(Left(Data_1, 4), 2)
Data_4 = Data_2 & Data_3
SenData = Address & Data_4 & Chr(3)
SenData = Chr(2) & SenData & SumChk(SenData)
Else
If Val("&H" & WRData.Text) > 32767 Then MsgBox "數值超限 ", vbCritical, "系統提示.!": Exit Sub
Data_1 = Right("00000000" & WRData.Text, 4)
Data_1 = Right(Data_1, 2) & Left(Data_1, 2)
SenData = Address & Data_1 & Chr(3) '地址&數字
SenData = Chr(2) & SenData & SumChk(SenData)
End If
End If
End Sub
Private Sub XPButton10_Click()
If ComErr = True Then
Tx.Caption = "通訊錯誤.無效端口.!"
Exit Sub
End If
Dim Paws As String, i As Byte, MidPws As Byte
'E118008083132333435363738
If Len(Pws.Text) = 0 Or Pws.Text = "未設置密碼" Or Pws.Text = "密碼被清除.!" Then
MsgBox "請輸入密碼.! ", vbCritical, "系統提示.!"
Pws.Text = ""
Pws.SetFocus
Exit Sub
End If
NotTimOut = True
WritData = "設密碼"
For i = 1 To 8
If Mid(Pws.Text, i, 1) = Empty Then
MidPws = 0
Else
MidPws = Mid(Pws.Text, i, 1)
End If
Paws = Paws & "3" & MidPws
Next i
'FxCom.RThreshold = 1
SenData = "E11800808" & Paws & Chr(3) '地址&數字
SenData = Chr(2) & SenData & SumChk(SenData)
End Sub
Private Sub XPButton11_Click()
If ComErr = True Then
Tx.Caption = "通訊錯誤.無效端口.!"
Exit Sub
End If
'E01800808
'FxCom.RThreshold = 20
NotTimOut = True
WritData = "讀密碼"
SenData = "E01800808" & Chr(3) '地址&數字
SenData = Chr(2) & SenData & SumChk(SenData)
End Sub
Private Sub XPButton12_Click()
If ComErr = True Then
Tx.Caption = "通訊錯誤.無效端口.!"
Exit Sub
End If
'E118008082020202020202020
NotTimOut = True
WritData = "清密碼"
SenData = "E118008082020202020202020" & Chr(3) '地址&數字
SenData = Chr(2) & SenData & SumChk(SenData)
End Sub
Private Sub XPButton5_Click()
If ComErr = True Then
Tx.Caption = "通訊錯誤.無效端口.!"
Exit Sub
End If
If Address_2.Text = "" Then Address_2.SetFocus: Exit Sub
If InStr(Address_2.Text, 8) <> 0 Or InStr(Address_2.Text, 9) <> 0 Then
MsgBox "元件號錯誤.!", vbCritical, "系統提示:"
Address_2.Text = Empty
Address_2.SetFocus
Exit Sub
End If
Dim Address As String
If Comp_2.Text = "X" Or Comp_2.Text = "Y" Then
Remainder = Address_2.Text Mod 10
Else
Remainder = Address_2.Text Mod 8
End If
Select Case Comp_2.Text '元件標誌
Case "S"
If Restrictions("S", Address_2.Text) = False Then
If Address_2.Text < 128 Then
Address = "0" + "000" + Hex(Address_2.Text \ 8) + "02" + Chr(3)
Else
Address = "0" + "00" + Hex(Address_2.Text \ 8) + "02" + Chr(3)
End If
Else
MsgBox "元件值超限.! ", vbCritical, "系統提示.!"
End If
Case "X"
If Restrictions("X", Address_2.Text) = False Then
If Oct(Val("&o" + Address_2.Text)) <> Address_2.Text Then '判斷是不是八進制。
Exit Sub
End If
Address = Val(Str(Address_2.Text \ 10))
Address = "0" + "008" + Hex("&o" + Address) + "02" + Chr(3)
Else
MsgBox "元件值超限.! ", vbCritical, "系統提示.!"
End If
Case "C"
If Restrictions("C", Address_2.Text) = False Then
If Address_2.Text < 128 Then
Address = "0" + "01C" + Hex(Address_2.Text \ 8) + "02" + Chr(3)
Else
Address = "0" + "01D" + Hex((Address_2.Text - 128) \ 8) + "02" + Chr(3)
End If
Else
MsgBox "元件值超限.! ", vbCritical, "系統提示.!"
End If
Case "Y"
If Restrictions("Y", Address_2.Text) = False Then
If Oct(Val("&o" + Address_2.Text)) <> Address_2.Text Then '判斷是不是八進制。
Exit Sub
End If
Address = Val(Str(Address_2.Text \ 10))
Address = "0" + "00A" + Hex("&o" + Address) + "02" + Chr(3)
Else
MsgBox "元件值超限.! ", vbCritical, "系統提示.!"
End If
Case "M"
If Restrictions("M", Address_2.Text) = False Then
If Address_2.Text < 128 Then
Address = "0" + "010" + Hex(Address_2.Text \ 8) + "02" + Chr(3)
Else
Address = "0" + "01" + Hex(Address_2.Text \ 8) + "02" + Chr(3)
End If
Else
MsgBox "元件值超限.! ", vbCritical, "系統提示.!"
End If
Case "T"
If Restrictions("T", Address_2.Text) = False Then
If Address_2.Text < 128 Then
Address = "0" + "00C" + Hex(Address_2.Text \ 8) + "02" + Chr(3)
Else
Address = "0" + "00D" + Hex((Address_2.Text - 128) \ 8) + "02" + Chr(3)
End If
Else
MsgBox "元件值超限.! ", vbCritical, "系統提示.!"
End If
Case Else
Exit Sub
End Select
NotTimOut = True
WritData = "查詢"
SenData = Chr(2) & Address & SumChk(Address)
End Sub
Private Sub XPButton6_Click()
If ComErr = True Then
Tx.Caption = "通訊錯誤.無效端口.!"
Exit Sub
End If
NotTimOut = True
WritData = "停止"
SenData = Chr(2) & "7250F" & Chr(3) & SumChk("7250F" & Chr(3))
End Sub
Private Sub XPButton7_Click()
If ComErr = True Then
Tx.Caption = "通訊錯誤.無效端口.!"
Exit Sub
End If
NotTimOut = True
WritData = "運行"
SenData = Chr(2) & "8250F" & Chr(3) & SumChk("8250F" & Chr(3))
End Sub
Private Sub XPButton8_Click()
'00E1A0E
If ComErr = True Then
Tx.Caption = "通訊錯誤.無效端口.!"
Exit Sub
End If
NotTimOut = True
WritData = "時間"
SenData = Chr(2) & "00E1A0E" & Chr(3) & SumChk("00E1A0E" & Chr(3))
End Sub
Function dectoBin(i As Long) As String '10在轉2進制
Const Bins = "0000000100100011010001010110011110001001101010111100110111101111"
Dim K As Integer, s As String, Y As String
Y = Hex(i)
s = ""
For K = 1 To Len(Y)
s = s + Mid(Bins, (Val("&h" + Mid(Y, K, 1)) * 4 + 1), 4)
Next
dectoBin = Format(s, "00000000")
End Function
Private Sub LoadCom(Port As Byte)
On Error GoTo Err '此處作用：如果您選擇了電腦中不存在的通訊口，則提示「無效的通訊口」
If FxCom.PortOpen = True Then FxCom.PortOpen = False '如果通訊口已打開，則先關閉通訊口。開始通訊口設置工作
Dim i As Byte
For i = 0 To 31
X(i).BackColor = &HC0C0C0 'X的狀態
Y(i).BackColor = &HC0C0C0 'Y的狀態
Next i
FxCom.CommPort = Port '通信口
FxCom.Settings = "9600,E,7,1" '固定值即可,偶校驗
FxCom.InputLen = 0 '設置和返回input每次讀出的字節數,設為0時讀出接收緩衝區中的所有內容
FxCom.OutBufferCount = 0 '設置和返回發送緩衝區的字節數,設為0時清空發送緩衝區
FxCom.InBufferCount = 0 '設置和返回接收緩衝區的字節數,設為0時清空接收緩衝區
FxCom.PortOpen = True '打開通訊口
ComErr = False
Tx.Caption = "通訊正常.!"
NotTimOut = False
TmrCom.Enabled = False
TimRw.Enabled = False
Exit Sub
Err:
MsgBox Err.Description, vbCritical, "系統提示.!" '錯誤提示
Tx.Caption = Err.Description
ComErr = True
End Sub
Private Function Hex2Dec(InputData As String) As Double '16進制轉10進制
Dim i As Integer
Dim DecOut As Double
Dim Lenhex As Integer
Dim HexStep As Double
DecOut = 0
InputData = UCase(InputData)
Lenhex = Len(InputData)
For i = 1 To Lenhex
If IsNumeric(Mid(InputData, i, 1)) Then
GoTo NumOk
ElseIf Mid(InputData, i, 1) = "A" Then
GoTo NumOk
ElseIf Mid(InputData, i, 1) = "B" Then
GoTo NumOk
ElseIf Mid(InputData, i, 1) = "C" Then
GoTo NumOk
ElseIf Mid(InputData, i, 1) = "D" Then
GoTo NumOk
ElseIf Mid(InputData, i, 1) = "E" Then
GoTo NumOk
ElseIf Mid(InputData, i, 1) = "F" Then
GoTo NumOk
Else
Exit Function
End If
NumOk:
Next i
HexStep = 0
For i = Lenhex To 1 Step -1
HexStep = HexStep * 16
If HexStep = 0 Then
HexStep = 1
End If
If Mid(InputData, i, 1) = "0" Then
DecOut = DecOut + (0 * HexStep)
ElseIf Mid(InputData, i, 1) = "1" Then
DecOut = DecOut + (1 * HexStep)
ElseIf Mid(InputData, i, 1) = "2" Then
DecOut = DecOut + (2 * HexStep)
ElseIf Mid(InputData, i, 1) = "3" Then
DecOut = DecOut + (3 * HexStep)
ElseIf Mid(InputData, i, 1) = "4" Then
DecOut = DecOut + (4 * HexStep)
ElseIf Mid(InputData, i, 1) = "5" Then
DecOut = DecOut + (5 * HexStep)
ElseIf Mid(InputData, i, 1) = "6" Then
DecOut = DecOut + (6 * HexStep)
ElseIf Mid(InputData, i, 1) = "7" Then
DecOut = DecOut + (7 * HexStep)
ElseIf Mid(InputData, i, 1) = "8" Then
DecOut = DecOut + (8 * HexStep)
ElseIf Mid(InputData, i, 1) = "9" Then
DecOut = DecOut + (9 * HexStep)
ElseIf Mid(InputData, i, 1) = "A" Then
DecOut = DecOut + (10 * HexStep)
ElseIf Mid(InputData, i, 1) = "B" Then
DecOut = DecOut + (11 * HexStep)
ElseIf Mid(InputData, i, 1) = "C" Then
DecOut = DecOut + (12 * HexStep)
ElseIf Mid(InputData, i, 1) = "D" Then
DecOut = DecOut + (13 * HexStep)
ElseIf Mid(InputData, i, 1) = "E" Then
DecOut = DecOut + (14 * HexStep)
ElseIf Mid(InputData, i, 1) = "F" Then
DecOut = DecOut + (15 * HexStep)
Else
End If
Next i
Hex2Dec = DecOut
eds:
End Function
內文搜尋
從 APP 打開
X