I have tried to use GetWindowTextW to extract the window title text successfully, and it is a unicode text. When I use FindWindowW to find the window, it failed and the returned Hwnd is 0.
The window with the unicode title:
The code on VB6 is below. the currentHwnd is the window Hwnd I captured already and it works well during my test:
Private Declare Function FindWindowW Lib "user32" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function GetWindowTextW Lib "user32" (ByVal hWnd As Long, ByVal lpString As Long, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLengthW Lib "user32" (ByVal hWnd As Long) As Long
Private Sub cmdOK_Click()
Dim titleString As String
dim newHwnd as Long
dim Class as string
Class = Space(500)
GetClassName currentHwnd, Class, Len(Class)
titleString = String$(256, 0)
GetWindowTextW currentHwnd, StrPtr(titleString), GetWindowTextLengthW(currentHwnd)
newHwnd = FindWindowW(StrPtr(Class), StrPtr(titleString))
End Sub
I want to write code in vb6
When the form is placed on the screen. and when click Button Return the colors me.top and me.left position.
I want this to be real-time(use timer)
my code:
Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Sub Command1_Click()
Label3 = (GetPixel(GetDC(Me.hdc), Me.Left, Me.Top))
End Sub
Private Sub Timer1_Timer()
Label1.Caption = Me.Left
Label2.Caption = Me.Top
End Sub
This code does not work and returns a value of -1
please help me
Using code from VB6 - Screen shot function, you should be able to get a valid value from GetPixel using something like this:
Dim Pixel As Long
Dim Left As Long
Dim Top As Long
Dim hDC As Long
' Get Desktop window
hDC = GetWindowDC(GetDesktopWindow)
' Use size of screen
Left = Me.Left \ Screen.TwipsPerPixelX
Top = Me.Top \ Screen.TwipsPerPixelY
Pixel = GetPixel(hDC, Left, Top)
This will give you a COLORREF from which you can extract the color of the pixel at the top left of your form.
You will need to Declare the following functions in a Module:
Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
You can then extract the RGB values from that pixel using the following functions:
Function GetRedValue(ByVal color As Long) As Long
GetRedValue = color And &HFF&
End Function
Function GetGreenValue(ByVal color As Long) As Long
GetGreenValue = (color \ &H100&) And &HFF&
End Function
Function GetBlueValue(ByVal color As Long) As Long
GetBlueValue = (color \ &H10000) And &HFF&
End Function
It's quite simple really. I want for an application to keep monitoring KeyDown events even without focus.
Private Sub Form1_KeyDown(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
Select Case e.KeyData
Case Keys.MediaStop
PictureBox2_Click(sender, e)
Case Keys.MediaPlayPause
PauseToolStripMenuItem_Click(sender, e)
Case Keys.MediaNextTrack
SkipTrackToolStripMenuItem_Click(sender, e)
Case Keys.MediaPreviousTrack
PreviousTrackToolStripMenuItem_Click(sender, e)
End Select
End Sub
The above code is for a music player. Functions are called when the media keys are pressed ('Fn'+ 'Home', 'Fn' + 'Pg Up'...etc)
In a previous comment, somebody suggested looking into WH_KEYBOARD_LL for a solution but I didn't really understand much of it, if I'm honest.
UPDATE:
The link suggested isn't great as the 'As Any' keyword is not supported in 'Declare' functions.
This is how far I've got with it...
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As **Any**) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function SetWindowsHook Lib "user32" Alias "SetWindowsHookA" (ByVal nFilterType As Long, ByVal pfnFilterProc As Long) As Long
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As **Any**, Source As **Any**, ByVal Length As Long)
**Global** Const WH_KEYBOARD_LL = 13
Public Const HC_ACTION = 0
Structure HookStruct
Dim vkCode As Long
Dim scancode As Long
Dim flags As Long
Dim time As Long
Dim dwExtraInfo As Long
End Structure
The errors that Visual Studio is underlining are all written in bold
On hover of 'Any' it gives me the message "'As Any' is not supported in 'Declare' statements"
On hover of 'Global' it gives "Syntax error"
Implementing Keyboard hook using Windows API is the solution. Please check : http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=13506&lngWId=1
If you are using VB6 and want to Hide the Navigation Bar, simply do this.
aw$ = "^(h)"
SendKeys aw$
Apply this after pdf file loads.
Is it possible to adjust forms transparency in VB6 like in VB.NET?
I need this effect especially for irregularly shaped intro screen, where I need the form to be invisible, while the shape on it and some labels need to be visible!
yes you can set a level of transparency on winXP or later using GDI+, you could also set a PNG file, and depending on the alpha value of each pixel to have that amount of transparency. Before winXP you could only change the shape of the form to something irregular, but not play with transparency levels.
Change the aplha of the entire form using gdi+
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const WS_EX_LAYERED = &H80000
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Dim i As Integer
Public Sub FadeForm(Frm As Form, Level As Byte)
On Error Resume Next
Dim msg As Long
msg = GetWindowLong(Frm.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
SetWindowLong Frm.hwnd, GWL_EXSTYLE, msg
SetLayeredWindowAttributes Frm.hwnd, 0, Level, LWA_ALPHA
End Sub
Per-pixel transparency using gdi+
Public Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, graphics As Long) As GpStatus
Public Declare Function GdipCreateFromHWND Lib "gdiplus" (ByVal hwnd As Long, graphics As Long) As GpStatus
Public Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As GpStatus
Public Declare Function GdipGetDC Lib "gdiplus" (ByVal graphics As Long, hdc As Long) As GpStatus
Public Declare Function GdipReleaseDC Lib "gdiplus" (ByVal graphics As Long, ByVal hdc As Long) As GpStatus
Public Declare Function GdipDrawImageRect Lib "gdiplus" (ByVal graphics As Long, ByVal image As Long, ByVal x As Single, ByVal y As Single, ByVal Width As Single, ByVal Height As Single) As GpStatus
Public Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, image As Long) As GpStatus
Public Declare Function GdipCloneImage Lib "gdiplus" (ByVal image As Long, cloneImage As Long) As GpStatus
Public Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal image As Long, Width As Long) As GpStatus
Public Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal image As Long, Height As Long) As GpStatus
Public Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As Long, ByVal hpal As Long, bitmap As Long) As GpStatus
Public Declare Function GdipBitmapGetPixel Lib "gdiplus" (ByVal bitmap As Long, ByVal x As Long, ByVal y As Long, color As Long) As GpStatus
Public Declare Function GdipBitmapSetPixel Lib "gdiplus" (ByVal bitmap As Long, ByVal x As Long, ByVal y As Long, ByVal color As Long) As GpStatus
Public Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As GpStatus
Public Declare Function GdipCreateBitmapFromFile Lib "gdiplus" (ByVal filename As Long, bitmap As Long) As GpStatus
Public Type GdiplusStartupInput
GdiplusVersion As Long ' Must be 1 for GDI+ v1.0, the current version as of this writing.
DebugEventCallback As Long ' Ignored on free builds
SuppressBackgroundThread As Long ' FALSE unless you're prepared to call
' the hook/unhook functions properly
SuppressExternalCodecs As Long ' FALSE unless you want GDI+ only to use
' its internal image codecs.
End Type
Public Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus
Public Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token As Long)
Public Enum GpStatus ' aka Status
Ok = 0
GenericError = 1
InvalidParameter = 2
OutOfMemory = 3
ObjectBusy = 4
InsufficientBuffer = 5
NotImplemented = 6
Win32Error = 7
WrongState = 8
Aborted = 9
FileNotFound = 10
ValueOverflow = 11
AccessDenied = 12
UnknownImageFormat = 13
FontFamilyNotFound = 14
FontStyleNotFound = 15
NotTrueTypeFont = 16
UnsupportedGdiplusVersion = 17
GdiplusNotInitialized = 18
PropertyNotFound = 19
PropertyNotSupported = 20
End Enum
'--------------------------------------
Private Const ULW_OPAQUE = &H4
Private Const ULW_COLORKEY = &H1
Private Const ULW_ALPHA = &H2
Private Const BI_RGB As Long = 0&
Private Const DIB_RGB_COLORS As Long = 0
Private Const AC_SRC_ALPHA As Long = &H1
Private Const AC_SRC_OVER = &H0
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_STYLE As Long = -16
Private Const GWL_EXSTYLE As Long = -20
Private Const HWND_TOPMOST As Long = -1
Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_NOSIZE As Long = &H1
Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
Private Type Size
cx As Long
cy As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Private Declare Function BitBlt Lib "gdi32.dll" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function AlphaBlend Lib "Msimg32.dll" (ByVal hdcDest As Long, ByVal nXOriginDest As Long, ByVal lnYOriginDest As Long, ByVal nWidthDest As Long, ByVal nHeightDest As Long, ByVal hdcSrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal bf As Long) As Boolean
Private Declare Function UpdateLayeredWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal hdcDst As Long, pptDst As Any, psize As Any, ByVal hdcSrc As Long, pptSrc As Any, ByVal crKey As Long, ByRef pblend As BLENDFUNCTION, ByVal dwFlags As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32.dll" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByRef lplpVoid As Any, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function GetDIBits Lib "gdi32.dll" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SetDIBits Lib "gdi32.dll" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function SetWindowPos Lib "user32.dll" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Dim mDC As Long ' Memory hDC
Dim mainBitmap As Long ' Memory Bitmap
Dim blendFunc32bpp As BLENDFUNCTION
Dim token As Long ' Needed to close GDI+
Dim oldBitmap As Long
Private Function MakeTrans(pngPath As String) As Boolean
Dim tempBI As BITMAPINFO
Dim tempBlend As BLENDFUNCTION ' Used to specify what kind of blend we want to perform
Dim lngHeight As Long, lngWidth As Long
Dim curWinLong As Long
Dim img As Long
Dim graphics As Long
Dim winSize As Size
Dim srcPoint As POINTAPI
With tempBI.bmiHeader
.biSize = Len(tempBI.bmiHeader)
.biBitCount = 32 ' Each pixel is 32 bit's wide
.biHeight = Me.ScaleHeight ' Height of the form
.biWidth = Me.ScaleWidth ' Width of the form
.biPlanes = 1 ' Always set to 1
.biSizeImage = .biWidth * .biHeight * (.biBitCount / 8) ' This is the number of bytes that the bitmap takes up. It is equal to the Width*Height*ByteCount (bitCount/8)
End With
mDC = CreateCompatibleDC(Me.hdc)
mainBitmap = CreateDIBSection(mDC, tempBI, DIB_RGB_COLORS, ByVal 0, 0, 0)
oldBitmap = SelectObject(mDC, mainBitmap) ' Select the new bitmap, track the old that was selected
' GDI Initializations
Call GdipCreateFromHDC(mDC, graphics)
Call GdipLoadImageFromFile(StrConv(pngPath, vbUnicode), img) ' Load Png
Call GdipGetImageHeight(img, lngHeight)
Call GdipGetImageWidth(img, lngWidth)
Call GdipDrawImageRect(graphics, img, 0, 0, lngWidth, lngHeight)
' Change windows extended style to be used by updatelayeredwindow
curWinLong = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
' Accidently did This line below which flipped entire form, it's neat so I left it in
' Comment out the line above and uncomment line below.
'curWinLong = GetWindowLong(Me.hwnd, GWL_STYLE)
SetWindowLong Me.hwnd, GWL_EXSTYLE, curWinLong Or WS_EX_LAYERED
' Make the window a top-most window so we can always see the cool stuff
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
' Needed for updateLayeredWindow call
srcPoint.x = 0
srcPoint.y = 0
winSize.cx = Me.ScaleWidth
winSize.cy = Me.ScaleHeight
With blendFunc32bpp
.AlphaFormat = AC_SRC_ALPHA ' 32 bit
.BlendFlags = 0
.BlendOp = AC_SRC_OVER
.SourceConstantAlpha = 255
End With
Call GdipDisposeImage(img)
Call GdipDeleteGraphics(graphics)
Call UpdateLayeredWindow(Me.hwnd, Me.hdc, ByVal 0&, winSize, mDC, srcPoint, 0, blendFunc32bpp, ULW_ALPHA)
End Function
Private Sub Form_Initialize()
' Start up GDI+
Dim GpInput As GdiplusStartupInput
GpInput.GdiplusVersion = 1
If GdiplusStartup(token, GpInput) <> 0 Then
MsgBox "Error loading GDI+!", vbCritical
Unload Me
End If
MakeTrans (App.Path & "\test.png")
End Sub
Private Sub Form_Unload(Cancel As Integer)
' Cleanup everything
Call GdiplusShutdown(token)
SelectObject mDC, oldBitmap
DeleteObject mainBitmap
DeleteObject oldBitmap
DeleteDC mDC
End Sub
Windows API method (before GDI+) that changes the shape of a form
Public Const RGN_AND = 1 'Shows the part when both regions are touched
Public Const RGN_OR = 2 'Shows the part when one or both regions are touched
Public Const RGN_XOR = 3 'Shows the part when one of both regions are touched
Public Const RGN_DIFF = 4
Public Const RGN_COPY = 5
Public Const RGN_MIN = RGN_AND
Public Const RGN_MAX = RGN_COPY
Public Type POINTAPI
X As Long
Y As Long
End Type
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function CreateRectRgnIndirect Lib "gdi32" (lpRect As RECT) As Long 'The only difference from CreateRectRgn is it is destinated thru a RECT variable
Declare Function InvertRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyfillMode As Long) As Long
Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Declare Function CreateEllipticRgn& Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
Declare Function CreatePolyPolygonRgn& Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyfillMode As Long, lpPolyCount As Long)
Dim ellipse& = CreateEllipticRgn&(100, 100, 200, 200);
SetWindowRgn Me.hwnd, ellipse, True
I want to download multiple files (mostly images) from VB6 application. presently i m using URLDownloadToFile but it allows only one file at a time and there is no progress bar. I want to download multiple files and with progress bar. please help. thanks in advance.
my present code:
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
You want to download the file asynchronously, so that your VB code continues executing while the download happens. There is a little-known way to do this with native VB6, using the AsyncRead method of UserControl and UserDocument objects - no need for API calls.
Here's an excellent explanation and VB6 code for multiple simultaneous downloads, from the renowned VB6 guru Karl Peterson. The AsyncReadProgress event gives you the BytesRead and BytesMax, which will allow you to display a progress bar.
You're hoping for a VB answer, but this is non trivial.
Most of the following comes from http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_20571958.html
IBindStatusCallback interface is not
directly accessible from VB. It must
be introduced into a compatible type
library.
You can find the Type library
olelib.tlb under:
http://www.domaindlx.com/e_morcillo/scripts/type/default.asp
The zip file name to download is:
tl_ole.zip
You will also find examples on how to
use it included. Not sure thou whether
you will find a specific example on
IBindStatusCallback on not, but it
worth giving it a try.
You can write your own function to get the data into a string, which will give you full control over everything:
Option Explicit
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_DEFAULT_HTTP_PORT = 80
Public Const INTERNET_SERVICE_HTTP = 3
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const HTTP_QUERY_STATUS_CODE = 19
Public Const HTTP_ADDREQ_FLAG_ADD = &H20000000
Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public 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
Public 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
Public Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal lOptionalLength As Long) As Long
Public 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 Long
Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Public Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lModifiers As Long) As Integer
Public Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumberOfBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Public Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternet&, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength&, ByVal dwFlags&, ByVal dwContext&) As Long
Public Declare Function InternetQueryDataAvailable Lib "wininet.dll" (ByVal hFile As Long, lpdwNumberOfBytesAvailable As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Public Function GetHTML(strURL As String) As String
Const BufferSize = 16384
Dim hSession&, hURL&, lRet&, lBytesAvail&
Dim Buffer As String * BufferSize
Dim BufferLen&, sResult$
hSession = InternetOpen(vbNullString, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
hURL = InternetOpenUrl(hSession, strURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
sResult = ""
Do
InternetReadFile hURL, Buffer, Len(Buffer), BufferLen
If BufferLen > 0 Then sResult = sResult & Left(Buffer, BufferLen)
Loop Until BufferLen = 0
GetHTML = sResult
InternetCloseHandle hURL
InternetCloseHandle hSession
End Function
You will find additional resources for doing the callback method here (scroll down to the bottom):
http://www.experts-exchange.com/Programming/Languages/.NET/Visual_Basic.NET/Q_21763861.html
http://www.experts-exchange.com/Programming/Languages/.NET/Visual_Basic.NET/Q_21746456.html
But I honestly think you'll be better off making your own download function if you want more control over it. TCP/IP stuff in VB is actually very easy.
-Adam