Ето кода, описанието е след него...

'

'    Add in Form_Load or Sub Main procedure this code:

'

'            If Right(App.EXEName, 4) = "_new" Then CheckVersion 1 Else CheckVersion 2

'

'

'

'    In "CheckVersion" procedure add:

'

'            CheckVersion

'

'

' Enjoy ;o)

'



Option Explicit



Public Sub CheckVersion(Optional UpdateOption As Integer)



    On Error GoTo ErrHandle

    

    Dim intTim As Long, http, s As String, strFile As String, strServer As String

    strFile = Replace(App.Path & "\" & App.EXEName & ".exe", "\\", "\")

    

    ' !!! Server address !!!

    strServer = "http://store1.data.bg/user/"

    

    Select Case UpdateOption

        Case 0

            Set http = CreateObject("MSXML2.XMLHTTP")

            http.Open "GET", strServer & App.EXEName & ".exe_version.txt", False

            http.send

            

            'Check version

            s = http.responseText

            If Val(s) > Val(App.Revision) Then

                If MsgBox("New version found. Do you want download and install it?", vbYesNo, _

                          "New version") = vbYes Then

                    'Update program

                    Dim b() As Byte

                    http.Open "GET", strServer & App.EXEName & ".exe_install.bin", False

                    http.send

                    b = http.responseBody

                    If Dir(strFile & "_new.exe") <> "" Then Kill strFile & "_new.exe"

                    Open strFile & "_new.exe" For Binary As #1: DoEvents: Put #1, , b: Close

                    

                    intTim = Timer

                    Do Until Timer > intTim + 3 Or Timer = 3

                        DoEvents

                    Loop

                    

                    Shell strFile & "_new.exe", vbMinimizedFocus

                    End

                    

                End If

            Else

                MsgBox "No new version found.", vbInformation

            End If

            

            Exit Sub

            

        Case 1

            

            intTim = Timer

            Do Until Timer > intTim + 3 Or Timer = 3

                DoEvents

            Loop

            

            If Dir(Left(strFile, Len(strFile) - 8)) <> "" Then Kill Left(strFile, Len(strFile) - 8)

            FileCopy strFile, Left(strFile, Len(strFile) - 8)

            

            Shell Left(strFile, Len(strFile) - 8), vbNormalFocus

            End

            

            Exit Sub

            

        Case 2

            If Dir(strFile & "_new.exe") <> "" Then

                

                intTim = Timer

                Do Until Timer > intTim + 3 Or Timer = 3

                    DoEvents

                Loop

                

                Kill strFile & "_new.exe"

            End If

            

            Exit Sub

            

    End Select

    Exit Sub

    

ErrHandle:

    MsgBox "Error " & Err & ". " & Err.Description

End Sub