Блог

о компьютерах и программах

Для своей программы реализовал отдельную подпрограмму - как отдельный файл проекта lpi\lpr. По началу трудно было разобраться с Indy, но в итоге разобрался и реализовал удобную для меня штуку. Быть может, кому-то данный код будет полезен. 

Стоит отметить, что Lazarus это среда разработки на языке Object Pascal с компилятором FreePascal.

Для начала, хочу привести ссылку на отличную статью по установке Indy www.freepascal.ru/article/lazarus/20100812185950. Версия сейчас есть более новая, но благодаря данной статьи установить её  не трудно.

Для начала приведу используемые компоненты:

 bUpdateBase: TButton; 
bDownloadProgram: TButton;
IdHTTP1: TIdHTTP;
IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
lVersionProgram: TLabel;
lVersionBase: TLabel;
ProgressBar1: TProgressBar;
SelectDirectoryDialog: TSelectDirectoryDialog;

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

Сначала программу сделал без поддержки SSL, но когда перевёл сайт на ssl, проверка обновлений перестала работать. Выбор каталога используется только для загрузки новой версии программы.

Теперь приведу используемые библиотеки:

uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ComCtrls, IdHTTP, Windows, IdSSL, IdSSLOpenSSL;

Теперь приведу глобальные переменные:

private
{ private declarations }
public
{ public declarations }
end;

 

var
fUpdate: TfUpdate;
FileVerBase: TextFile;
FileVerProg: TextFile;
VerBase: string; 
VerProg: string; 

 

implementation

Версия базы данных и программы хранится в обычных текстовых файлах, при открытие программы она автоматически подгружается и отображается в TLabel. Вот процедура Form.OnCreate:

procedure TfUpdate.FormCreate(Sender: TObject);
begin
AssignFile(FileVerBase, UTF8ToSys('base.txt'));
Reset(FileVerBase);
AssignFile(FileVerProg, UTF8ToSys('prog.txt'));
Reset(FileVerProg);
Readln(FileVerBase, VerBase);
Readln(FileVerProg, VerProg);
lVersionBase.Caption:=VerBase;
lVersionProgram.Caption:=VerProg;
CloseFile(FileVerBase);
CloseFile(FileVerProg);
end;

Теперь приведу процедуру обновления базы данных

procedure TfUpdate.bUpdateBaseClick(Sender: TObject);
var
version:WideString;
Response:TFileStream;
//FullProgPath: PChar; для перезапуска
begin
ProgressBar1.Position:=0;
ProgressBar1.Min := 0;
ProgressBar1.Max := 10;
{ if lVersionBase.Caption='' then
begin
AssignFile(FileVerBase, UTF8ToSys('base.txt'));
Reset(FileVerBase);
Read(FileVerBase, VerBase);
lVersionBase.Caption:=VerBase;
//CloseFile(FileVerBase);
end; }
try
version:=IdHTTP1.Get('https://xn--90abhbolvbbfgb9aje4m.xn--p1ai/images/lpro-base-version.txt');
if version=lVersionBase.Caption then
begin
ProgressBar1.StepBy(10);
Application.MessageBox('У Вас самая новая версия базы','Внимание',MB_OK);
Exit;
end
else
begin
ProgressBar1.StepBy(3);
Application.MessageBox('Появилась новая версия базы, сейчас она будет загружена.','Внимание',MB_OK);
// ShowMessage('Обновление базы есть, сейчас оно будет загружен, а далее приложение будет перезапущено.');

Response:=TFileStream.Create('Lpro.db', fmCreate);
IdHTTP1.Get('https://xn--90abhbolvbbfgb9aje4m.xn--p1ai/images/Lpro.db',Response);
ProgressBar1.StepBy(3);
// нужно сохранить архив
TMemoryStream(Response).SaveToFile('Lpro.db');
ProgressBar1.StepBy(2);

// Принудительный перезапуск приложения
// FullProgPath := PChar(Application.ExeName);
// ShowWindow(Form1.handle,SW_HIDE);
//WinExec(FullProgPath,SW_SHOW);
//Application.Terminate; // or: Close;
end;
except
on e:Exception do
//-//-//-//-//-//

