Nhiều trao đổi mong muốn một công cụ biết ngay giá vàng thế giới cũng như giá đô hiện tại. Tại forum clbvb tôi có viết sẵn một công cụ như thế, đã lâu, hình như không hoạt động nữa do link đã chết.
Lẽ ra bài nầy viết nối thêm vào bài "Các phép tính về giá vàng tại Việt Nam và thế giới...", tuy nhiên do bài nầy chủ yếu giới thiệu với ngôn ngữ VB6 nên tôi viết riêng.
Bạn đọc không thông thạo lập trình, có thể dùng ngay sản phẩm: Giá vàng - Ðô như sau:
Giao diện
link download:
http://www.mediafire.com/download/e1yt914vehg36za/Gi%C3%A1_V%C3%A0ng_%C3%90%C3%B4.exe
Sau đây là code:
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Sub Command1_Click()
MsgBox "Máy cân nô'i mang Internet" & vbCrLf & "Tu Ðông câp nhât môi 5 phút" & vbCrLf & _
"Nhân nút Stop Ðê ngung chay, nhân Run Ðê chay lai" & vbCrLf & "============" & _
vbCrLf & "truongphu - clbvb.com - truongphu111@gmail.com", , "Ghi Chú"
End Sub
Private Sub Command2_Click()
Static Chay&
Chay = Chay + 1
If Chay Mod 2 Then
Timer1.Enabled = False
Command2.Caption = "Run"
Else
Timer1.Enabled = True
Command2.Caption = "Stop"
End If
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
URLDownloadToFile 0, "http://www.vietcombank.com.vn/", "vcb.txt", 0, 0
URLDownloadToFile 0, "http://www.goldcalc.com/", "goca.txt", 0, 0
URLDownloadToFile 0, "http://118.69.35.146/sjc/", "sjc.txt", 0, 0
Dim aaa, ddd$, oo&, ppp$, VangTg1LVND As Single
' Giá Ðô
Set aaa = CreateObject("Scripting.FileSystemObject").OpenTextFile(App.Path & "\vcb.txt", 1, False, -2)
ddd = aaa.ReadAll ' Luu ý câu trúc OpenTextFile voi 1 là Ðoc, 2 là viêt. -1 là unicode, -2 default. Web không dùng unicode
oo = InStr(ddd, "USD")
ppp = Mid(ddd, oo, 62)
ppp = Replace(ppp, "<td>", " ")
ppp = Replace(ppp, "</td>", " ")
ppp = Replace(ppp, " ", " ")
ppp = Trim(ppp)
Label4.Caption = ppp
Dim MMM() As String: MMM = Split(ppp)
VangTg1LVND = CSng(MMM(3)) * 1.2
Label2.Caption = FormatNumber(MMM(3), 0, , , vbTrue) & " VNÐ"
aaa.Close
Kill App.Path & "\vcb.txt"
' Giá vàng troy ounce
Set aaa = CreateObject("Scripting.FileSystemObject").OpenTextFile(App.Path & "\goca.txt", 1, False, -2)
ddd = aaa.ReadAll ' Luu ý câu trúc OpenTextFile voi 1 là Ðoc, 2 là viêt. -1 là unicode, -2 default. Web không dùng unicode
oo = InStr(ddd, "Basis:")
ppp = Mid(ddd, oo, 15)
ppp = Right(ppp, 8)
VangTg1LVND = VangTg1LVND * CSng(ppp)
Label8.Caption = ppp & " USD"
aaa.Close
Kill App.Path & "\goca.txt"
' Giá vàng 1 luong VND
Set aaa = CreateObject("Scripting.FileSystemObject").OpenTextFile(App.Path & "\sjc.txt", 1, False, -2)
ddd = aaa.ReadAll ' Luu ý câu trúc OpenTextFile voi 1 là Ðoc, 2 là viêt. -1 là unicode, -2 default. Web không dùng unicode
oo = InStr(ddd, "Vàng SJC 1L")
ppp = Mid(ddd, oo, 85)
ppp = Replace(ppp, "<td align=""center"">", " ")
ppp = Replace(ppp, "</td>", " ")
Do While InStr(ppp, " ")
ppp = Replace(ppp, " ", " ")
DoEvents
Loop
ppp = Replace(ppp, "Vàng", "Vàng")
ppp = Trim(ppp)
Label11.Caption = ppp
MMM = Split(ppp)
Label6.Caption = MMM(4) & ",000 VNÐ"
aaa.Close
Kill App.Path & "\sjc.txt"
Label14.Caption = FormatNumber(VangTg1LVND, 0, , , vbTrue) & " VNÐ"
Label15.Caption = Now
End Sub
Download Project:
Các bạn có thể trao đổi thêm ở phần nhận xét bên dưới, hoặc tại forum clbvb
Trương Phú
Không có nhận xét nào:
Đăng nhận xét