Viewcode Website với VB

Chia sẻ: Abcdef_45 Abcdef_45 | Ngày: | Loại File: PDF | Số trang:9

Thêm vào BST

Báo xấu

55
lượt xem 3
download

Download Vui lòng tải xuống để xem tài liệu đầy đủ

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.

Chủ đề:

Bình luận(0) Đăng nhập để gửi bình luận!

Lưu

Nội dung Text: Viewcode Website với VB

Viewcode Website với VB 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 Lo ng, 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 lBufferSi ze 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_HT TP_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 store s 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:
...::: wWw.HaySo1.Com :::...MÆ¡ vá» emLam TrÆ°á» ng...::: wWw.HaySo1.Com :::... 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 pC aller 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 = URLDownloadT oFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True End Function Private Sub Form_Load() 'example by Matthew Gates ( Địa chỉ email này đã được bảo vệ từ spam bots, Puff0rz@hotmail.com bạn cần kích hoạt Javascript để xem nó. ) DownloadFile "http://www.allapi.net", "c: \allapi.htm" End Sub Nguồn: DDTH.com