Lessons XVII : Viewcode Website với VB

Viewcode Website với VB

Thứ hai, 18 Tháng 8 2008 15:39 huytranaz Hướng dẫn lập trình Visual Basic-VB.NET
Email In

Cách thực hiện: Sử dụng các hàm API InternetOpen,InternetReadFile… để tải nội dung từ 1 địa chỉ.

Bạn xem code mẫu sau, trong đó hàm:
Private Function InternetGetContent(sServerName As String, sFileName As String, Optional sUsername As String = vbNullString, Optional sPassword As String = vbNullString, Optional lBufferSize As Long = -1) As String
Thực hiện việc download nội dung (html source code) từ file sFileName, đặt tại host: sServerName.

Bạn tạo 1 ứng dụng mới, sau đó copy/paste đoạn code sau vào Form1 rồi chạy thử nhé.

Code:
Option Explicit
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, sOptional As Any, ByVal lOptionalLength As Long) As Integer
'--
Private Function InternetGetContent(sServerName As String, sFileName As String, Optional sUsername As String = vbNullString, Optional sPassword As String = vbNullString, Optional lBufferSize As Long = -1) As String
   Dim hInternetSession As Long, hInternetConnect As Long, hHttpOpenRequest As Long
   Dim lRetVal As Long, lLenFile As Long, lNumberOfBytesRead As Long, lResLen As Long
   Dim sBuffer As String, lTotalBytesRead As Long

   Const clBufferIncrement As Long = 2000, scUserAgent As String = "VBUsers"
   Const INTERNET_OPEN_TYPE_PRECONFIG = 0, INTERNET_FLAG_EXISTING_CONNECT = &H20000000
   Const INTERNET_OPEN_TYPE_DIRECT = 1, INTERNET_OPEN_TYPE_PROXY = 3
   Const INTERNET_DEFAULT_HTTP_PORT = 80, INTERNET_FLAG_RELOAD = &H80000000
   Const INTERNET_SERVICE_HTTP = 3
   Const HTTP_QUERY_CONTENT_LENGTH = 5

   If lBufferSize = -1 Then
       'Create an arbitary buffer to read the whole file in parts
       sBuffer = String$(clBufferIncrement, vbNullChar)
       lBufferSize = clBufferIncrement
   Else
       'Create a specified buffer size
       sBuffer = String$(lBufferSize, vbNullChar)
   End If

   'Initializes an application's use of the Win32 Internet functions
   hInternetSession = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
   'Opens an FTP, Gopher, or HTTP session for a given site
   hInternetConnect = InternetConnect(hInternetSession, sServerName, INTERNET_DEFAULT_HTTP_PORT, sUsername, sPassword, INTERNET_SERVICE_HTTP, 0, 0)
   'Create an HTTP request handle
   hHttpOpenRequest = HttpOpenRequest(hInternetConnect, "GET", sFileName, "HTTP/1.0", vbNullString, 0, INTERNET_FLAG_RELOAD, 0)

   'Creates a new HTTP request handle and stores the specified parameters in that handle
   lRetVal = HttpSendRequest(hHttpOpenRequest, vbNullString, 0, 0, 0)
   If lRetVal Then
       'Determine the file size
       lResLen = lBufferSize
       lRetVal = HttpQueryInfo(hHttpOpenRequest, HTTP_QUERY_CONTENT_LENGTH, ByVal sBuffer, lResLen, 0)
       If lRetVal Then
           'Successfully returned file length
           lLenFile = Val(Left$(sBuffer, lResLen))
           'Create a buffer to hold file
           sBuffer = String$(lLenFile, vbNullChar)
           lBufferSize = lLenFile
       Else
           'Unable to establish file length
           lLenFile = -1
       End If

       'Read the file
       Do
           lRetVal = InternetReadFile(hHttpOpenRequest, sBuffer, lBufferSize, lNumberOfBytesRead)
           'Store the results
           InternetGetContent = InternetGetContent & Left$(sBuffer, lNumberOfBytesRead)
           lTotalBytesRead = lTotalBytesRead + lNumberOfBytesRead
           If lNumberOfBytesRead = 0 Or lTotalBytesRead = lLenFile Or lRetVal = 0 Then
               'Finished reading file
               Exit Do
           End If
       Loop
   End If
   'Close handles
   InternetCloseHandle hHttpOpenRequest
   InternetCloseHandle hInternetSession
   InternetCloseHandle hInternetConnect
End Function
'--
'  Demo cach su dung ham InternetGetContent
'(Note the Debug window will only show the last 255 lines)
Private Sub Form_Load()
   Dim mHTMLCode As String
   mHTMLCode = InternetGetContent("hayso1.com", "/m/asx.php?type=1&id=58049", "", "")
   Debug.Print "Code: " & vbCrLf & mHTMLCode
End Sub

Kết quả sẽ là:

Code:
Code: 
<asx Version="3.0"><Title>...::: wWw.HaySo1.Com :::...</Title><Param Name="Encoding" Value="UTF-8" /><entry><Title>Mơ về em</Title><Author>Lam Trường</Author><Copyright>...::: wWw.HaySo1.Com :::...</Copyright><Ref Href="mms://s2.vui9.com/s2/@Change0108@/Nhac7/thang8/Lam Truong - Ngay Hom Nay ( Today )/06. Lam Truong - Mo Ve Em-[HaySo1.Com].mp3" /></entry></asx>

Hoặc bạn có thể dùng cách này: Dùng hàm API URLDownloadToFile để download 1 internet URL xuống file trên đĩa cứng rồi xử lý:
Tham khảo ví dụ trong API-Guide

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
Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean
    Dim lngRetVal As Long
    lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
    If lngRetVal = 0 Then DownloadFile = True
End Function
Private Sub Form_Load()
    'example by Matthew Gates (
 Puff0rz@hotmail.com)
    DownloadFile "http://www.allapi.net", "c:\allapi.htm"
End Sub

Nguồn: DDTH.com

  1. Leave a comment

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: