I know how to search for files on the local pc or server, but not on the internet. the standard fileexits functions doesn't seem to be able to read http:// etc
Now if I download a file that doesn't exist yet I just get the internet explorer download error message but I want to prevent that by first checking if the file exists or not
code is as follows
Option Explicit
Private Const CONNECT_LAN As Long = &H2
Private Const CONNECT_MODEM As Long = &H1
Private Const CONNECT_PROXY As Long = &H4
Private Const CONNECT_OFFLINE As Long = &H20
Private Const CONNECT_CONFIGURED As Long = &H40
Private Const MAX_PATH As Long = 260
Private Const ERROR_SUCCESS As Long = 0&
Private Const INVALID_HANDLE_VALUE = -1
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const REG_SZ As Long = 1
Private Const READ_CONTROL As Long = &H20000
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ALL_ACCESS As Long = &HF003F
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const SYNCHRONIZE As Long = &H100000
Private Const STANDARD_RIGHTS_WRITE As Long = READ_CONTROL
Private Const KEY_READ As Long = ((READ_CONTROL Or _
KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And _
(Not SYNCHRONIZE))
Private Const KEY_WRITE As Long = ((STANDARD_RIGHTS_WRITE Or _
KEY_SET_VALUE Or _
KEY_CREATE_SUB_KEY) And _
(Not SYNCHRONIZE))
Private Const KEY_EXECUTE As Long = (KEY_READ And (Not SYNCHRONIZE))
'registry key containing the Download Directory entry
Private Const sRegDownloadKey = "Software\Microsoft\Internet Explorer"
'a private type used to pass
'data to the function
Private Type FileRegistryDownloadData
DownloadDlgTitle As String 'custom download dialog title
DownloadTempRegKey As String 'temporary download destination folder to set in Reg
DownloadRemoteFileUrl As String 'full URL/name of download file
DownloadLocalFileName As String 'local file download filename
End Type
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
ByVal lpType As Long, _
ByVal lpData As Any, _
lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" _
Alias "RegSetValueExA" _
(ByVal hKey As Long, _
ByVal lpszValueName As String, _
ByVal dwReserved As Long, _
ByVal dwType As Long, _
lpData As Any, _
ByVal nSize As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private Declare Function DoFileDownload Lib "shdocvw.dll" _
(ByVal lpszFile As String) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Private Declare Function IsWindow Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long
Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" _
(ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
Private Declare Function InternetGetConnectedState Lib "wininet" (ByRef dwflags As Long, _
ByVal dwReserved As Long) As Long
Private Sub Form_Load()
Command1.Caption = "Do Custom Download"
'Text1.Text = ""
End Sub
Private Sub Command1_Click()
On Error GoTo Err_Command1_Click
Dim dldata As FileRegistryDownloadData
Dim FN As String ' file name
Dim FNVersion As Double
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sqldata As String
Dim msg As String
If IsWebConnected(msg) Then
msg = "You are connected to the Internet via: " & msg & ". SQS will now search for available updates on the internet."
MsgBox msg, vbOKOnly, "Internet Connection Status"
Else
msg = "You are not connected to the Internet."
MsgBox msg, vbOKOnly, "Internet Connection Status"
Exit Sub
End If
'check latest downloaded and installed Update file
Set db = CurrentDb()
sqldata = "SELECT Downloadversion FROM TblDownload"
Set rs = db.OpenRecordset(sqldata, dbOpenDynaset, dbSeeChanges)
rs.MoveFirst
FNVersion = rs!Downloadversion
rs.Close
If gbLanguage = "Korean" Then FN = "Update English" & FNVersion & ".msi"
If gbLanguage = "English" Or gbLanguage = "English US" Then FN = "Update English" & FNVersion & ".msi"
If gbLanguage = "Nederlands" Then FN = "Update English" & FNVersion & ".msi"
If gbLanguage = "Francais" Then FN = "Update English" & FNVersion & ".msi"
If gbLanguage = "Espanol" Then FN = "Update Espanol" & FNVersion & ".msi"
If gbLanguage = "Italiano" Then FN = "Update English" & FNVersion & ".msi"
If gbLanguage = "Deutsch" Then FN = "Update Deutsch" & FNVersion & ".msi"
If gbLanguage = "portuguese" Then FN = "Update English" & FNVersion & ".msi"
If gbLanguage = "polish" Then FN = "Update English" & FNVersion & ".msi"
With dldata
'custom string, if desired, to
'set as the title of the dialog.
'Leave blank if the default title
''File Download' is adequate
.DownloadDlgTitle = "VBnet Custom File Download Demo"
'the full URL (http or ftp) of the
'file to download to the above directory
.DownloadRemoteFileUrl = "http://info.compair.com/Aftermarket/Service_Quotation_Software_Updates/" & FN
'local or network path where the
'download dialog should offer to
'place the file - THIS PATH MUST EXIST
.DownloadTempRegKey = "C:\"
'remember to set the filename here to the same name
'as the file being downloaded, otherwise you will receive
'a Failed message even though the file was successfully
'retrieved. If this code is being used in an app
'that needs to dynamically set the save filename, you
'can add code from PathStripPath: Removes Path Portion of Fully-qualified Path/Filename
'to automatically retrieve the file part of the URL being downloaded.
.DownloadLocalFileName = .DownloadTempRegKey & "\" & FN
'--------------------
'this next If Then is for debugging;
'it deletes the file each time called
'so as to allow the proper message to
'be displayed following the call. This
'is not required for production
If FileExists(.DownloadLocalFileName) Then
Kill .DownloadLocalFileName
End If
'--------------------
If DownloadRemoteFile(dldata) = True Then
Displaymessage "Download success!"
Else
Displaymessage "Download failed or user pressed Cancel"
End If
End With
Exit_Command1_Click:
Exit Sub
Err_Command1_Click:
Displaymessage "No Updates available"
Resume Exit_Command1_Click
End Sub
Private Function DownloadRemoteFile(dldata As FileRegistryDownloadData) As Boolean
Dim hwndDlg As Long
Dim sDownloadFile As String
Dim sTmpRegHold As String
Dim bRegChanged As Boolean
'retrieve the user's current download
'directory by querying the registry under
'HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer
sTmpRegHold = RegGetDownloadDirectory()
'if the current download folder from
'the registry is not the same as the
'desired download folder, change it
If LCase$(sTmpRegHold) <> LCase$(dldata.DownloadTempRegKey) Then
'Change the registry from the user's
'last-saved folder to the desired
'download folder. Return and save
'a local flag indicating a change
'to the registry was made.
bRegChanged = RegSetDownloadDirectory(dldata.DownloadTempRegKey)
End If
'DoFileDownload requires a Unicode
'string so convert the desired path
'to Unicode and call api
sDownloadFile = StrConv(dldata.DownloadRemoteFileUrl, vbUnicode)
Call DoFileDownload(sDownloadFile)
'if a custom dialog title was specified
'in the dldata type, we have to give
'the dialog a chance to appear, then
'we can retrieve its handle and change
'the caption.
If Len(dldata.DownloadDlgTitle) > 0 Then
'Ensure dialog is displayed.
'You can either use the loop below,
'which waits for the hwndDlg to
'become valid, or you can use the
'commented out code below instead,
'which puts the app to sleep for a
'few milliseconds to let Windows
'create the dialog. Note that only
'one of the two method are needed!
'
'The advantage of the first is the
'dialog title is changed as soon as
'the dialog hwnd becomes valid, whereas
'the delay method may require tweaking
'to ensure sufficient delay is introduced
'to allow Windows to create the dialog.
'The disadvantage of the first method is,
'should the dialog creation fail, you'll
'stay in the loop. The downside to the
'delay method is a possible perceptible
'caption change, or, if the dialog is slow
'to appear, no title change will occur.
'You're choice!
'Loop method
Do
hwndDlg = FindWindow("#32770", "File Download")
Loop While hwndDlg = 0
'Delay method
'Call Sleep(150)
'hwndDlg = FindWindow("#32770", "File Download")
'assign the custom caption
If hwndDlg <> 0 Then
Call SetWindowText(hwndDlg, dldata.DownloadDlgTitle)
End If
End If
'Since we've changed the registry,
'it is only polite to change it
'back once we're done. This is
'accomplished by entering a loop
'and pausing the app while the
'dialog is on-screen. DoEvents
'ensures the app can process messages.
'The loop will terminate when the
'dialog has closed, either from a
'successful download or from the
'user selecting Cancel. This
'information can't be determined here,
'so later we do a test for the file
'(a FileExists) to determine the
'success of the action.
Do
Call Sleep(50)
DoEvents
Loop Until IsWindow(hwndDlg) = False
'The download is done or has been
'cancelled, so first reset the user's
'original download folder if changed
If bRegChanged Then
Call RegSetDownloadDirectory(sTmpRegHold)
End If
'now check the download was successful,
'and return that as the success of this
'routine
DownloadRemoteFile = FileExists(dldata.DownloadLocalFileName)
End Function
Private Function RegGetDownloadDirectory() As String
Dim hKey As Long
Dim sizeData As Long
Dim tmpdata As String
If RegOpenKeyEx(HKEY_CURRENT_USER, _
sRegDownloadKey, _
0, _
KEY_READ, _
hKey) = ERROR_SUCCESS Then
tmpdata = Space$(MAX_PATH)
sizeData = Len(tmpdata)
Call RegQueryValueEx(hKey, _
"Download Directory", _
0, 0, _
tmpdata, _
sizeData)
'strip trailing nulls and return
RegGetDownloadDirectory = TrimNull(tmpdata)
End If
Call RegCloseKey(hKey)
End Function
Private Function RegSetDownloadDirectory(sRegDownloadDir As String) As Boolean
Dim hKey As Long
Dim tmpdata As String
If RegOpenKeyEx(HKEY_CURRENT_USER, _
sRegDownloadKey, _
0, _
KEY_WRITE, _
hKey) = ERROR_SUCCESS Then
RegSetDownloadDirectory = RegSetValueEx(hKey, _
"Download Directory", _
0&, _
REG_SZ, _
ByVal sRegDownloadDir & vbNullChar, _
Len(sRegDownloadDir) + 1) = ERROR_SUCCESS
End If
Call RegCloseKey(hKey)
End Function
Private Function FileExists(sSource As String) As Boolean
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
hFile = FindFirstFile(sSource, WFD)
FileExists = hFile <> INVALID_HANDLE_VALUE
Call FindClose(hFile)
End Function
Private Function TrimNull(startstr As String) As String
TrimNull = left$(startstr, lstrlenW(StrPtr(startstr)))
End Function
Public Function IsWebConnected(Optional ByRef ConnType As String) As Boolean
Dim dwflags As Long
Dim WebTest As Boolean
ConnType = ""
WebTest = InternetGetConnectedState(dwflags, 0&)
Select Case WebTest
Case dwflags And CONNECT_LAN: ConnType = "LAN"
Case dwflags And CONNECT_MODEM: ConnType = "Modem"
Case dwflags And CONNECT_PROXY: ConnType = "Proxy"
Case dwflags And CONNECT_OFFLINE: ConnType = "Offline"
Case dwflags And CONNECT_CONFIGURED: ConnType = "Configured"
' Case dwflags And CONNECT_RAS: ConnType = "Remote"
End Select
IsWebConnected = WebTest
End Function
