VB - Update program-VBForums
Results 1 to 4 of 4

Thread: VB - Update program

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2002
    Location
    Utah
    Posts
    397

    VB - Update program

    Any way to do it better?

    VB Code:
    1. Private Function CheckForFile(FileName) As Boolean
    2. 'Check if file exists
    3. CheckForFile = (Dir(FileName) <> "")
    4. End Function
    5.  
    6. Private Sub Patch()
    7. On Error GoTo err
    8. Dim intLocalVer As Integer
    9. Dim b() As Byte
    10. Dim intRemoteVer As Integer
    11. Dim strRemoteVer As String
    12. Dim doUpdate As Boolean
    13.  
    14. '1. Open the local version file and read in the number
    15.  
    16. Open App.Path & "\curversion.dat" For Input As #1
    17. intLocalVer = CInt(Input(LOF(1), 1))
    18. Close 1
    19.  
    20. '2. Download the remote version file and read in the number
    21. ' Note: This is all one line:
    22. Text1.Text = "Connecting..."
    23. b() = InetUpdate.OpenURL("http://www.ofpnam.com/hammy/comref/remotever.dat", 1)
    24. Text1.Text = "Connecting..." & vbNewLine & "Connected"
    25. Text1.Text = "Connecting..." & vbNewLine & "Connected" & vbNewLine & "Checking for updates..."
    26. strRemoteVer = ""
    27.  
    28. For t = 0 To UBound(b)
    29. strRemoteVer = strRemoteVer + Chr(b(t))
    30. Next
    31.  
    32. intRemoteVer = Int(strRemoteVer)
    33.  
    34. '3. Compare numbers
    35.  
    36. If intRemoteVer > intLocalVer Then
    37. 'Note: This is all one line:
    38.     Text1.Text = "Connecting..." & vbNewLine & "Connected" & vbNewLine & "Checking for updates..." & vbNewLine & "Update available"
    39.     Text1.SelStart = Len(Text1.Text)
    40.     upd = MsgBox("New version available, would you like to update it now? " & vbNewLine & "Please be patient, This may take a few minutes depending on connection speed.", vbYesNo Or vbQuestion)
    41.     If upd = vbYes Then
    42.         doUpdate = True
    43.     End If
    44.     If upd = vbNo Then
    45.         doUpdate = False
    46.         Text1.Text = "Connecting..." & vbNewLine & "Connected" & vbNewLine & "Checking for updates..." & vbNewLine & "Update available" & vbNewLine & "Canceled"
    47.         Text1.SelStart = Len(Text1.Text)
    48.         'Pause 2
    49.     End If
    50. Else
    51.     'MsgBox "You have the most recent version of this program."
    52.     Text1.Text = "Connecting..." & vbNewLine & "Connected" & vbNewLine & "Checking for updates..." & vbNewLine & "You have the most recent version!"
    53.     Text1.SelStart = Len(Text1.Text)
    54.     'Pause 2
    55.     doUpdate = False
    56. End If
    57.  
    58. '4. If doupdate = True, then download the latest program exe from the site
    59.  
    60. If doUpdate Then
    61. 'Note: This is all one line:
    62. Text1.Text = "Connecting..." & vbNewLine & "Connected" & vbNewLine & "Checking for updates..." & vbNewLine & "Update available" & vbNewLine & "Downloading..."
    63. Text1.SelStart = Len(Text1.Text)
    64.  
    65. b() = InetUpdate.OpenURL("http://www.ofpnam.com/hammy/comref/1200.exe", 1)
    66. Open App.Path & "\1200.exe" For Binary Access Write As #1
    67. Put #1, , b()
    68. Close 1
    69.  
    70. b() = InetUpdate.OpenURL("http://www.ofpnam.com/hammy/comref/1200r.txt", 1)
    71.             Open App.Path & "\1200r.txt" For Binary As #1
    72.             Put #1, , b()
    73.             Close #1
    74.            
    75. Text1.Text = "Connecting..." & vbNewLine & "Connected" & vbNewLine & "Checking for updates..." & vbNewLine & "Update available" & vbNewLine & "Downloading..." & vbNewLine & "Download Complete!" & vbNewLine & "Installing..."
    76.             Text1.SelStart = Len(Text1.Text)
    77.             'Name App.Path & "\ComRef.exe" As App.Path & "\OComRef.exe"
    78.             Kill App.Path & "\ComRef.exe"
    79.             'Kill App.Path & "\ComRef.exe"
    80.             If CheckForFile(App.Path & "\Readme.doc") Then
    81.                 Kill App.Path & "\Readme.doc"
    82.             Else
    83.                 Kill App.Path & "\Readme.txt"
    84.             End If
    85.             Name App.Path & "\1200r.txt" As App.Path & "\Readme.doc"
    86.             Name App.Path & "\1200.exe" As App.Path & "\ComRef.exe"
    87.             'Kill App.Path & "\OComRef.exe"
    88.  
    89. 'Now save the current version into the local version file
    90.  
    91. Open App.Path & "\curversion.dat" For Output As #1
    92. Print #1, strRemoteVer
    93. Close 1
    94.  
    95. Text1.Text = "Connecting..." & vbNewLine & "Connected" & vbNewLine & "Checking for updates..." & vbNewLine & "Update available" & vbNewLine & "Downloading..." & vbNewLine & "Download Complete!" & vbNewLine & "Installing..." & vbNewLine & "Installation Complete!" & vbNewLine & "Update was successful"
    96.             Text1.SelStart = Len(Text1.Text)
    97.  
    98. End If
    99. err:
    100. If err.Number = 13 Then
    101.     MsgBox "Error connecting, please make sure you are connected to the internet.", vbCritical
    102.     Text1.Text = "Connecting..." & vbNewLine & "Could not connect to server"
    103. 'Else
    104.     'MsgBox err.Number & vbNewLine & err.Description
    105. End If
    106.  
    107. If err.Number = 53 Then
    108.     MsgBox "Error finding files" & vbNewLine & "Please make sure the files: ComRef.exe, Update.exe, Readme.txt Or Readme.doc, and curversion.dat are in the same directory", vbCritical
    109. End If
    110. End Sub
    111.  
    112. Public Sub Form_Unload(cancel As Integer)
    113. On Error GoTo weeee:
    114.     Shell App.Path & "\ComRef", vbNormalFocus
    115.     GoTo end2
    116. weeee:
    117.     MsgBox "Could not find ComRef.exe, Update may have not been successful"
    118.     GoTo end2
    119. end2:
    120.     Dim frm As Form
    121.  
    122.     For Each frm In Forms
    123.  
    124.         Unload frm
    125.  
    126.         Set frm = Nothing
    127.  
    128.     Next
    129.  
    130. End Sub
    131.  
    132. Private Sub Timer1_Timer()
    133. Patch
    134. Timer1.Enabled = False
    135. End Sub

  2. #2
    Frenzied Member agmorgan's Avatar
    Join Date
    Dec 2000
    Location
    Lurking
    Posts
    1,383
    I have taken the code from About.com (which is what the above is based on I think) and made it into an ActiveX control.
    It has a reference to Microsoft Scripting Runtime and uses the Microsoft Internet Transfer control.

    Usage
    Select it from the list of components and put it on your form.
    It is invisible at runtime.
    Set the property RemoteEXE to the file you want to update to.
    The path must start with file:// or http://
    VB Code:
    1. ctlUpdate1.Update

    What it does
    Uses GetModuleFileName to get the filename of the main exe
    Uses FileSystemObject to get the version numbers of both files
    Compares the versions.

    On updating,
    The remote file is copied to the local directory
    A batch file is created
    TerminateProcess closes the main exe
    The batch file deletes the main exe,
    The batch file renames the downloaded exe to the main exe name,
    The batch file restarts the new exe
    The batch file deletes itself.

    Thanks
    Thanks to crptcblade and Aaron Young for the API help
    Thanks to anyone else who recognises their code that I might have copied.

    I have pasted the code below, but also attached the project.

    VB Code:
    1. Option Explicit
    2. 'Default Property Values:
    3. Const m_def_RemoteEXE = ""
    4. 'Property Variables:
    5. Dim m_RemoteEXE As String
    6.  
    7. Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, _
    8.                                                                                       ByVal lpFileName As String, _
    9.                                                                                       ByVal nSize As Long) As Long
    10. Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
    11. Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
    12.                                                                                     ByVal lpszShortPath As String, _
    13.                                                                                     ByVal lBuffer As Long) As Long
    14.  
    15. Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
    16. Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    17. Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
    18. Private Declare Function TerminateProcess Lib "Kernel32.dll" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
    19. Private Const PROCESS_TERMINATE As Long = (&H1)
    20.  
    21.  
    22.  
    23. Private Function GetShortPath(strFileName As String) As String
    24.     'KPD-Team 1999
    25.     'URL: [url]http://www.allapi.net/[/url]
    26.     'E-Mail: [email]KPDTeam@Allapi.net[/email]
    27.     Dim lngRes As Long, strPath As String
    28.     'Create a buffer
    29.     strPath = String$(165, 0)
    30.     'retrieve the short pathname
    31.     lngRes = GetShortPathName(strFileName, strPath, 164)
    32.     'remove all unnecessary chr$(0)'s
    33.     GetShortPath = Left$(strPath, lngRes)
    34. End Function
    35.  
    36. ' Return the path of a given full path to a file
    37. '
    38. Private Function returnPathOfFile(ByVal strFile As String) As String
    39.     returnPathOfFile = Left(strFile, InStrRev(strFile, "\"))
    40. End Function
    41.  
    42. ' Return the filename of a given full path to a file
    43. '
    44. Private Function returnNameOfFile(ByVal strFile As String) As String
    45.     returnNameOfFile = Mid(strFile, InStrRev(strFile, "\") + 1)
    46. End Function
    47.  
    48. Private Function Terminator()
    49.     Dim objParent As Object
    50.     Dim lngHwnd As Long
    51.     Dim lngPID As Long
    52.    
    53.    
    54.     ' Locate the Form on which the control is placed
    55.     ' (not strictly necessary, but ensures a reliable Hwnd)
    56.     Set objParent = UserControl.Extender.Parent
    57.     While Not (TypeOf objParent Is Form)
    58.         Set objParent = objParent.Parent
    59.     Wend
    60.     lngHwnd = objParent.hwnd
    61.    
    62.     ' No Hwnd, no Return value
    63.     If lngHwnd = 0 Then
    64.         Exit Function
    65.     End If
    66.    
    67.     ' Get the owning Process ID
    68.     Call GetWindowThreadProcessId(lngHwnd, lngPID)
    69.    
    70.    
    71.    
    72.     Dim Prog As Long
    73.     Prog = OpenProcess(PROCESS_TERMINATE, lngHwnd, lngPID)
    74.     If Prog Then
    75.         TerminateProcess Prog, lngHwnd
    76.         CloseHandle Prog
    77.     Else
    78.         MsgBox "You can't Kill This Process, Maybe because it's important for System"
    79.     End If
    80. End Function
    81.  
    82.  
    83.  
    84.  
    85.  
    86. Private Sub UserControl_Initialize()
    87.     cmdImage.Left = 0
    88.     cmdImage.Top = 0
    89.     UserControl.Width = cmdImage.Width
    90.     UserControl.Height = cmdImage.Height
    91. End Sub
    92.  
    93. 'Initialize Properties for User Control
    94. Private Sub UserControl_InitProperties()
    95.     m_RemoteEXE = m_def_RemoteEXE
    96. End Sub
    97.  
    98. 'Load property values from storage
    99. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    100.     m_RemoteEXE = PropBag.ReadProperty("RemoteEXE", m_def_RemoteEXE)
    101. End Sub
    102.  
    103. Private Sub UserControl_Resize()
    104.     UserControl.Width = cmdImage.Width
    105.     UserControl.Height = cmdImage.Height
    106. End Sub
    107.  
    108. 'Write property values to storage
    109. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    110.     Call PropBag.WriteProperty("RemoteEXE", m_RemoteEXE, m_def_RemoteEXE)
    111. End Sub
    112.  
    113. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
    114. 'MemberInfo=0
    115. Public Function Update() As Boolean
    116. Dim b() As Byte
    117. Dim strLocalNum() As String
    118. Dim strRemoteNum() As String
    119. Dim strLocalVer As String
    120. Dim strRemoteVer As String
    121. Dim blnUpdate As Boolean
    122.  
    123. Dim fsoFile As File
    124. Dim FSO As FileSystemObject
    125. Dim strFileName As String
    126. Dim strPath As String
    127. Dim strFile As String
    128. Dim i As Long
    129.  
    130.     'Get full path of parent exe (i.e. the local file)
    131.     strFileName = Space$(255)
    132.     Call GetModuleFileName(GetModuleHandle(vbNullString), strFileName, Len(strFileName))
    133.     strFileName = Split(strFileName, vbNullChar)(0)
    134.     strPath = returnPathOfFile(strFileName)
    135.     strFile = returnNameOfFile(strFileName)
    136.    
    137.     'Get the version number of the local file
    138.     Set FSO = New FileSystemObject
    139.     Set fsoFile = FSO.GetFile(strFileName)
    140.     strLocalVer = FSO.GetFileVersion(strFileName)
    141.  
    142.     'Get the version number of the remote file
    143.     strFileName = Right(m_RemoteEXE, Len(m_RemoteEXE) - 7)
    144.     Set FSO = New FileSystemObject
    145.     Set fsoFile = FSO.GetFile(strFileName)
    146.     strRemoteVer = FSO.GetFileVersion(strFileName)
    147.  
    148.  
    149.     'Compare version numbers
    150.     If strRemoteVer = strLocalVer Then
    151.         blnUpdate = False
    152.     Else
    153.         strRemoteNum() = Split(strRemoteVer, ".")
    154.         strLocalNum() = Split(strLocalVer, ".")
    155.         'Compare major, then minor, then revision
    156.         For i = 0 To UBound(strRemoteNum)
    157.             If CInt(strRemoteNum(i)) > CInt(strLocalNum(i)) Then
    158.                 If MsgBox("A more recent version of this program exists. Would you like to update it now?", vbYesNo Or vbQuestion) = vbYes Then
    159.                     blnUpdate = True
    160.                 Else
    161.                     blnUpdate = False
    162.                 End If
    163.                 Exit For
    164.             ElseIf CInt(strRemoteNum(i)) < CInt(strLocalNum(i)) Then
    165.                 blnUpdate = False
    166.                 Exit For
    167.             Else
    168.                 'ie values are the same
    169.                 blnUpdate = False
    170.                
    171.             End If
    172.         Next
    173.     End If
    174.  
    175.     'If blnUpdate = True, then download the latest program exe from the remote site
    176.     If blnUpdate Then
    177.         'Copy the remote file into byte variable
    178.  
    179.         b() = InetUpdate.OpenURL(m_RemoteEXE, 1)
    180.         'Write it as a temporary file
    181.         Open strPath & "\update.exe" For Binary Access Write As #1
    182.             Put #1, , b()
    183.         Close 1
    184.  
    185.         'Write a batch file to delete running exe, rename updated exe, run updated exe
    186.         'and delete the batch file itself
    187.         strPath = GetShortPath(strPath) & "\test.bat"
    188.         Open strPath For Output As #1
    189.             Print #1, "@echo off"
    190.             Print #1, ":start"
    191.             Print #1, "cls"
    192.             Print #1, "del " & strFile
    193.             Print #1, "if  exist " & Chr$(34) & strFile & Chr$(34) & " goto start"
    194.             Print #1, "ren update.exe " & strFile
    195.             Print #1, strFile
    196.             Print #1, "del test.bat"
    197.         Close #1
    198.         Shell strPath
    199.         Terminator
    200.    
    201.     Else
    202.         MsgBox "You already have the most recent version of this program."
    203.     End If
    204.  
    205. End Function
    206.  
    207.  
    208. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
    209. 'MemberInfo=13,0,0,
    210. Public Property Get RemoteEXE() As String
    211.     RemoteEXE = m_RemoteEXE
    212. End Property
    213.  
    214. Public Property Let RemoteEXE(ByVal New_RemoteEXE As String)
    215.     m_RemoteEXE = New_RemoteEXE
    216.     PropertyChanged "RemoteEXE"
    217. End Property
    Attached Files Attached Files

  3. #3
    Super Moderator si_the_geek's Avatar
    Join Date
    Jul 2002
    Location
    Bristol, UK
    Posts
    37,162
    The code/files within this thread (submitted: 10-20-2004) have been checked for malware by a moderator.

    Disclaimer: This does not necessarily mean that any compiled files (DLL/EXE/OCX etc) are completely safe, but any supplied code does not contain any obvious malware. It also does not imply that code is error free, or that it performs exactly as described.

    It is recommended that you manually check any code before running it, and/or use an automated tool such as Source Search by Minnow (available here or here).
    If you find any serious issues (ie: the code causes damage or some sort), please contact a moderator of this forum.

    Usage of any code/software posted on this forum is at your own risk.

  4. #4
    Lively Member
    Join Date
    Jun 2010
    Location
    Spain
    Posts
    79

    Re: VB - Update program

    there is some sample for this function in vb.net?

    for example what is the best replacement for msinet.ocx .OpenURL ?

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.