Модуль автообновления

ApxaHGe1 · #1 14.04.2017, 17:01

Ребята подскажите пожалуйста, почему не работает поток в отдельном модуле, я с потоками не дружу если честно вообще...
камнями не кидайте, делал чисто для себя. так как озадачили на работе, и что бы пользователям постоянно не сообщать что нужно обновиться, решил написать модуль самообновления.

Форма с прогресс баром то вроде открывается, но мало того что прогресс бар стоит на месте, так еще и файл даже не качается, пока не закроешь эту форму ....

Помогите...

Код:

procedure TForm1.FormCreate(Sender: TObject);
begin
Check_Update;
end;

Сам модуль авто обновления

Код:

unit Autoupdate;

type
   TUpdate = class(TThread)
protected
    procedure Execute; override;
end;

var
Server:string;
FVersion:string;
FSize:string;

HTTP:TIdHTTP;
HTTP2:TIdHTTP;
UpdateForm:TForm;
Update:TUpdate;
UpdateList:TStringList;
TotalSize:integer;
i,n:Integer;
ProgressBar: TProgressBar;
Log:Tmemo;
Stream:TMemoryStream;
FCount:integer;

procedure Check_Update;


implementation

uses MainForm;

//Поток обновления приложения
procedure TUpdate.Execute;
begin
HTTP2:=TIdHTTP.Create(nil);
try
Stream:=TMemoryStream.Create;

for FCount:=0 to UpdateList.Count - 1 do
begin

if FCount mod 2 = 0 then
begin
Log.Lines.Add('Загрузка файла: '+UpdateList.Strings[FCount]);
Log.Lines.Add('Размер загружаемого файла: '+UpdateList.Strings[FCount+1]);
HTTP2.Get(Server+UpdateList.Strings[FCount],Stream);
Stream.SaveToFile(ExtractFilePath(ParamStr(0))+'\'+UpdateList.Strings[FCount]+'_');
Stream.Free;
end;

end;
except
on E: Exception do
      ShowMessage (E.Message);
end;
end;

procedure HTTP2WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
ProgressBar.Max:=AWorkCountMax;
end;

procedure HTTP2Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
ProgressBar.Position:=ProgressBar.Position+AWorkCount;
end;

procedure Check_Update;
begin
try
HTTP:=TIdHTTP.Create(nil);
Server:='http://************.ru/soft/' ;
//получаем версию файла на сервере
FVersion:=HTTP.Get(Server+'ver.txt');
if Form1.Vers = FVersion then
begin
  ShowMEssage ('Вы используете актуальную версию программы!');
  exit;
end;

if Form1.Vers < FVersion then
begin
//Получаем список файлов для обновления
UpdateList:=TStringList.Create;
UpdateList.Text:=HTTP.Get(Server+'FileList.txt');
//Подсчитаем общий объем файлов для скачивания
for I := 0 to UpdateList.Count-1  do
begin
if i mod 2 = 1 then
begin
TotalSize:=TotalSize + StrToInt (UpdateList.Strings[i]) ;
end;
end;

UpdateForm:=TForm.Create(nil);
UpdateForm.Position:=poDesktopCenter;
UpdateForm.Caption:='Обновление ...';
UpdateForm.Height:=205;
UpdateForm.Width:=300;
UpdateForm.BorderStyle:=bsToolWindow;
ProgressBar:=TProgressBar.Create(nil);
ProgressBar.Parent:=UpdateForm;
ProgressBar.Height:=30;
ProgressBar.Width:=295;
ProgressBar.Visible:=True;
Log:=TMemo.Create(nil);
Log.Parent:=UpdateForm;
log.Top:=40;
Log.Width:=295;
Log.Height:=200;
Log.ScrollBars:=ssVertical;
Log.ReadOnly:=True;
Log.Lines.Add('Количество файлов для обновления: '+IntToStr (UpdateList.Count-1));
UpdateForm.ShowModal;
//Создадим поток
Update:= TUpdate.Create(false);
Update.Priority:= tpNormal;
Update.FreeOnTerminate:= true;
end;
except
on E: Exception do ShowMessage (E.Message);
end;

end;


end.

lmikle · #2 14.04.2017, 19:32

А ниче так, что форма модальная?

Код:

UpdateForm.ShowModal;

Ну, соответственно, процесс и ждет ее закрытия...

ApxaHGe1 · #3 15.04.2017, 15:58

Так как бы на ней и хотелось бы отобразить процесс обновления в ProgressBar'е
т.е. я правильно понял, если форма была бы не модальная, то все обновлялось бы?
Думаю что нет, и поэтому прошу помощи, в понедельник нужно сдать скомпилированный проект на работе.. что бы пользователи могли использовать готовое приложение, но как я говорил выше, без модуля автообновления будет трудно, каждый раз просить пользователей обновить приложение, т.к. будет допиливаться данное приложения, будут добавляться новые функции...

ApxaHGe1 · #4 15.04.2017, 17:37

Действительно, если изменить

Код:

UpdateForm.ShowModal;

на

Код:

UpdateForm.Show;

в логе обновления появляются строки, с информацией об обновлении

Код:

Количество файлов для обновления: 1
Загрузка файла: BAGIRA.exe
Размер загружаемого файла: 7762944

НО, прогресс бар стоит на месте

как его заставить шевелиться то )

