Translate

Thứ Bảy, 20 tháng 7, 2013

Giá dollar, Giá vàng thế giới và Việt Nam


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&#224;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&#224;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ú

1 nhận xét:

Trực tuyến

Mục lục Toàn bộ (theo thứ tự thời gian)

Trực tuyến