|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Модуль автообновления
Ребята подскажите пожалуйста, почему не работает поток в отдельном модуле, я с потоками не дружу если честно вообще...
камнями не кидайте, делал чисто для себя. так как озадачили на работе, и что бы пользователям постоянно не сообщать что нужно обновиться, решил написать модуль самообновления. Форма с прогресс баром то вроде открывается, но мало того что прогресс бар стоит на месте, так еще и файл даже не качается, пока не закроешь эту форму .... Помогите... Код:
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. Последний раз редактировалось ApxaHGe1, 15.04.2017 в 16:38. |
#2
|
|||
|
|||
А ниче так, что форма модальная?
Код:
UpdateForm.ShowModal; |
Этот пользователь сказал Спасибо lmikle за это полезное сообщение: | ||
ApxaHGe1 (15.04.2017)
|
#3
|
|||
|
|||
Так как бы на ней и хотелось бы отобразить процесс обновления в ProgressBar'е
т.е. я правильно понял, если форма была бы не модальная, то все обновлялось бы? Думаю что нет, и поэтому прошу помощи, в понедельник нужно сдать скомпилированный проект на работе.. что бы пользователи могли использовать готовое приложение, но как я говорил выше, без модуля автообновления будет трудно, каждый раз просить пользователей обновить приложение, т.к. будет допиливаться данное приложения, будут добавляться новые функции... Последний раз редактировалось ApxaHGe1, 15.04.2017 в 16:18. |
#4
|
|||
|
|||
Действительно, если изменить
Код:
UpdateForm.ShowModal; Код:
UpdateForm.Show; Код:
Количество файлов для обновления: 1 Загрузка файла: BAGIRA.exe Размер загружаемого файла: 7762944 НО, прогресс бар стоит на месте как его заставить шевелиться то ) |
#5
|
|||
|
|||
кидай таймер
|
#6
|
|||
|
|||
Цитата:
Код:
procedure TimerTimer(Sender: TObject); begin ProgressBar.Position:=Stream.Position; end; Ни какого результата прогрессс бар стоит на месте ) в логе через определнное время просто получаю "Обновление завершено" |
#7
|
|||
|
|||
видимо stream.position равно нулю
|
#8
|
||||
|
||||
Код:
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; Помогаю платно. Помогаю иногда бесплатно. Последний раз редактировалось @Rafa3L, 15.04.2017 в 18:55. |
#9
|
|||
|
|||
Цитата:
Код:
========Доступно оновление 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, 15.04.2017 в 18:48. |
#10
|
|||
|
|||
Цитата:
Извиняюсь, но этого просто нет в листинге 1 поста, не стал копировать. |
#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, 15.04.2017 в 19:18. |
#12
|
|||
|
|||
Народ, а почему
Код:
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 (''); и ниразу не поймал сообщений |
#13
|
|||
|
|||
Еще.. если написать в потоке
Код:
HTTP2Work (ProgressBar,wmWrite,Stream.Position); |
#14
|
|||
|
|||
Переписал свой хлам, может кому то будет интересно ...
Код:
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'); Все работает, все хорошо Только вот одно НО, Прогресс бар не много не так работает как хотелось бы ) нет плавного хода прогресса ) |