crazyman · #5 15.04.2017, 17:48

кидай таймер

ApxaHGe1 · #6 15.04.2017, 18:14

Цитата:

Сообщение от crazyman

кидай таймер

Код:

procedure TimerTimer(Sender: TObject);
begin
ProgressBar.Position:=Stream.Position;
end;

Ни какого результата

прогрессс бар стоит на месте ) в логе через определнное время просто получаю "Обновление завершено"

crazyman · #7 15.04.2017, 18:38

видимо stream.position равно нулю

@Rafa3L · #8 15.04.2017, 18:43

Код:

procedure HTTP2Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
begin 
 ProgressBar.Position:= AWorkCount;
end;

procedure HTTP2WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Int64);
begin 
 ProgressBar.Position:= 0; 
 ProgressBar.Max:= AWorkcountMax;
end;

ApxaHGe1 · #9 15.04.2017, 18:46

Цитата:

Сообщение от crazyman

видимо stream.position равно нулю

Stream Len = 7762944

Код:

========Доступно оновление 1.1========
Количество файлов для обновления: 2
Общий объем обновления: 140888888
____________________________________________
Загрузка файла: BAGIRA.exe
Размер загружаемого файла: 8888888
Stream Pos = 7762944 //показывает после завершения скачивания
Загрузка файла: Setup.exe
Размер загружаемого файла: 132000000

Кстати,

Код:

procedure TimerTimer(Sender: TObject);
begin
ShowMessage (IntToStr(Stream.Position));
ProgressBar.Position:=Stream.Position;
end;

почему то не выполняется ...

Код:

procedure TUpdate.Execute;
begin
Timer:=TTImer.Create(nil);
Timer.Interval:=50;
Timer.Enabled:=True;

ApxaHGe1 · #10 15.04.2017, 19:07

Цитата:

Сообщение от @Rafa3L

Код:

procedure HTTP2Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
begin 
 ProgressBar.Position:= AWorkCount;
end;

procedure HTTP2WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Int64);
begin 
 ProgressBar.Position:= 0; 
 ProgressBar.Max:= AWorkcountMax;
end;

Спасибо, но как бы в своем коде я это использую. Но нет результата ....
Извиняюсь, но этого просто нет в листинге 1 поста, не стал копировать.

ApxaHGe1 · #11 15.04.2017, 19:11

Приведу еще раз полный листинг данного юнита, которы работает, делает то что мне нужно... но вот хотелось бы отображение хода процесса загрузки, что бы пользователь е думал что обновление остановилось/не запустилось...
Да же если закрыть форму обновления, то поток то работает как надо, закачивает все файлы обновления......

Помогите сделать прогресс бар ...

Жаль на форуме нет spoiler

Код:

type
   TUpdate = class(TThread)
protected
    procedure Execute; override;
end;

var
Server:string;
FVersion:string;
FSize:string;

HTTP:TIdHTTP;
HTTP2:TIdHTTP;
UpdateForm:TForm;
Update:TUpdate;
UpdateList:TStringList;
TotalSize:integer;
i,n:Integer;
ProgressBar: TProgressBar;
Log:Tmemo;
Stream:TMemoryStream;
FCount:integer;
Timer:TTimer;
//Статус обновления
UpdStatus:integer=0;

procedure Check_Update;


implementation

uses MainForm;


procedure HTTP2Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
begin
 ProgressBar.Position:= AWorkCount;
end;

procedure HTTP2WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Int64);
begin
 ProgressBar.Position:= 0;
 ProgressBar.Max:= AWorkcountMax;
end;


procedure TimerTimer(Sender: TObject);
begin
//ShowMessage (IntToStr(Stream.Position));
ProgressBar.Position:=Stream.Position;
end;

