Option Explicit
'Default Property Values:
Const m_def_RemoteEXE = ""
'Property Variables:
Dim m_RemoteEXE As String
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, _
ByVal lpFileName As String, _
ByVal nSize As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal lBuffer As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
Private Declare Function TerminateProcess Lib "Kernel32.dll" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Const PROCESS_TERMINATE As Long = (&H1)
Private Function GetShortPath(strFileName As String) As String
'KPD-Team 1999
'URL: [url]http://www.allapi.net/[/url]
'E-Mail: [email]KPDTeam@Allapi.net[/email]
Dim lngRes As Long, strPath As String
'Create a buffer
strPath = String$(165, 0)
'retrieve the short pathname
lngRes = GetShortPathName(strFileName, strPath, 164)
'remove all unnecessary chr$(0)'s
GetShortPath = Left$(strPath, lngRes)
End Function
' Return the path of a given full path to a file
'
Private Function returnPathOfFile(ByVal strFile As String) As String
returnPathOfFile = Left(strFile, InStrRev(strFile, "\"))
End Function
' Return the filename of a given full path to a file
'
Private Function returnNameOfFile(ByVal strFile As String) As String
returnNameOfFile = Mid(strFile, InStrRev(strFile, "\") + 1)
End Function
Private Function Terminator()
Dim objParent As Object
Dim lngHwnd As Long
Dim lngPID As Long
' Locate the Form on which the control is placed
' (not strictly necessary, but ensures a reliable Hwnd)
Set objParent = UserControl.Extender.Parent
While Not (TypeOf objParent Is Form)
Set objParent = objParent.Parent
Wend
lngHwnd = objParent.hwnd
' No Hwnd, no Return value
If lngHwnd = 0 Then
Exit Function
End If
' Get the owning Process ID
Call GetWindowThreadProcessId(lngHwnd, lngPID)
Dim Prog As Long
Prog = OpenProcess(PROCESS_TERMINATE, lngHwnd, lngPID)
If Prog Then
TerminateProcess Prog, lngHwnd
CloseHandle Prog
Else
MsgBox "You can't Kill This Process, Maybe because it's important for System"
End If
End Function
Private Sub UserControl_Initialize()
cmdImage.Left = 0
cmdImage.Top = 0
UserControl.Width = cmdImage.Width
UserControl.Height = cmdImage.Height
End Sub
'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
m_RemoteEXE = m_def_RemoteEXE
End Sub
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_RemoteEXE = PropBag.ReadProperty("RemoteEXE", m_def_RemoteEXE)
End Sub
Private Sub UserControl_Resize()
UserControl.Width = cmdImage.Width
UserControl.Height = cmdImage.Height
End Sub
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("RemoteEXE", m_RemoteEXE, m_def_RemoteEXE)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0
Public Function Update() As Boolean
Dim b() As Byte
Dim strLocalNum() As String
Dim strRemoteNum() As String
Dim strLocalVer As String
Dim strRemoteVer As String
Dim blnUpdate As Boolean
Dim fsoFile As File
Dim FSO As FileSystemObject
Dim strFileName As String
Dim strPath As String
Dim strFile As String
Dim i As Long
'Get full path of parent exe (i.e. the local file)
strFileName = Space$(255)
Call GetModuleFileName(GetModuleHandle(vbNullString), strFileName, Len(strFileName))
strFileName = Split(strFileName, vbNullChar)(0)
strPath = returnPathOfFile(strFileName)
strFile = returnNameOfFile(strFileName)
'Get the version number of the local file
Set FSO = New FileSystemObject
Set fsoFile = FSO.GetFile(strFileName)
strLocalVer = FSO.GetFileVersion(strFileName)
'Get the version number of the remote file
strFileName = Right(m_RemoteEXE, Len(m_RemoteEXE) - 7)
Set FSO = New FileSystemObject
Set fsoFile = FSO.GetFile(strFileName)
strRemoteVer = FSO.GetFileVersion(strFileName)
'Compare version numbers
If strRemoteVer = strLocalVer Then
blnUpdate = False
Else
strRemoteNum() = Split(strRemoteVer, ".")
strLocalNum() = Split(strLocalVer, ".")
'Compare major, then minor, then revision
For i = 0 To UBound(strRemoteNum)
If CInt(strRemoteNum(i)) > CInt(strLocalNum(i)) Then
If MsgBox("A more recent version of this program exists. Would you like to update it now?", vbYesNo Or vbQuestion) = vbYes Then
blnUpdate = True
Else
blnUpdate = False
End If
Exit For
ElseIf CInt(strRemoteNum(i)) < CInt(strLocalNum(i)) Then
blnUpdate = False
Exit For
Else
'ie values are the same
blnUpdate = False
End If
Next
End If
'If blnUpdate = True, then download the latest program exe from the remote site
If blnUpdate Then
'Copy the remote file into byte variable
b() = InetUpdate.OpenURL(m_RemoteEXE, 1)
'Write it as a temporary file
Open strPath & "\update.exe" For Binary Access Write As #1
Put #1, , b()
Close 1
'Write a batch file to delete running exe, rename updated exe, run updated exe
'and delete the batch file itself
strPath = GetShortPath(strPath) & "\test.bat"
Open strPath For Output As #1
Print #1, "@echo off"
Print #1, ":start"
Print #1, "cls"
Print #1, "del " & strFile
Print #1, "if exist " & Chr$(34) & strFile & Chr$(34) & " goto start"
Print #1, "ren update.exe " & strFile
Print #1, strFile
Print #1, "del test.bat"
Close #1
Shell strPath
Terminator
Else
MsgBox "You already have the most recent version of this program."
End If
End Function
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,
Public Property Get RemoteEXE() As String
RemoteEXE = m_RemoteEXE
End Property
Public Property Let RemoteEXE(ByVal New_RemoteEXE As String)
m_RemoteEXE = New_RemoteEXE
PropertyChanged "RemoteEXE"
End Property