Results 1 to 2 of 2

Thread: Software Update thru Web

  1. #1

    Thread Starter
    Lively Member
    Join Date
    May 2000
    Location
    Atlanta, GA
    Posts
    80

    Question

    Could someone point me to any example code that could be used for automatic web updates for an EXE?

    I would like to give my users an option to click "Update" and have the most recent version of the EXE downloaded and replace the current EXE.

    Thanks!
    Kevin

  2. #2
    Frenzied Member Jop's Avatar
    Join Date
    Mar 2000
    Location
    Amsterdam, the Netherlands
    Posts
    1,986
    Here's a template I made a while ago... it was for an app I made so the URL locations or the appname may stay in the prog, just change it... also you could drasticly improve the FileMove stuff (now with the API) but you can figure that out yourself

    Code:
    'In the form, put a Internet Transfer Control (Inet1)
    'a Label (lblStatus) and a ProgressBar (ProgressBar1)
    Option Explicit
    Dim Newver As String
    Public Curver As String
    Public cvfile As String
    Dim fn As Long
    Dim dl As String
    Dim dlFile() As Byte
    Dim dlPath As String
    
    Private Sub Form_Activate()
    On Error GoTo error:
    Newver = Inet1.OpenURL("http://YOURSITE/newver.txt")
    cvfile = App.Path & "\curver.txt"
    fn = FreeFile
    Open cvfile For Input As #fn
    Line Input #fn, Curver
    Close #fn
    If Newver > Curver Then
        dl = MsgBox("Update available! (" & Newver & " ) " & vbCrLf & "Do you want to download?", vbYesNo, "Update available!")
        lblStatus = "Update available!"
        ProgressBar1.Position = 0
            If dl = vbYes Then
                Call Download
            End If
    Else
        MsgBox "No updates available!", , "Update available!"
        lblStatus = "No updates available!"
        Shell App.Path & "\YOURAPP.exe", vbNormalFocus
        Unload Me
    End If
    error:
    Call errorH
    End Sub
    Function Download()
    On Error GoTo error
    'Delete .bak file
    If Dir(App.Path & "\YOURAPPNAME" & Curver & ".bak", vbNormal Or vbReadOnly Or vbHidden Or _
    vbSystem Or vbArchive) <> "" Then
        Kill App.Path & "\YOURAPPNAME" & Curver & ".bak"
    End If
    
    Dim lret As Long
    Dim fileop As SHFILEOPSTRUCT
    
    lblStatus.Caption = "YOURAPPNAMEr.exe > YOURAPPNAME.bak"
    With fileop
    .hwnd = 0
    .wFunc = FO_RENAME
    .pFrom = App.Path & "\YOURAPPNAMEOLD.exe" & vbNullChar & vbNullChar
    .pTo = App.Path & "\YOURAPPNAMENEW" & Curver & ".bak" & vbNullChar & vbNullChar
    .lpszProgressTitle = "Please wait, renaming APPNAME.exe to APPNAME.bak..."
    .fFlags = FOF_SIMPLEPROGRESS Or FOF_ALLOWUNDO
    End With
    
    lret = SHFileOP(fileop)
    
    'If Module1.result <> 0 Then 'Operation failed
    'MsgBox Err.LastDllError 'Show the error returned from the API.
    'Else
    'If fileop.fAnyOperationsAborted <> 0 Then
    'MsgBox "Operation Failed"
    'End If
    'End If
    
    'Download the file
    dlFile() = Inet1.OpenURL("http://YOURSITE/YOURAPPNAME.exe", icByteArray)
    'Put it in the dir
    fn = FreeFile
    dlPath = App.Path & "\YOURAPPNAME.exe"
    Open dlPath For Binary Access Write As #fn
    Put #fn, , dlFile()
    Close #fn
    
    'Write New FileVersion to curver.txt
    Open cvfile For Output As #fn
    Print #fn, Newver
    Close #fn
    
    Dim msg As String
    msg = "YOURAPPNAME succesfully updated!" & vbCrLf
    msg = msg & "Your old APPNAME is renamed to " & App.Path & "\APPNAME" & Curver & ".bak"
    ProgressBar1.Position = 0
    MsgBox msg, , "Succesfully updated!"
    'Run YOURAPPNAME.exe en Unload me!
        Shell App.Path & "\YOURAPPNAME.exe", vbNormalFocus
        Unload Me
    error:
    Call errorH
    End Function
    
    Private Sub Inet1_StateChanged(ByVal State As Integer)
    Select Case State
        Case icResolvingHost
            ProgressBar1.Position = 1
            lblStatus = "Connecting to server, please standby..."
        Case icHostResolved
            ProgressBar1.Position = 2
        Case icConnecting
            ProgressBar1.Position = 3
        Case icConnected
            ProgressBar1.Position = 4
       Case icRequesting
       lblStatus = "Checking for updates..."
            ProgressBar1.Position = 5
        Case icRequestSent
            ProgressBar1.Position = 6
        Case icReceivingResponse
            ProgressBar1.Position = 7
        Case icResponseReceived
            ProgressBar1.Position = 8
            lblStatus = "File version received..."
        Case icError
            ProgressBar1.Position = 0
            lblStatus = "An error occurred"
            MsgBox "There was an error proccessing the updater" & vbCrLf & Inet1.ResponseCode & vbCrLf & Inet1.ResponseCode
    End Select
    End Sub
    
    Function errorH()
    If Err.Number <> 0 Then
        MsgBox "There was an error proccessing the updater" & vbCrLf & Err.Number & vbCrLf & Err.Description, , "Error!"
    End If
    End Function
    and put this code in a module:

    Code:
    Option Explicit
    Public Declare Function SHFileOperation Lib _
    "shell32.dll" Alias "SHFileOperationA" _
    (lpFileOp As Any) As Long
    Public Declare Sub SHFreeNameMappings Lib _
    "shell32.dll" (ByVal hNameMappings As Long)
    
    Public Declare Sub CopyMemory Lib "KERNEL32" _
    Alias "RtlMoveMemory" (hpvDest As Any, hpvSource _
    As Any, ByVal cbCopy As Long)
    Public Type SHFILEOPSTRUCT
                   hwnd As Long
                   wFunc As FO_Functions
                   pFrom As String
                   pTo As String
                   fFlags As FOF_Flags
                   fAnyOperationsAborted As Long
                   hNameMappings As Long
                   lpszProgressTitle As String 'only used if FOF_SIMPLEPROGRESS
                   End Type
    
                   Public Enum FO_Functions
                   FO_MOVE = &H1
                   FO_COPY = &H2
                   FO_DELETE = &H3
                   FO_RENAME = &H4
                   End Enum
    
                   Public Enum FOF_Flags
                   FOF_MULTIDESTFILES = &H1
                   FOF_CONFIRMMOUSE = &H2
                   FOF_SILENT = &H4
                   FOF_RENAMEONCOLLISION = &H8
                   FOF_NOCONFIRMATION = &H10
                   FOF_WANTMAPPINGHANDLE = &H20
                   FOF_ALLOWUNDO = &H40
                   FOF_FILESONLY = &H80
                   FOF_SIMPLEPROGRESS = &H100
                   FOF_NOCONFIRMMKDIR = &H200
                   FOF_NOERRORUI = &H400
                   FOF_NOCOPYSECURITYATTRIBS = &H800
                   FOF_NORECURSION = &H1000
                   FOF_NO_CONNECTED_ELEMENTS = &H2000
                   FOF_WANTNUKEWARNING = &H4000
                   End Enum
    
                   Public Type SHNAMEMAPPING
                   pszOldPath As String
                   pszNewPath As String
                   cchOldPath As Long
                   cchNewPath As Long
                   End Type
    
    Public Function SHFileOP(ByRef lpFileOp As SHFILEOPSTRUCT) As Long
    'This uses a method suggested at MSKB to
    'ensure that all parameters are passed correctly
    'Call this wrapper rather than the API function directly
    
    Dim result As Long
    Dim lenFileop As Long
    Dim foBuf() As Byte
    
    lenFileop = LenB(lpFileOp)
    ReDim foBuf(1 To lenFileop) 'the size of the structure.
    
    'Now we need to copy the structure into a byte array
    Call CopyMemory(foBuf(1), lpFileOp, lenFileop)
    
    'Next we move the last 12 bytes by 2 to byte align the data
    Call CopyMemory(foBuf(19), foBuf(21), 12)
    result = SHFileOperation(foBuf(1))
    
    SHFileOP = result
    End Function
    If you need help ICQ me (18818940)
    Jop - validweb.nl

    Alcohol doesn't solve any problems, but then again, neither does milk.

Posting Permissions

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



Click Here to Expand Forum to Full Width