//Поток обновления приложения
procedure TUpdate.Execute;
begin
//synchronize(Check_Update);
//Делаем форму видимой из за главной формы
UpdateForm.BringToFront;
//TForm(Sender).BringToFront;
HTTP2:=TIdHTTP.Create(nil);
try
Stream:=TMemoryStream.Create;
//Обрабатываем в цикле информацию о файлах и объем файлов
//для обновления
for FCount:=0 to UpdateList.Count - 1 do
begin
//Выбираем из списка имена файлов обновления
if FCount mod 2 = 0 then
begin
Log.Lines.Add('Загрузка файла: '+UpdateList.Strings[FCount]);
Log.Lines.Add('Размер загружаемого файла: '+UpdateList.Strings[FCount+1]);
HTTP2.Get(Server+UpdateList.Strings[FCount],Stream);
Log.Lines.Add('Stream Pos = '+IntToStr (Stream.Position));
ProgressBar.Max:=StrToInt (UpdateList.Strings[FCount+1]);
Timer.Enabled:=True;
Stream.SaveToFile(ExtractFilePath(ParamStr(0))+'\'+UpdateList.Strings[FCount]+'_');
end;
Stream.Position:=0;
Timer.Enabled:=False;
end;
//Окончание обновления
UpdateForm.Canvas.Create;
Stream.Free;
Log.Lines.Add('Обновление успешно завершено!');
//Теперь нужно перезапустить программу
except
on E: Exception do
      ShowMessage (E.Message);
end;

end;

procedure Check_Update;
begin
try
HTTP:=TIdHTTP.Create(nil);
Server:='http://********.ru/soft/' ;
//получаем версию файла на сервере
FVersion:=HTTP.Get(Server+'ver.txt');
if Form1.Vers = FVersion then
begin
  ShowMEssage ('Вы используете актуальную версию программы!');
  exit;
end;

if Form1.Vers < FVersion then
begin
//Получаем список файлов для обновления
UpdateList:=TStringList.Create;
UpdateList.Text:=HTTP.Get(Server+'FileList.txt');
//Подсчитаем общий объем файлов для скачивания
for I := 0 to UpdateList.Count-1  do
begin
if i mod 2 = 1 then
begin
TotalSize:=TotalSize + StrToInt (UpdateList.Strings[i]) ;
end;

end;
//Закончили расчет общего объема файлов
//Создаем форму и настраиваем ее
UpdateForm:=TForm.Create(nil);
UpdateForm.Position:=poDesktopCenter;
UpdateForm.Caption:='Обновление ...';
UpdateForm.Height:=275;
UpdateForm.Width:=300;
UpdateForm.BorderStyle:=bsToolWindow;
ProgressBar:=TProgressBar.Create(nil);
ProgressBar.Parent:=UpdateForm;
ProgressBar.Height:=30;
ProgressBar.Width:=295;
ProgressBar.Visible:=True;
Log:=TMemo.Create(nil);
Log.Parent:=UpdateForm;
log.Top:=40;
Log.Width:=295;
Log.Height:=200;
Log.ScrollBars:=ssVertical;
Log.ReadOnly:=True;
Log.TabOrder:=4;
//Выведем краткую информацию по обновлению
Log.Lines.Add('========Доступно оновление '+FVersion+'========');
Log.Lines.Add('Количество файлов для обновления: '+IntToStr (UpdateList.Count-2));
Log.Lines.Add('Общий объем обновления: '+IntToStr(TotalSize));
Log.Lines.Add('____________________________________________');
Timer:=TTImer.Create(nil);
Timer.Interval:=500;
Timer.Enabled:=True;
UpdateForm.Show;
//Создадим поток
Update:= TUpdate.Create(false);
Update.Priority:= tpNormal;
Update.FreeOnTerminate:= true;
end;
UpdStatus:=1;
except
on E: Exception do ShowMessage (E.Message);
end;

end;

end.

Вот, сам проект, скомпилированный ... не знаю зачем он тут .. но может просто хотите взглянуть

Клик

Отчет
виртотал
SHA256: b278e03e26dde74ec2b262f25e06c2aead3d99b5a1299d1242 0f2157159c6d7f

ApxaHGe1 · #12 15.04.2017, 20:50

Народ, а почему

Код:

rocedure HTTP2Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
begin
 ProgressBar.Position:= AWorkCount;
 ShowMessage ('');
end;

procedure HTTP2WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Int64);
begin
 ProgressBar.Position:= 0;
 ProgressBar.Max:= AWorkcountMax;
 Log.Lines.Add('Начинаю загрузку файла. Объем :'+IntToStr(AWorkcountMax));
