Home
Search
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
C# Helper...
 
XML RSS Feed
Follow VBHelper on Twitter
 
 
 
MSDN Visual Basic Community
 
 
 
 
 
TitleDownload the NASA Astronomy Picture of the Day and use it for wallpaper
DescriptionThis example shows how to download the NASA Astronomy Picture of the Day and use it for wallpaper in Visual Basic 6.
Keywordswallpaper, desktop, SystemParametersInfo, APOTD, NASA, Astronomy Picture of the Day
CategoriesWindows, Utilities, Graphics
 
When the program starts, it uses an Internet Transfer control to download the Astronomy Picture of the Day Web page text. It searches the page for the IMG token, composes the image file's name, and uses the URLDownloadToFile API function to download the picture into the C:\Temp\Apotd directory.

Next the program loads the picture into a hidden PictureBox and saves the control's picture in a bitmap file. Finally it uses the SystemParametersInfo API function to set the bitmap file as the system's desktop image.

 
' Download the image and set the wallpaper.
Private Sub Form_Load()
Const SPI_SETDESKWALLPAPER As Long = 20
Const SPIF_UPDATEINIFILE As Long = 1
Const APOTD_URL As String = _
    "http://antwrp.gsfc.nasa.gov/apod/"
Const START_TOKEN As String = "IMG SRC="""
Const END_TOKEN As String = """"
Dim upd As Long
Dim web_page As String
Dim pos1 As Integer
Dim pos2 As Integer
Dim remote_file As String
Dim local_file As String
Dim img_url As String

    On Error GoTo DownloadError

    ' Get the APOTD Web page.
    web_page = Inet1.OpenURL(APOTD_URL)

    ' Find the IMG tag.
    pos1 = InStr(web_page, START_TOKEN)
    pos1 = pos1 + Len(START_TOKEN)

    ' Find the closing quote.
    pos2 = InStr(pos1, web_page, END_TOKEN)

    ' Get the remote file's full URL and file name.
    img_url = APOTD_URL & Mid$(web_page, pos1, pos2 - pos1)
    pos1 = InStrRev(img_url, "/")
    remote_file = Mid$(img_url, pos1 + 1)

    ' Fetch the image.
    local_file = "C:\Temp\Apotd\" & remote_file
    URLDownloadToFile 0, img_url, local_file, 0, 0

    ' Copy the image into a bitmap.
    picHidden.Picture = LoadPicture(local_file)
    SavePicture picHidden.Picture, "C:\Temp\Apotd\temp.bmp"

    ' Set upd to make the change permanent or not.
    ' upd = SPIF_UPDATEINIFILE
    upd = 0

    SystemParametersInfo SPI_SETDESKWALLPAPER, 0, _
        "C:\Temp\Apotd\temp.bmp", upd
    Unload Me
    Exit Sub

DownloadError:
    MsgBox "Error downloading file." & vbCrLf & vbCrLf & _
        Err.Description
    Unload Me
    Exit Sub
End Sub
 
 
Copyright © 1997-2006 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated