View Web Page Source in VB6

Option Explicit
 
Private Const WININET_API_FLAG_SYNC = &H4&
Private Const INVALID_HANDLE_VALUE = (-1)
Private Const CREATE_ALWAYS = &H2&
Private Const GENERIC_WRITE = &H40000000
 
Private Declare Function CreateFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function InternetOpenW Lib "wininet" (ByVal lpszAgent As Long, ByVal dwAccessType As Long, ByVal lpszProxyName As Long, ByVal lpszProxyBypass As Long, ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrlW Lib "wininet" (ByVal hInternet As Long, ByVal lpszUrl As Long, ByVal lpszHeaders As Long, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal dwNumberOfBytesToRead As Long, lpdwNumberOfBytesRead As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInternet As Long) As Long
Private Declare Function InternetQueryDataAvailable Lib "wininet" (ByVal hFile As Long, lpdwNumberOfBytesAvailable As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
 
 
Public Sub ViewSource(ByVal szUrl As String, ByVal szFile As String)
  
  Dim Buffer() As Byte ' raw buffer.
  Dim hOpen As Long
  Dim hConn As Long
  Dim hFile As Long
  Dim dwBytes As Long
  Dim dwWrittenBytes As Long
  Dim dwReadBytes As Long
  
  ' Create and overwrite the file with write access.
  hFile = CreateFileW(StrPtr("\\?\" & szFile), GENERIC_WRITE, 0, 0, CREATE_ALWAYS, 0, 0)
  
  ' If this fails check rights and permissions...etc
  If hFile = INVALID_HANDLE_VALUE Then
    
    Debug.Print Err.LastDllError
    
    Exit Sub ' _leave
    
  End If
  
  ' Open connection force sync download.
  hOpen = InternetOpenW(0, 1, 0, 0, WININET_API_FLAG_SYNC)
  
  ' Establish connection to URL.
  hConn = InternetOpenUrlW(hOpen, StrPtr(szUrl), 0, 0, 0, 0)
  
  Do
  
    If InternetQueryDataAvailable(hConn, dwBytes, 0, 0) Then
    
      ' Allocate the amount that is immediatley available.
      ReDim Buffer(dwBytes) As Byte
 
    Else
    
      ' Allocate 1KB chunk if the amount available fails.
      dwBytes = 1024
      
      ReDim Buffer(dwBytes) As Byte
      
    End If
    
    If InternetReadFile(hConn, VarPtr(Buffer(0)), dwBytes, dwReadBytes) Then
      
      ' At this point we can write the bytes to the file.
      WriteFile hFile, VarPtr(Buffer(0)), dwReadBytes, dwWrittenBytes, 0
      
    Else
    
      Exit Do ' _leave
    
    End If
    
  Loop Until dwReadBytes = 0
  
  ' perform cleanup.
  InternetCloseHandle hConn
  InternetCloseHandle hOpen
  CloseHandle hFile
  
  ' free memory
  Erase Buffer
  
End Sub
 
Private Sub Command1_Click()
 
ViewSource "http://www.google.com/", "C:\source.txt"
 
End Sub

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90: