Giúp truyền 1 chuổi ký tự số xuống pic16f877a

**mrsin** · 12-04-2012, 10:01 AM

Chào các anh chị trong diễn đàn
Em có 1 giao diện VB6.0 cập nhật số liệu từ internet xuống và lấy số liệu đó truyền xuống PIC em đã viết rồi nhưng không chạy. Lấy số liệu từ internet xuống thì em làm được rồi nhưng truyền xuống pic thì chưa làm được, anh chị xem code VB này sửa giúp em với nha. Em đang bí cái này mong anh chị giúp đỡ.

**mrsin** · 12-04-2012, 06:25 PM

Đây là giao diện VB

**mrsin** · 12-04-2012, 06:40 PM

Em xin nói tổng quan về cái code VB này:
Thứ I: Cập nhật giá trị từ internet xuống và hiện thị ra text box em đã làm xong
Thứ II: Mong anh chị giúp em send số liệu xuống PIC.

Từ đầu cho đến phần Private Sub Form_Load() là phần tách số liệu trên text box và gửi từng ký tự xuống PIC nhưng không gửi xuống được mong anh chị xem và sửa giúp em
Dim V_SJC_M As String
Dim V_SJC_B As String
Dim M_SJC(1 To 4) As String
Dim B_SJC(1 To 4) As String
Dim V_SBC_M As String
Dim V_SBJ_B As String
Dim M_SBJ(1 To 4) As String
Dim B_SBJ(1 To 4) As String
Private Sub SEND_Click()
Timer2.Enabled = True
End Sub

Private Sub Timer1_Timer()
V_SJC_M = txtMua(0)
M_SJC(1) = Mid(V_SJC_M, 1, 1)
M_SJC(2) = Mid(V_SJC_M, 3, 1)
M_SJC(3) = Mid(V_SJC_M, 4, 1)
M_SJC(4) = Mid(V_SJC_M, 5, 1)

V_SJC_B = txtBan(0)
B_SJC(1) = Mid(V_SJC_B, 1, 1)
B_SJC(2) = Mid(V_SJC_B, 3, 1)
B_SJC(3) = Mid(V_SJC_B, 4, 1)
B_SJC(4) = Mid(V_SJC_B, 5, 1)

V_SBJ_M = txtMua(1)
M_SBJ(1) = Mid(V_SBJ_M, 1, 1)
M_SBJ(2) = Mid(V_SBJ_M, 3, 1)
M_SBJ(3) = Mid(V_SBJ_M, 4, 1)
M_SBJ(4) = Mid(V_SBJ_M, 5, 1)

V_SBJ_B = txtBan(1)
B_SBJ(1) = Mid(V_SBJ_B, 1, 1)
B_SBJ(2) = Mid(V_SBJ_B, 3, 1)
B_SBJ(3) = Mid(V_SBJ_B, 4, 1)
B_SBJ(4) = Mid(V_SBJ_B, 5, 1)

Timer1.Enabled = False
End Sub

Private Sub Timer2_Timer()
Timer1.Enabled = True

MSComm1.Output = M_SJC(1)
MSComm1.Output = M_SJC(2)
MSComm1.Output = M_SJC(3)
MSComm1.Output = M_SJC(4)

MSComm1.Output = B_SJC(1)
MSComm1.Output = B_SJC(2)
MSComm1.Output = B_SJC(3)
MSComm1.Output = B_SJC(4)

MSComm1.Output = M_SBJ(1)
MSComm1.Output = M_SBJ(2)
MSComm1.Output = M_SBJ(3)
MSComm1.Output = M_SBJ(4)

