Автообновление

[Морфий]

Надо написать автообновление программы по сетке. Как лучше сделать? Исходники приветствуются

[sergey-911]

Пришли маил, скину проект вместе с osx компонентом, который при обновлении прокручивает прогресбар, как в винде.

[Морфий]

yssoft@inbox.ru

[timsoft]

если можно, то и мне скинь на chegotebe (собака) gmail.com

[KDima]

osx?
А по какой технологии он работает?
ActiveComCobraX

Вывешивайте в Public!
Я тоже хачу!

[sergey-911]

В программе, которая проверяется на обновление пишешь код, приведенный ниже. В инишнике указывается путь, куда выкладываются новые версии программы и название. Не забудь подключить библиотеку "scrrun.dll".
Хотелось бы узнать мнение, о предложенном мною варианте обновления.



Private Sub Form_Load()
'V Обновление версии программы ****************************************************************************************************************
Dim PutProg As String 'Путь к обновленной версии программы (указывается в файле "Obnovlenie.ini")
Dim Programma As String 'Путь к программе
Dim fso As New FileSystemObject 'Подключение библиотеки
PutProg = Empty
Programma = Empty
nFile = FreeFile 'Возвращаем следующий свободный номер файла
sAppPath = App.Path 'Определение местонахождения файлов с программой
If Right$(sAppPath, 1) <> "\" Then sAppPath = sAppPath & "\" 'Проверка на местонахождение на локальном диске
Err.Clear
On Error Resume Next
Open sAppPath & "Obnovlenie.ini" For Input As #nFile 'Открытие файла для последовательного считывания
If Err.Number > 0 Then GoTo Er1
Line Input #nFile, PutProg 'Последовательно считываем данные из файла
Line Input #nFile, Programma 'Последовательно считываем данные из файла
Close #nFile 'Закрываем файл
If Err.Number > 0 Then GoTo Er2 'Если файл "Obnovlenie.ini" отсутствует на сервере программой
File1 = Empty
Set File1 = fso.GetFile(sAppPath & Programma) 'Путь к файлу в каталоге с программой
GoTo Er2
Er1: 'Если файл "Obnovlenie.ini" отсутствует в папке с программой
Err.Clear
PutProg = Empty
Programma = Empty
PutProg = "C:\LastVer$\"
Programma = "Avtomagazin.exe"
nFile = FreeFile 'Возвращаем следующий свободный номер файла
sAppPath = App.Path 'Определение местонахождения файлов с программой
If Right$(sAppPath, 1) <> "\" Then sAppPath = sAppPath & "\" 'Проверка на местонахождение на локальном диске
Open sAppPath & "Obnovlenie.ini" For Output As #nFile 'Создаем файл с параметрами соединения
Print #nFile, CStr(PutProg)
Print #nFile, CStr(Programma)
Close #nFile
PutProg = Empty
Programma = Empty
nFile = FreeFile 'Возвращаем следующий свободный номер файла
sAppPath = App.Path 'Определение местонахождения файлов с программой
If Right$(sAppPath, 1) <> "\" Then sAppPath = sAppPath & "\" 'Проверка на местонахождение на локальном диске
Open sAppPath & "Obnovlenie.ini" For Input As #nFile 'Открытие файла для последовательного считывания
Line Input #nFile, PutProg 'Последовательно считываем данные из файла
Line Input #nFile, Programma 'Последовательно считываем данные из файла
Close #nFile 'Закрываем файл
File1 = Empty
Set File1 = fso.GetFile(sAppPath & Programma) 'Путь к файлу в каталоге с программой
If Err.Number > 0 Then GoTo Er2
Er2:
Err.Clear
File2 = Empty
Set File2 = fso.GetFile(PutProg & Programma) 'Путь к обновленному файлу
If Err.Number > 0 Then GoTo Er3
Er3:
Err.Clear
On Error Resume Next
If File1 <> "" And File2 <> "" Then
Set File1 = fso.GetFile(sAppPath & Programma) 'Путь к файлу в каталоге с программой
If Err.Number > 0 Then GoTo Er4
Set File2 = fso.GetFile(PutProg & Programma) 'Путь к обновленному файлу
If Err.Number > 0 Then GoTo Er4
Dim Ver1, Ver2 As String
Ver1 = fso.GetFileVersion(File1)
If Err.Number > 0 Then GoTo Er4
Ver2 = fso.GetFileVersion(File2)
If Err.Number > 0 Then GoTo Er4
If Ver1 = "" Then
Ver1 = Empty
Else
Ver1 = Replace(Ver1, ".", "") 'Убираем точки в значении версии
If Err.Number > 0 Then GoTo Er4
End If
If Ver2 = "" Then
Ver2 = Empty
Else
Ver2 = Replace(Ver2, ".", "") 'Убираем точки в значении версии
If Err.Number > 0 Then GoTo Er4
End If
If CInt(Ver1) < CInt(Ver2) Then 'Проверка на более новую версию
If Err.Number > 0 Then GoTo Er4
Call Shell(sAppPath & "Obnovlenie.exe", vbNormalFocus) 'Запуск программы
If Err.Number > 0 Then GoTo Er4
End
End If
End If
Er4:
Err.Clear
On Error Resume Next
'A Обновление версии программы ****************************************************************************************************************
End Sub