Tweet
Các sư huynh ơi! Giúp đệ với.Đệ đang có vấn đề với cái đề án môn học ghép nối máy tính của đệ.Yêu cầu của bài là lập trình để truyền kí tự và file text giữa 2 máy tính qua cổng com.Phần truyền kí tự thì đệ đã làm được nhưng còn phần truyền file thì không ổn.
Để kiểm tra thì đệ nối chân 2 và chân 3 của máy mình để truyền nhận thử.Phần truyền kí tự thì đã ok nhưng khi truyền file thì lúc save vào máy rồi mở lại thì file nhận không có dữ liệu.Đệ đã tìm hiểu rùi nhưng vẫn không ra nên phải nhờ các huynh giúp đỡ.Dưới đây đệ xin gửi CODE và cả giao diện để các huynh kiểm tra hộ xem vấn đề sai ở đâu hay thiếu cái gì nữa.Mong các huynh giúp đỡ.
CODE:
Private Sub Command1_Click()
On Error GoTo OpenFalse
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
Exit Sub
OpenFalse:
MsgBox Err.Description & vbLf + vbCr + "Loi, khong the mo cong. Hay dong cac ung dung dang su dung cong COM"
End Sub
Private Sub Command2_Click()
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End
End Sub
Private Sub Command3_Click()
On Error GoTo sendfalse
MSComm1.Output = Trim(Text1.Text)
Text1.Text = ""
Exit Sub
sendfalse:
MsgBox "Loi, Cong COM chua duoc mo"
End Sub
Private Sub Command4_Click()
Text2.Text = ""
End Sub
Private Sub Command5_Click()
Cdlg.DialogTitle = "Send file..."
Cdlg.Filter = "Textfile (*.TXT)|*.txt|All Files (*.*)|*.*"
Cdlg.InitDir = App.Path
Cdlg.FileName = ""
Cdlg.ShowOpen
Text1.Text = Cdlg.FileName
Label1.Caption = Str(Round(FileLen(Text1.Text) / 1024, 2)) + "KB"
Exit Sub
Loi:
Label1.Caption = "0 KB"
Text1.Text = ""
Text2.Text = "Da truyen file qua cong COM1 thanh cong"
' goi ham truyen file
If Cdlg.FileName <> "" Then SendFile (Cdlg.FileName)
End Sub
Private Sub Command6_Click()
FileReceive = FreeFile
ReceiveFlag = True
Timer1.Enabled = False
Do
Cdlg.FileName = ""
Cdlg.ShowSave
If Trim(Cdlg.FileName) = "" Then
MsgBox "File name error!!"
End If
Loop While Trim(Cdlg.FileName) = ""
Text2.Text = Cdlg.FileName
MSComm1.Output = "RECEIVE" + vbCr
Open Trim(Text2.Text) For Output As FileReceive
End Sub
Private Sub Form_Load()
With MSComm1
.Settings = "9600,N,8,1"
.RThreshold = 1 'su kien OnComm xay ra khi bat kì kí tu nào duoc chuyen den bo dem nhan.
.Handshaking = comNone
.SThreshold = 0
.InBufferSize = 1024
.OutBufferSize = 1024
.InputMode = comInputModeText 'quyet dinh dang du lieu nhan duoc la dang text
.InputLen = 0
.CommPort = 1 'thiêt lâp và tra vê tên cua công giao tiêp la cong COM1
End With
End Sub
Private Sub MSComm1_OnComm()
If (MSComm1.CommEvent = comEvReceive) Then
Text2.Text = Text2.Text + MSComm1.Input
End If
End Sub
' ham truyen File
Function SendFile(tmp$)
Dim temp$
Dim hsend, bsize, LF&
' mo file
Open tmp$ For Binary Access Read As #2
' kiem tra kich thuoc Mscomm1 OutBuffer
bsize = MSComm1.OutBufferSize
' kiem tra kich thuoc File
LF& = LOF(2)
' code nay se chia du lieu thanh nhung fan nho(Buffer sized)
' va gui chung di
Do Until EOF(2)
If LF& - Loc(2) <= bsize Then
bsize = LF& - Loc(2) + 1
End If
' tao vung chua du lieu
temp$ = Space$(bsize)
' dat du lieu vao bien Temp$ dang string
Get #2, , temp$
MSComm1.Output = temp$
Do
ret = DoEvents()
' cho den khi buffer trong
Loop Until MSComm1.OutBufferCount = 0
Loop
' dong file
Close #2
End Function
Để kiểm tra thì đệ nối chân 2 và chân 3 của máy mình để truyền nhận thử.Phần truyền kí tự thì đã ok nhưng khi truyền file thì lúc save vào máy rồi mở lại thì file nhận không có dữ liệu.Đệ đã tìm hiểu rùi nhưng vẫn không ra nên phải nhờ các huynh giúp đỡ.Dưới đây đệ xin gửi CODE và cả giao diện để các huynh kiểm tra hộ xem vấn đề sai ở đâu hay thiếu cái gì nữa.Mong các huynh giúp đỡ.
CODE:
Private Sub Command1_Click()
On Error GoTo OpenFalse
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
Exit Sub
OpenFalse:
MsgBox Err.Description & vbLf + vbCr + "Loi, khong the mo cong. Hay dong cac ung dung dang su dung cong COM"
End Sub
Private Sub Command2_Click()
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End
End Sub
Private Sub Command3_Click()
On Error GoTo sendfalse
MSComm1.Output = Trim(Text1.Text)
Text1.Text = ""
Exit Sub
sendfalse:
MsgBox "Loi, Cong COM chua duoc mo"
End Sub
Private Sub Command4_Click()
Text2.Text = ""
End Sub
Private Sub Command5_Click()
Cdlg.DialogTitle = "Send file..."
Cdlg.Filter = "Textfile (*.TXT)|*.txt|All Files (*.*)|*.*"
Cdlg.InitDir = App.Path
Cdlg.FileName = ""
Cdlg.ShowOpen
Text1.Text = Cdlg.FileName
Label1.Caption = Str(Round(FileLen(Text1.Text) / 1024, 2)) + "KB"
Exit Sub
Loi:
Label1.Caption = "0 KB"
Text1.Text = ""
Text2.Text = "Da truyen file qua cong COM1 thanh cong"
' goi ham truyen file
If Cdlg.FileName <> "" Then SendFile (Cdlg.FileName)
End Sub
Private Sub Command6_Click()
FileReceive = FreeFile
ReceiveFlag = True
Timer1.Enabled = False
Do
Cdlg.FileName = ""
Cdlg.ShowSave
If Trim(Cdlg.FileName) = "" Then
MsgBox "File name error!!"
End If
Loop While Trim(Cdlg.FileName) = ""
Text2.Text = Cdlg.FileName
MSComm1.Output = "RECEIVE" + vbCr
Open Trim(Text2.Text) For Output As FileReceive
End Sub
Private Sub Form_Load()
With MSComm1
.Settings = "9600,N,8,1"
.RThreshold = 1 'su kien OnComm xay ra khi bat kì kí tu nào duoc chuyen den bo dem nhan.
.Handshaking = comNone
.SThreshold = 0
.InBufferSize = 1024
.OutBufferSize = 1024
.InputMode = comInputModeText 'quyet dinh dang du lieu nhan duoc la dang text
.InputLen = 0
.CommPort = 1 'thiêt lâp và tra vê tên cua công giao tiêp la cong COM1
End With
End Sub
Private Sub MSComm1_OnComm()
If (MSComm1.CommEvent = comEvReceive) Then
Text2.Text = Text2.Text + MSComm1.Input
End If
End Sub
' ham truyen File
Function SendFile(tmp$)
Dim temp$
Dim hsend, bsize, LF&
' mo file
Open tmp$ For Binary Access Read As #2
' kiem tra kich thuoc Mscomm1 OutBuffer
bsize = MSComm1.OutBufferSize
' kiem tra kich thuoc File
LF& = LOF(2)
' code nay se chia du lieu thanh nhung fan nho(Buffer sized)
' va gui chung di
Do Until EOF(2)
If LF& - Loc(2) <= bsize Then
bsize = LF& - Loc(2) + 1
End If
' tao vung chua du lieu
temp$ = Space$(bsize)
' dat du lieu vao bien Temp$ dang string
Get #2, , temp$
MSComm1.Output = temp$
Do
ret = DoEvents()
' cho den khi buffer trong
Loop Until MSComm1.OutBufferCount = 0
Loop
' dong file
Close #2
End Function
Attached Files
Comment