MSComm1.Output = B_SBJ(1)
MSComm1.Output = B_SBJ(2)
MSComm1.Output = B_SBJ(3)
MSComm1.Output = B_SBJ(4)
Timer2.Enabled = False
End Sub
Private Sub Form_Load()
WebBrowser1.Navigate "http://www.sacombank.com.vn/Pages/default.aspx"
WebBrowser2.Navigate "about:blank"
With MSComm1
.CommPort = 5 'CONG SO 5
.Settings = "9600,N,8,1" ' KHAI BAO TUONG THICH VOI KHAI BAO CUA PIC
.InBufferSize = 1024 ' BO DEM THU CUA MAY TINH 1024
.InputLen = 0 ' 0 -> DOC HET BO DEM THU, 1 -> DOC TUNG KYTU
.OutBufferSize = 512 ' BO DEM PHAT CUA MAYTINH LA 512
.InputMode = comInputModeText
'.PortOpen = True
End With
End Sub
Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
Label1.BackColor = &HC0C0&
Label1.Caption = "LOADING www.sacombank.com.vn ..."
WebBrowser2.Visible = False
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
UPDATEAU
Label1.BackColor = &H8000&
Label1.Caption = "COMPLETED"
WebBrowser2.Visible = True
End Sub
Private Sub UPDATEAU()

Dim s As String: s = WebBrowser1.Document.body.innerhtml
Dim s1 As String: s1 = "DIV id=ctl00_g_a0798536_2182_4f37_be2f_391a4307bc4b_ct l00_UpdatePanel2"

'<div id=ctl00_g_a0798536_2182_4f37_be2f_391a4307bc4b_ct l00_UpdatePanel2"
'<div id=ctl00_g_a0798536_2182_4f37_be2f_391a4307bc4b_ct l00_UpdatePanel1"

If InStr(s, s1) > 0 Then
s = LCase(Right(s, Len(s) - InStr(s, s1) + 1))
Dim s2 As String: s2 = "</table>"
s = Left$(s, InStr(s, s2) + Len(s2))
s = LCase(Right(s, Len(s) - InStr(s, "<div class=capnhatluc>") + 1))
s = Replace(s, "<table>", "<table border=""1"">")
s = s & "</div><br><hr><strong>Application: nguyenminh</strong>"
SplitContents s ', " ", "")
WebBrowser2.Document.Write "<HTML>" & s & "</HTML>"
End If
End Sub
Public Function SplitContents(ByVal s As String)

s = Right(s, Len(s) - InStr(s, "<td class=""current-item text"">") + 1)
txtType(0).Text = SplitString(s, "<td class=""current-item text"">", "</td>")
s = Right(s, Len(s) - InStr(s, vbNewLine) + 1)
s = Right(s, Len(s) - InStr(s, "<td class=""current-item number"">") + 1)
txtMua(0).Text = SplitString(s, "<td class=""current-item number"">", "</td>")
s = Right(s, Len(s) - InStr(s, vbNewLine) + 1)
s = Right(s, Len(s) - InStr(s, "<td class=""current-item number"">") + 1)
txtBan(0).Text = SplitString(s, "<td class=""current-item number"">", "</td>")
's = Right(s, Len(s) - InStr(s, vbNewLine) + 1)

s = Right(s, Len(s) - InStr(s, "<td class=""current-item text"">") + 1)
txtType(1).Text = SplitString(s, "<td class=""current-item text"">", "</td>")
s = Right(s, Len(s) - InStr(s, vbNewLine) + 1)
s = Right(s, Len(s) - InStr(s, "<td class=""current-item number"">") + 1)
txtMua(1).Text = SplitString(s, "<td class=""current-item number"">", "</td>")
s = Right(s, Len(s) - InStr(s, vbNewLine) + 1)
s = Right(s, Len(s) - InStr(s, "<td class=""current-item number"">") + 1)
txtBan(1).Text = SplitString(s, "<td class=""current-item number"">", "</td>")
's = Right(s, Len(s) - InStr(s, vbNewLine) + 1)

End Function

Public Function SplitString(ByVal mainString As String, ByVal BeginString As String, ByVal EndString As String) As String
Dim i_s As Integer: i_s = InStr(mainString, BeginString)
Dim i_e As Integer: i_e = InStr(mainString, EndString)
If i_s <> -1 And i_e <> -1 Then
Dim s As String
s = Mid(mainString, i_s + Len(BeginString), i_e - i_s - Len(BeginString))
SplitString = s
Else SplitString = ""
End If
End Function

