Hỏi về Giao tiếp máy tính với PLC và VXL qua cổng Com bằng Visual Basic 6.0 ?
Tôi thử viết chương trình giao tiếp máy tính với VXL và PLC qua cổng Com bằng Visual Basic 6.0 nhưng chưa có dịp kiểm nghiệm lại. Ai biết giúp mình với
loc minh tung
Trả lời 15 năm trước
Mình Post Source lên để các bạn tham khảo nha!
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim DatanhanText As String
Private Sub MnuHuongDan_Click()
Datanhan.Text = "Ñaây laø chöông trình xuaát nhaäp Port Serial ñeå truyeàn döõ lieäu xuoáng Vi Xöû Lí hoaëc PLC.Tröôùc tieân caùc baïn choïn Port caàn truyeàn vaø nhaän (Ví duï nhö coång COM1, COM2, ...). Sau ñoù choïn caùc thoâng soá truyeàn nhaän (Toác ñoä Baud, Soá Bits döõ lieäu, Soá bit Stop, Bit kieåm tra loãi Parity, Thôøi gian thöïc hieän). Roài Click vaøo môû Port. Cuoái cuøng laø nhaäp döõ lieäu caàn truyeàn roài Enter ñeå truyeàn. Chuùc caùc baïn thaønh coâng!"
End Sub
Private Sub MnuKiemTra_Click()
Datanhan.Text = "Baïn muoán kieåm tra xem döõ lieäu coù xuaát ra vaø nhaän vaøo ñöôïc hay khoâng thì khi truyeàn haõy noái taét hai chaân TxD vaø RxD cuûa coång COM. Neáu döõ lieäu nhaän vaøo gioáng nhö döõ lieäu xuaát ra thì xem nhö chöông trình ñaõ truyeàn nhaän toát. Ngoaøi ra chöông trình coøn cho pheùp keát noái 2 maùy tính vôùi nhau. "
End Sub
Private Sub MnuLienHe_Click()
Datanhan.Text = "Caùc baïn coù vaán ñeà gì xin lieân laïc vôùi mình qua Email: thachbangtam@yahoo.com hoaëc hoangquocthanh@yahoo.com. HandPhone: 0918473304 (Thanh). Raát mong söï ñoùng goùp yù kieán cuûa caùc baïn! Hoaøng Quoác Thanh"
End Sub
Private Sub Nutxoa_Click()
Datanhan.Text = ""
End Sub
Private Sub DongPort_Click()
If MSComm1.PortOpen Then
MSComm1.PortOpen = False
DongPort.Enabled = False
MoPort.Enabled = True
Chonlua (True)
End If
End Sub
Private Sub Chonlua(state As Boolean)
ChonPort.Enabled = state
ChonBaud.Enabled = state
ChonsobitData.Enabled = state
ChonsobitStop.Enabled = state
ChonParity.Enabled = state
timeOutBox.Enabled = state
End Sub
Private Sub Chuoi_KeyPress(EnterAscii As Integer)
Dim rstr As String
If EnterAscii = 13 Then
EnterAscii = 0
rstr = Truyen(Chuoi.Text)
If rstr = "" Then
Beep
Tinhieuphanhoi ("(Khoâng coù döõ lieäu nhaän vaøo)")
Else
Tinhieuphanhoi (rstr)
End If
End If
End Sub
Private Sub Nutthoat_Click()
Call DongPort_Click
End
End Sub
Private Sub Form_Load()
ChonPort.ListIndex = 0
ChonBaud.ListIndex = 1
ChonsobitData.ListIndex = 1
ChonsobitStop.ListIndex = 0
ChonParity.ListIndex = 0
DongPort.Enabled = False
End Sub
Private Sub MoPort_Click()
Dim Dataxuatformat As String
If MSComm1.PortOpen = True Then Exit Sub
Dataxuatformat = ChonBaud.List(ChonBaud.ListIndex) + "," _
+ Mid(ChonParity.List(ChonParity.ListIndex), 1, 1) + "," _
+ ChonsobitData.List(ChonsobitData.ListIndex) + "," _
+ ChonsobitStop.List(ChonsobitStop.ListIndex)
MSComm1.Settings = Dataxuatformat
MSComm1.CommPort = ChonPort.ListIndex + 1
MSComm1.PortOpen = True
Tinhieuphanhoi ("COM" + Str(MSComm1.CommPort) + _
" ñöôïc môû vôùi thoâng soá sau: " + MSComm1.Settings)
MoPort.Enabled = False
DongPort.Enabled = True
Chonlua (False)
End Sub
Private Sub Tinhieuphanhoi(s As String)
Datanhan.Text = Datanhan.Text + s + Chr(13) + Chr(10)
End Sub
Public Function Truyen(cmd As String)
Dim Thoigiantruyennhan As Long
Thoigiantruyennhan = Str(timeOutBox.Text)
If (Thoigiantruyennhan <= 0) Then Thoigiantruyennhan = 1000
Call MoPort_Click
If Mid(cmd, 1, 1) <> "@" Then
MSComm1.Output = Chr(5)
If getCtrlE() = False Then
DatanhanText = ""
Exit Function
End If
End If
MSComm1.Output = cmd + Chr(13)
Call getResponse
Truyen = DatanhanText
End Function
Public Function appendFCS(ID As Integer, cmd As String)
Dim IDString As String
Dim FCSString As String
IDString = Hex(ID)
If Len(IDString) = 1 Then IDString = "0" + IDString
cmd = "@" + IDString + cmd
FCSString = Hex(computeFCS(cmd))
If Len(FCSString) = 1 Then FCSString = "0" + FCSString
cmd = cmd + FCSString + "*"
appendFCS = cmd
End Function
Public Function computeFCS(cmd As String)
Dim result As Integer
Dim length As Integer
Dim I As Integer
length = Len(cmd)
result = Asc(Mid(cmd, 1, 1))
For I = 2 To length
result = result Xor Asc(Mid(cmd, I, 1))
Next
computeFCS = result
End Function
Private Function getCtrlE()
Dim inbuff As String
Dim pcount As Long
Dim ccount As Long
Dim duration As Long
duration = Str(timeOutBox.Text)
If (duration <= 0) Then duration = 1000
pcount = GetTickCount()
Do While True
inbuff = MSComm1.Input
If inbuff = Chr(5) Then
getCtrlE = True
Exit Function
End If
ccount = GetTickCount()
If ccount >= pcount + duration Then Exit Do ' timeout and still did not get complete string
Loop
getCtrlE = False
End Function
Private Sub getResponse()
Static responseBuffer As String
Dim inbuff As String
Dim length As Integer
Dim pcount As Long
Dim ccount As Long
Dim duration As Long
duration = Str(timeOutBox.Text)
If (duration <= 0) Then duration = 500
pcount = GetTickCount()
Do While True
inbuff = MSComm1.Input
If Len(inbuff) > 0 Then
responseBuffer = responseBuffer + inbuff
length = Len(responseBuffer)
If Mid(responseBuffer, length, 1) = Chr(13) Then
DatanhanText = Mid(responseBuffer, 1, length - 1)
responseBuffer = ""
Exit Sub
Else
End If
End If
ccount = GetTickCount()
If ccount >= pcount + duration Then Exit Do
Loop
DatanhanText = ""
End Sub
Private Sub Timer_Timer()
TextTimer.Text = Format(Now, "Long Date") & " " & Format(Now, "Long Time")
End Sub