end;

в моем коде не работают.... Просто добавил для проверки везде

Код:

ShowMessage ('');

и ниразу не поймал сообщений

ApxaHGe1 · #13 15.04.2017, 21:14

Еще.. если написать в потоке

Код:

HTTP2Work (ProgressBar,wmWrite,Stream.Position);

То отображается процесс, но после закачки 1 файла...и стоит на месте, пока не скачается скажем 2 файл

ApxaHGe1 · #14 18.04.2017, 12:07

Переписал свой хлам, может кому то будет интересно ...

Код:

procedure Check (Server,FVer,PVer,FList:String);
var
  FVersion:String;
  HTTP:TIdHTTP;
  UpdateForm:TForm;
  ProgressBar:TProgressBar;
  Log:TMemo;
  UpdateList:TStringList;
  Stream:TMemoryStream;
  FCount:integer;
  i:integer;
begin
//Создаем форму и компоненты
//Размещаем и настраиваем компоненты
//На нашей форме
HTTP:=TIdHTTP.Create(nil);
UpdateForm:=TForm.Create(nil);
UpdateForm.Position:=poDesktopCenter;
UpdateForm.Caption:='Обновление ...';
UpdateForm.Height:=275;
UpdateForm.Width:=310;
UpdateForm.BorderStyle:=bsToolWindow;
ProgressBar:=TProgressBar.Create(nil);
ProgressBar.Parent:=UpdateForm;
ProgressBar.Height:=30;
ProgressBar.Width:=295;
ProgressBar.Visible:=True;
Log:=TMemo.Create(nil);
Log.Parent:=UpdateForm;
log.Top:=40;
Log.Width:=295;
Log.Height:=200;
Log.ScrollBars:=ssVertical;
Log.ReadOnly:=True;
Log.TabOrder:=4;
HTTP:=TIdHTTP.Create(nil);
//Запрашиваем версию файлов на сервере
FVersion:=HTTP.Get(server+FVer);
//и сравниваем с версией программы
//Если файлы на сервере более свежей версии
if  FVersion > PVer then
begin
//то отобразим форму
UpdateForm.Show;
//Выведем в ЛОГ сообщение о доступном обновлении
Log.Lines.Add ('----------------Доступно обновление '+FVersion+'----------------');
//Запросим список файлов с сервера и их размер
UpdateList:=TStringList.Create;
UpdateList.Text:=HTTP.Get(server+FList);
//Разберем список файлов обновления
//Формат файла :
//ИМЯ ФАЙЛА.ЕХЕ
//РАЗМЕР ФАЙЛА В БАЙТАХ
//И создадим поток, для загрузки файлов
Stream:=TMemoryStream.Create;
//========> БЛОК РАЗБОРА ФАЙЛОВ <========
for FCount:=0 to UpdateList.Count - 1 do
begin
Application.Initialize;
if FCount mod 2 = 0 then
begin
Application.Initialize;
//Выводим в ЛОГ имя файла и его размер
Log.Lines.Add('-'+UpdateList.Strings[FCount]+' ('+UpdateList.Strings[FCount+1]+')');
//Устанавливаем МАХ значение прогрессбара
ProgressBar.Max:=StrToInt (UpdateList.Strings[FCount+1]);
//Загружаем файл с сервера
HTTP.Get(Server+UpdateList.Strings[FCount],Stream);
//Сохраняем на диск, рядом с ЕХЕ файлом программы
Stream.SaveToFile(ExtractFilePath(ParamStr(0))+'\'+UpdateList.Strings[FCount]+'_');
//Отображаем на прогрессбаре процесс скачивания файла
ProgressBar.Position:=Stream.Position;
end;
//Очищаем поток и прогрессбар
Stream.Position:=0;
ProgressBar.Position:=0;
end;
//========> БЛОК РАЗБОРА ФАЙЛОВ END <========
//Освобождаем поток
Stream.Free;
//Выводим сообщение об удачной загрузке обновления
Log.Lines.Add('Файлы обновления загружены!');
end;

end;


пример использования

Check ('http://**********.ru/','ver.txt','0.9','FileList.txt');

Все работает, все хорошо

Только вот одно НО, Прогресс бар не много не так работает как хотелось бы ) нет плавного хода прогресса )

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты

Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
ApxaHGe1 (15.04.2017)