CCTV TECH
Nassau, Bahamas
Search this site Search Help
Default
Newest
Oldest
Your Ad here
 
 
 
API Download

Download a file using the Inet API.
Download VB6 project.

Form
Option Explicit

Private Sub Command1_Click()
    Dim sURL As String
    sURL = "http://www.mysite.com/setup.exe"
    '// START DOWNLOAD
    Command1.Enabled = False
    Command1.Caption = "Downloading.."
    If DownloadInetAPI(sURL, True) Then
        '// DOWNLOAD SUCCEEDED
        Command1.Caption = "Download Complete"
    Else
        '// DOWNLOAD FAILED
        Command1.Caption = "Download Failed"
    End If
    Beep
End Sub

Module
Option Explicit

Private Const MAX_BUFFER_LENGTH = 8162
Private Const API_AGENT_NAME As String = "VB Program"
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000

Private Declare Function InternetCloseHandle Lib "wininet" (ByRef hInet As Long) As Long
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 InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuff As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long

Public Function DownloadInetAPI(ByVal sURL As String, ByVal DEBUG_ON As Boolean) As Boolean
    Dim hOpen As Long, hFile As Long, Ret As Long
    Dim sBuff As String * MAX_BUFFER_LENGTH, sData As String
    Dim sFileName As String, iFile As Integer, dData As Double
    If InStr(1, sURL, "/") Then
        sFileName = App.Path & "\" & Right$(sURL, Len(sURL) - InStrRev(sURL, "/"))
    Else
        sFileName = "Download" & Format(Now, "hhmmssmmddyy") & ".tmp"
    End If
    If DEBUG_ON Then Debug.Print "Connecting ... "
    hOpen = InternetOpen(API_AGENT_NAME, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
    If hOpen = 0 Then
        MsgBox "Error opening Internet connection"
        DownloadInetAPI = False
        Exit Function
    End If
    hFile = InternetOpenUrl(hOpen, sURL, vbNullString, 0, INTERNET_FLAG_NO_CACHE_WRITE, 0)
    If hFile = 0 Then
        dData = 0
    Else
        If DEBUG_ON Then Debug.Print "Downloading ... " & Format(Len(sData) / 1024, 0) & " KB"
        InternetReadFile hFile, sBuff, MAX_BUFFER_LENGTH, Ret
        sData = sBuff
        Do While Ret <> 0
            If DEBUG_ON Then Debug.Print "Downloading ... " & Format(Len(sData) / 1024, 0) & " KB"
            InternetReadFile hFile, sBuff, MAX_BUFFER_LENGTH, Ret
            sData = sData + Mid(sBuff, 1, Ret)
        Loop
        dData = Len(sData): iFile = FreeFile
        Open sFileName For Binary Access Write Lock Write As #iFile
        Put #iFile, , sData: Close #iFile
    End If
    InternetCloseHandle hFile
    InternetCloseHandle hOpen
    sData = ""
    If dData Then
        DownloadInetAPI = True
    End If
End Function

CCTV | DVR | Video Surveillance | Day Night | CCTV Cameras | Remote Video | Tech Support | Software | Scripts | Visual Basic | Articles | Yellow Pages | Real Estate
Copyright © 2001/2012 BahamasSecurity.com
 
Website hosted in Nassau, The Bahamas