end;
ProgressBar1.StepBy(2);
//меняем версию программы
AssignFile(FileVerBase, UTF8ToSys('base.txt'));
try
Rewrite(FileVerBase);
Append(FileVerBase);
Write(FileVerBase, version);
finally
CloseFile(FileVerBase);
end;
//конец смены версии проги !!!!
TMemoryStream(Response).Free;
//Меняем надпись версий
AssignFile(FileVerBase, UTF8ToSys('base.txt'));
Reset(FileVerBase);
AssignFile(FileVerProg, UTF8ToSys('prog.txt'));
Reset(FileVerProg);
Readln(FileVerBase, VerBase);
Readln(FileVerProg, VerProg);
lVersionBase.Caption:=VerBase;
lVersionProgram.Caption:=VerProg;
CloseFile(FileVerBase);
CloseFile(FileVerProg);
ProgressBar1.StepBy(2);
//конец смени надписей версий
Application.MessageBox('Загрузка завершена','Внимание',MB_OK);
// lVerBase.Caption:=FormatDateTime('yyyymmdd', Now); дата обновлений
// дата сделать запись в файл даты обновления внутри цикла!!!
end;

Теперь приведу процедуру загрузки новой версии программы:

procedure TfUpdate.bDownloadProgramClick(Sender: TObject);
var
version:WideString;
Response:TFileStream;
filename2 : String;
path : TSelectDirectoryDialog;
begin
ProgressBar1.Position:=0;
ProgressBar1.Min := 0;
ProgressBar1.Max := 10;
try
version:=IdHTTP1.Get('https://xn--90abhbolvbbfgb9aje4m.xn--p1ai/images/lpro-version.txt');
if version=lVersionProgram.Caption then
begin
ProgressBar1.StepBy(10);
Application.MessageBox('У Вас самая новая версия программы','Внимание',MB_OK);
Exit;
end
else
begin
ProgressBar1.StepBy(2);
Application.MessageBox('Появилась новая версия программы, сейчас начнётся загрузка','Внимание',MB_OK);
// ShowMessage('Обновление есть, сейчас буду загружать.');
// SD3.FileName:=filename2;
// if SD3.Execute then
path := TSelectDirectoryDialog.Create(Application);
if path.Execute then
begin
// filename2:=SD3.FileName;
ProgressBar1.StepBy(3);
filename2:=path.FileName + '\Lpro.exe';
// ShowMessage(filename2);
Response:=TFileStream.Create(filename2, fmCreate);
IdHTTP1.Get('https://xn--90abhbolvbbfgb9aje4m.xn--p1ai/images/Lpro.exe',Response);
ProgressBar1.StepBy(3);
// нужно сохранить архив
TMemoryStream(Response).SaveToFile(filename2);

end;
FreeAndNil(path);
end;
except
on e:Exception do
//-//-//-//-//-//
end;
ProgressBar1.StepBy(2);
TMemoryStream(Response).Free;

Application.MessageBox('Загрузка завершена','Внимание',MB_OK);
// хотел сделать автозапуск, но не пашет
// WinExec(PChar(filename2),SW_SHOW); //запуск инсталлятора
//Application.Terminate;
// Close; //завершение программы
end;

Остается самое интересное, как из основной программы открыть данный исполняемый файл и при этом закрыть главную форму? Привожу код события:

procedure TfMian.mUpdateCheckClick(Sender: TObject);
var
ename:string;
begin
ename:= Extractfilepath(paramstr(0));
ename:=ename + '\update.exe';
ShellExecute(0, 'open', PChar(ename), nil, nil, SW_SHOWNORMAL);
// showmessage(ename);
Close;
end;

Надеюсь, что кому-то данный код будет полезен. Для среды разработки Lazarus опубликовано не так много готового кода, только обрывки. Для Delphi много, но некоторые функции и методы разные. Буду продолжать публиковать подобные статьи, если будут вопросы, задавайте через сайт .