How can you associate a program with a webpage. Lets say if i wanted my program to upgrade automatically, how would i do that?
Thanks in advance!!!
Printable View
How can you associate a program with a webpage. Lets say if i wanted my program to upgrade automatically, how would i do that?
Thanks in advance!!!
Im not real sure how you are 'supposed' to do it...but this is how I am doing it.
Public Sub VersionControl()
Dim equal As Boolean
Dim iResponse As Integer
Dim iCurrentVersion As Single
Dim iVersionNumber As Single
Dim regKey As String
On Error GoTo Trapper
'retrieve newest available version from web
txtCurrentVersion.Text = getsourcecode("http://members.xoom.com/BVozza/Version.html")
'Check version located in registry, if none(1st time) then save as version 1.0
If regKey = "" Then
regKey = "1.0"
SaveSettingString HKEY_CURRENT_USER, "Software\oKID\VersionNum", "String", regKey
Else
regKey = GetSettingString(HKEY_CURRENT_USER, "Software\oKID\VersionNum", "String", regKey)
End If
txtVersionNumber.Text = regKey
iCurrentVersion = Val(txtCurrentVersion)
iVersionNumber = Val(txtVersionNumber)
'Version comparisons
If iVersionNumber < iCurrentVersion And iVersionNumber <> iCurrentVersion Then
iResponse = MsgBox("There is a new version available." & Chr(13) & "Click the YES button to download the newsest version.", vbYesNo, "Download Now?")
If iResponse = 6 Then
MsgBox "Yes"
'Save File from web to app.path directory.
Else
Exit Sub
End If
'If user has newest version then proceed with startup
ElseIf iVersionNumber = iCurrentVersion Then
equal = True
End If
'Save settings in registry
SaveSettingString HKEY_CURRENT_USER, "Software\oKID\VersionNum", "String", txtCurrentVersion.Text
Trapper:
'error trap for no internet connection
End Sub
Then call VersionControl in either Form_Load or Form_Unload
You'll also need to list the API calls for the registry in a module.
Option Explicit
Public Const HKEY_CURRENT_USER = &H80000001
Public Const REG_SZ = 1
Public Const ERROR_SUCCESS = 0&
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Public Sub CreateKey(hKey As Long, strPath As String)
Dim hCurKey As Long
Dim lRegResult As Long
lRegResult = RegCreateKey(hKey, strPath, hCurKey)
If lRegResult <> ERROR_SUCCESS Then
' there is a problem
MsgBox "There was an error while attempting to write to the registry."
End If
lRegResult = RegCloseKey(hCurKey)
End Sub
Public Function GetSettingString(hKey As Long, strPath As String, strValue As String, Optional Default As String) As String
Dim hCurKey As Long
Dim lValueType As Long
Dim strBuffer As String
Dim lDataBufferSize As Long
Dim intZeroPos As Integer
Dim lRegResult As Long
' Set up default value
If Not IsEmpty(Default) Then
GetSettingString = Default
Else
GetSettingString = ""
End If
' Open the key and get length of string
lRegResult = RegOpenKey(hKey, strPath, hCurKey)
lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, ByVal 0&, lDataBufferSize)
If lRegResult = ERROR_SUCCESS Then
If lValueType = REG_SZ Then
' initialise string buffer and retrieve string
strBuffer = String(lDataBufferSize, " ")
lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, ByVal strBuffer, lDataBufferSize)
' format string
intZeroPos = InStr(strBuffer, Chr$(0))
If intZeroPos > 0 Then
GetSettingString = Left$(strBuffer, intZeroPos - 1)
Else
GetSettingString = strBuffer
End If
End If
Else
End If
lRegResult = RegCloseKey(hCurKey)
End Function
Public Sub SaveSettingString(hKey As Long, strPath As String, strValue As String, strData As String)
Dim hCurKey As Long
Dim lRegResult As Long
lRegResult = RegCreateKey(hKey, strPath, hCurKey)
lRegResult = RegSetValueEx(hCurKey, strValue, 0, REG_SZ, ByVal strData, Len(strData))
If lRegResult <> ERROR_SUCCESS Then
'there is a problem
MsgBox "There was an error writing to your registry."
End If
lRegResult = RegCloseKey(hCurKey)
End Sub
**In my package & deployment wizard I set a registry key to specify the path of installation. I'll use this value to download the new version from web to the users system.
I hope this helps. If you need more explanation on [email protected]
dubi
Awsome that actually helped alot, thanks!
I had one more question though, does anybody know how to somehow allow only authorized users to download the file by using HTTP not FTP? Is there any way u can set a password or something on it???