Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 360
  • Last Modified:

VBA - Authorize when opened by checking for existnace of a website

I built a VBA app in Excel and I am trying to set the application up to check for the existance of a webpage when it is opened.  If the webpage no longer exists then the application quits before loading any code and is useless.

This way I can disable the use of the application if I remove the file from my webserver.

The problem I am running into is the file keeps being saved into the temporary internet files so even if I delete the file from the internet, its reads it from the cache and proceeds with the program.

Here is what I am using:

Private Sub Workbook_Open()
    On Error GoTo UnAuth_Shutdown
    Workbooks.Open ("http://www.-----.com/65483.html")
    ActiveWindow.Close
    MsgBox "Access Granted"

If the internet file does not exist it throws off an error and it sends it to a shutdown sequence.  If the file is present it closes it with no error and continues to execute my code.

After it loads the file once though, the 65483.html file is saved in the cache so even when I remove it from the web it still finds it in the cache - doesn't throw the error and continues to execute the code.

Any advice on how to fix this or a better way to go about this all together.

Thanks,

Robert

0
EFLRobert
Asked:
EFLRobert
1 Solution
 
Ryan ChongCommented:
you may try this function:

Public Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long

'Get Status using using Microsoft XML 2.0 Object Library (MSXML)
Public Function getHTTPStatus(url As String) As String
    On Error GoTo EH
    DeleteUrlCacheEntry url
   
    Dim xmlHttp As MSXML.XMLHTTPRequest
    Set xmlHttp = New MSXML.XMLHTTPRequest
   
    xmlHttp.Open "GET", url, False
    xmlHttp.Send
    getHTTPStatus = xmlHttp.Status
    Set xmlHttp = Nothing
    Exit Function
EH:
    Debug.Print Err.Number & ": " & Err.Description
    On Error Resume Next
    Set xmlHttp = Nothing
End Function

try like:

URL = "http://www.-----.com/65483.html"
if getHTTPStatus(URL) = "200" then
   msgbox "URL accessible"
else
   msgbox "URL not accessible"
end if


hope this helps
0
 
bruintjeCommented:
Hi EFLRobert,

Maybe you can try the following in your html file to prevent caching by the browser
source: http://www.mnot.net/cache_docs/

Or use an API call to directly download the file and delete it
source: http://support.microsoft.com/kb/244757/EN-US/
---------
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
---------

and use like
source: http://vbnet.mvps.org/index.html?code/internet/urldownloadtofile.htm
---------
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2006 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Declare Function URLDownloadToFile Lib "urlmon" _
   Alias "URLDownloadToFileA" _
  (ByVal pCaller As Long, _
   ByVal szURL As String, _
   ByVal szFileName As String, _
   ByVal dwReserved As Long, _
   ByVal lpfnCB As Long) As Long
   
Private Const ERROR_SUCCESS As Long = 0
Private Const BINDF_GETNEWESTVERSION As Long = &H10
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000

Public Function DownloadFile(sSourceUrl As String, _
                             sLocalFile As String) As Boolean
 
  'Download the file. BINDF_GETNEWESTVERSION forces
  'the API to download from the specified source.
  'Passing 0& as dwReserved causes the locally-cached
  'copy to be downloaded, if available. If the API
  'returns ERROR_SUCCESS (0), DownloadFile returns True.
   DownloadFile = URLDownloadToFile(0&, _
                                    sSourceUrl, _
                                    sLocalFile, _
                                    BINDF_GETNEWESTVERSION, _
                                    0&) = ERROR_SUCCESS
   
End Function

' now we need only the handle the file when downloaded

Dim sSourceUrl As String
   Dim sLocalFile As String
   Dim hfile As Long, strMyFile as String
   
   sSourceUrl = "http://www.-----.com/65483.html"
   sLocalFile = "c:\deleteme.htm"
   
   Label1.Caption = sSourceUrl
   Label2.Caption = sLocalFile
   
   If DownloadFile(sSourceUrl, sLocalFile) Then ' if this is a success then delete the file
     
      hfile = FreeFile
      Open sLocalFile For Input As #hfile
         strMyFile = Input$(LOF(hfile), hfile)
      Close #hfile
      Kill sLocalFile ' delete it here and run your program
   Else
      Exit sub ' do not start the program the file is not there
   End If
---------

hope this helps a bit
bruintje
0
 
bruintjeCommented:
didn't see that earlier post ryan, busy typing :)
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
EFLRobertAuthor Commented:
Its still looking at the cache file as if it is the real file.  Its recopying the cache file into the local file set up.

I would just delete the cache file but the path changes based on the user.

Is there a way to set the path based on user to delete the cached file?

I also put in the no cache HTML but it doesnt work when "offline"

Any ideas?
0
 
bruintjeCommented:
looking at the comment from ryancys i would chang it like


Public Function getHTTPStatus(url As String) As String
    On Error GoTo EH
    DeleteUrlCacheEntry url
   
    Dim xmlHttp As MSXML.XMLHTTPRequest
    Set xmlHttp = New MSXML.XMLHTTPRequest
   
    xmlHttp.Open "GET", url, False
    xmlHttp.Send
    getHTTPStatus = xmlHttp.Status
    Set xmlHttp = Nothing

    DeleteUrlCacheEntry url ' add this line here too to delete then entry after validation

    Exit Function
EH:
    Debug.Print Err.Number & ": " & Err.Description
    On Error Resume Next
    Set xmlHttp = Nothing
End Function

if this works then the points should go to ryancys
0
 
junglerover77Commented:
I have to say that your idea is absolutely wrong for your purpose. If I were the user, even if you have solved the problem of "loading html file from the cache", I can still use your application by directing "http://www.-----.com/" to a fake website where a file "65483.html" exists, by editing the "HOSTS" file on my own computer.

So, to prevent users from using your application as you like, the way should be:

1. When your application starts, try to access an ASP web page with a random string:

http://www.-----.com/check.asp?code=inasldhhjaheudkasdk

2. Then, the ASP page should return an corresponding emcrypted string (you can use any encryption algorithm as you like), such as:

hnjsfhjwebngkdhnolasd

3. Decrypt the returned string in your application, if it's right, let the user use the application; if not, quit the application.

Regards,
Jungle
0
 
EFLRobertAuthor Commented:
I get a user-defined type no assigned error on the line

dim xmlHttp As MSXML.XMLHTTPRequest
0
 
bruintjeCommented:
try late binding then, this will prevent versioning problems

Public Function getHTTPStatus(url As String) As String
    On Error GoTo EH
    DeleteUrlCacheEntry url
   
    Dim xmlHttp As Obejct
    Set xmlHttp = CreateObject("MSXML.XMLHTTPRequest")
   
    xmlHttp.Open "GET", url, False
    xmlHttp.Send
    getHTTPStatus = xmlHttp.Status
    Set xmlHttp = Nothing

    DeleteUrlCacheEntry url ' add this line here too to delete then entry after validation

    Exit Function
EH:
    Debug.Print Err.Number & ": " & Err.Description
    On Error Resume Next
    Set xmlHttp = Nothing
End Function
0
 
bruintjeCommented:
Dim xmlHttp As Obejct
should be
Dim xmlHttp As Object

0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now