**mrsin** · 13-04-2012, 07:39 AM

Mọi người đâu hết rồi xem và sửa giúp em di

12-04-2012, 06:25 PM	#2
mrsin Đệ tử 2 túi Tham gia ngày: Mar 2012 Bài gửi: 34 :	Đây là giao diện VB

12-04-2012, 06:40 PM	#3
mrsin Đệ tử 2 túi Tham gia ngày: Mar 2012 Bài gửi: 34 :	Em xin nói tổng quan về cái code VB này: Thứ I: Cập nhật giá trị từ internet xuống và hiện thị ra text box em đã làm xong Thứ II: Mong anh chị giúp em send số liệu xuống PIC. Từ đầu cho đến phần Private Sub Form_Load() là phần tách số liệu trên text box và gửi từng ký tự xuống PIC nhưng không gửi xuống được mong anh chị xem và sửa giúp em Dim V_SJC_M As String Dim V_SJC_B As String Dim M_SJC(1 To 4) As String Dim B_SJC(1 To 4) As String Dim V_SBC_M As String Dim V_SBJ_B As String Dim M_SBJ(1 To 4) As String Dim B_SBJ(1 To 4) As String Private Sub SEND_Click() Timer2.Enabled = True End Sub Private Sub Timer1_Timer() V_SJC_M = txtMua(0) M_SJC(1) = Mid(V_SJC_M, 1, 1) M_SJC(2) = Mid(V_SJC_M, 3, 1) M_SJC(3) = Mid(V_SJC_M, 4, 1) M_SJC(4) = Mid(V_SJC_M, 5, 1) V_SJC_B = txtBan(0) B_SJC(1) = Mid(V_SJC_B, 1, 1) B_SJC(2) = Mid(V_SJC_B, 3, 1) B_SJC(3) = Mid(V_SJC_B, 4, 1) B_SJC(4) = Mid(V_SJC_B, 5, 1) V_SBJ_M = txtMua(1) M_SBJ(1) = Mid(V_SBJ_M, 1, 1) M_SBJ(2) = Mid(V_SBJ_M, 3, 1) M_SBJ(3) = Mid(V_SBJ_M, 4, 1) M_SBJ(4) = Mid(V_SBJ_M, 5, 1) V_SBJ_B = txtBan(1) B_SBJ(1) = Mid(V_SBJ_B, 1, 1) B_SBJ(2) = Mid(V_SBJ_B, 3, 1) B_SBJ(3) = Mid(V_SBJ_B, 4, 1) B_SBJ(4) = Mid(V_SBJ_B, 5, 1) Timer1.Enabled = False End Sub Private Sub Timer2_Timer() Timer1.Enabled = True MSComm1.Output = M_SJC(1) MSComm1.Output = M_SJC(2) MSComm1.Output = M_SJC(3) MSComm1.Output = M_SJC(4) MSComm1.Output = B_SJC(1) MSComm1.Output = B_SJC(2) MSComm1.Output = B_SJC(3) MSComm1.Output = B_SJC(4) MSComm1.Output = M_SBJ(1) MSComm1.Output = M_SBJ(2) MSComm1.Output = M_SBJ(3) MSComm1.Output = M_SBJ(4) MSComm1.Output = B_SBJ(1) MSComm1.Output = B_SBJ(2) MSComm1.Output = B_SBJ(3) MSComm1.Output = B_SBJ(4) Timer2.Enabled = False End Sub Private Sub Form_Load() WebBrowser1.Navigate "http://www.sacombank.com.vn/Pages/default.aspx" WebBrowser2.Navigate "about:blank" With MSComm1 .CommPort = 5 'CONG SO 5 .Settings = "9600,N,8,1" ' KHAI BAO TUONG THICH VOI KHAI BAO CUA PIC .InBufferSize = 1024 ' BO DEM THU CUA MAY TINH 1024 .InputLen = 0 ' 0 -> DOC HET BO DEM THU, 1 -> DOC TUNG KYTU .OutBufferSize = 512 ' BO DEM PHAT CUA MAYTINH LA 512 .InputMode = comInputModeText '.PortOpen = True End With End Sub Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean) Label1.BackColor = &HC0C0& Label1.Caption = "LOADING www.sacombank.com.vn ..." WebBrowser2.Visible = False End Sub Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant) UPDATEAU Label1.BackColor = &H8000& Label1.Caption = "COMPLETED" WebBrowser2.Visible = True End Sub Private Sub UPDATEAU() Dim s As String: s = WebBrowser1.Document.body.innerhtml Dim s1 As String: s1 = "DIV id=ctl00_g_a0798536_2182_4f37_be2f_391a4307bc4b_ct l00_UpdatePanel2" '<div id=ctl00_g_a0798536_2182_4f37_be2f_391a4307bc4b_ct l00_UpdatePanel2" '<div id=ctl00_g_a0798536_2182_4f37_be2f_391a4307bc4b_ct l00_UpdatePanel1" If InStr(s, s1) > 0 Then s = LCase(Right(s, Len(s) - InStr(s, s1) + 1)) Dim s2 As String: s2 = "</table>" s = Left$(s, InStr(s, s2) + Len(s2)) s = LCase(Right(s, Len(s) - InStr(s, "<div class=capnhatluc>") + 1)) s = Replace(s, "<table>", "<table border=""1"">") s = s & "</div><br><hr><strong>Application: nguyenminh</strong>" SplitContents s ', " ", "") WebBrowser2.Document.Write "<HTML>" & s & "</HTML>" End If End Sub Public Function SplitContents(ByVal s As String) s = Right(s, Len(s) - InStr(s, "<td class=""current-item text"">") + 1) txtType(0).Text = SplitString(s, "<td class=""current-item text"">", "</td>") s = Right(s, Len(s) - InStr(s, vbNewLine) + 1) s = Right(s, Len(s) - InStr(s, "<td class=""current-item number"">") + 1) txtMua(0).Text = SplitString(s, "<td class=""current-item number"">", "</td>") s = Right(s, Len(s) - InStr(s, vbNewLine) + 1) s = Right(s, Len(s) - InStr(s, "<td class=""current-item number"">") + 1) txtBan(0).Text = SplitString(s, "<td class=""current-item number"">", "</td>") 's = Right(s, Len(s) - InStr(s, vbNewLine) + 1) s = Right(s, Len(s) - InStr(s, "<td class=""current-item text"">") + 1) txtType(1).Text = SplitString(s, "<td class=""current-item text"">", "</td>") s = Right(s, Len(s) - InStr(s, vbNewLine) + 1) s = Right(s, Len(s) - InStr(s, "<td class=""current-item number"">") + 1) txtMua(1).Text = SplitString(s, "<td class=""current-item number"">", "</td>") s = Right(s, Len(s) - InStr(s, vbNewLine) + 1) s = Right(s, Len(s) - InStr(s, "<td class=""current-item number"">") + 1) txtBan(1).Text = SplitString(s, "<td class=""current-item number"">", "</td>") 's = Right(s, Len(s) - InStr(s, vbNewLine) + 1) End Function Public Function SplitString(ByVal mainString As String, ByVal BeginString As String, ByVal EndString As String) As String Dim i_s As Integer: i_s = InStr(mainString, BeginString) Dim i_e As Integer: i_e = InStr(mainString, EndString) If i_s <> -1 And i_e <> -1 Then Dim s As String s = Mid(mainString, i_s + Len(BeginString), i_e - i_s - Len(BeginString)) SplitString = s Else SplitString = "" End If End Function

13-04-2012, 07:39 AM	#4
mrsin Đệ tử 2 túi Tham gia ngày: Mar 2012 Bài gửi: 34 :	Mọi người đâu hết rồi xem và sửa giúp em di