Ну я бы сделал так (точнее уже сделал):
Код в программе:
| Код |
//***************Код Закачки****************
type
CalBackInet = class(TInterfacedObject, IBindStatusCallback)
function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
function GetPriority(out nPriority): HResult; stdcall;
function OnLowResource(reserved: DWORD): HResult; stdcall;
function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
szStatusText: LPCWSTR): HResult; stdcall;
function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc;
stgmed: PStgMedium): HResult; stdcall;
function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
end;
function DownloadFile(SourceFile, DestFile: string): Boolean;
var
CLB : IBindStatusCallback;
begin
CLB := CalBackInet.Create as IBindStatusCallback;
try
Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, CLB) = 0;
except
Result := False;
end;
CLB := nil;
end;
{ CalBackInet }
function CalBackInet.GetBindInfo(out grfBINDF: DWORD;
var bindinfo: TBindInfo): HResult;
begin
end;
function CalBackInet.GetPriority(out nPriority): HResult;
begin
end;
function CalBackInet.OnDataAvailable(grfBSCF, dwSize: DWORD;
formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin
end;
function CalBackInet.OnLowResource(reserved: DWORD): HResult;
begin
end;
function CalBackInet.OnObjectAvailable(const iid: TGUID;
punk: IInterface): HResult;
begin
end;
function CalBackInet.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
szStatusText: LPCWSTR): HResult;
begin
//Этот метод вызывается постоянно
//тут можно вызвать Application.ProcessMessages для обработки сообщений
// перерисовки и отображения прогресса.
end;
function CalBackInet.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult;
begin
//Тут отображаем начало старта закачки
end;
function CalBackInet.OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult;
begin
//Вызовиться по завершению процесса закачки
end;
// ************************* Конец кода закачки**************
//Проверяем подключен ли интернет
function IsConnectedToInternet: Boolean;
var
dwConnectionTypes: DWORD;
begin
dwConnectionTypes :=
INTERNET_CONNECTION_MODEM +
INTERNET_CONNECTION_LAN +
INTERNET_CONNECTION_PROXY;
Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;
|
Узнаём об обновлениях (можно при показе формы):
| Код |
version:='1.02';//Версия... Например 1.02
if Pos('.',version)<>0 then Delete(version, Pos('.', version), 1);
SourceFile:='http://www.maniaks1.cwx.ru/myprograms/news/index.php?program=screen&version='+version;
DestFile:=ExtractFilePath(Application.ExeName)+'versioninfo.html';
if IsConnectedToInternet then
begin
Label9.Caption:='Получение данных...';
if DownloadFile(SourceFile, DestFile) then
begin
Label9.Caption:='Готово';
Memo1.Lines.LoadFromFile(ExtractFilePath(Application.ExeName)+'versioninfo.html');
info:=Memo1.Text;
if Pos('no_new', info)<>0 then
Label9.Caption:='Обновлений нет.' else
begin
GroupBox1.Enabled:=true;
if Pos('new_version=', info)<>0 then
begin
Delete(info, 1, Pos('new_version=', info)-1);
Label11.Caption:=Copy(info, Pos('new_version=', info)+12, Pos(';', info)-13);
Delete(info, Pos('new_version=', info), Pos(';', info));
end;
if Pos('link=', info)<>0 then
begin
Delete(info, 1, Pos('link=', info)-1);
Link:=Copy(info, Pos('link=', info)+5, Pos(';', info)-6);
Delete(info, Pos('link=', info), Pos(';', info));
end;
if Pos('size=', info)<>0 then
begin
Delete(info, 1, Pos('size=', info)-1);
Label13.Caption:=Copy(info, Pos('size=', info)+5, Pos(';', info)-6);
Delete(info, Pos('size=', info), Pos(';', info));
end;
if Pos('info=', info)<>0 then
begin
Delete(info, 1, Pos('info=', info)-1);
readme:=Copy(info, Pos('info=', info)+5, Pos(';', info)-6);
Delete(info, Pos('info=', info), Pos(';', info));
end;
end;
end
else
Label9.Caption:='Нет данных.';
end
else Label9.Caption:='Интернет не подключен';
if FileExists(DestFile) then DeleteFile(DestFile);
|
Вот так мы узнаём есть ли новая программа, и инфу о ней.
Думаю сложностей при переделке не возникнет.
Теперь код интернет страницы. Причём она может располагаться и на ,бесплатном сервере.
index.php
| Код |
<?
session_start();
if (isset($_SESSION['page'])) {$page=$_SESSION['page'];} else {$page='no';}
$program=strtolower($_REQUEST['program']);
$version=strtolower($_REQUEST['version']);
if ($program=='') {
echo"<center>Вы не ввели имя программы</center>";
die();
}
if (File_Exists("$program.php")) {
include("$program.php");
} else {
echo"<center>Программа не найдена.</center>";
}
if ($version<$new_version) {
echo"<center>Появилась новая версия. new_version=$new_version;link=$link;size=$size;info=$info;";
} else {
echo"Обновлений нет. no_new";
}
?>
|
Например программа называеться Screen, тогда в этойже директории ложим Screen.php
| Код |
<?
$new_version='120';
$link='http://maniaks1.cwx.ru/download.php?page=myprograms&file=Screen_v1.20.rar';
$size='249 кб.';
$info='*Появилась новая возможность: поворот изображения.#13 *Появилась опция: оттенки серого.';
?>
|
в uses понадобится WinInet, ActiveX, UrlMon
Конечно всё довольно некрасиво, но работает.
Тебе нужно добавить что то вроде
| Код |
procedure update;
Var f:Text;
begin
AssignFile(f, ExtractFilePath(Application.ExeName)+'update.bat');
Rewrite(f);
Write(f, 'del'+Application.Exename);
Write(f, 'rename new.tmp '+Application.Exename);
Closefile(f);
ShellExecute(Handle, 'open', PAnsiChar(ExtractFilePath(Application.ExeName)+'update.bat'), nil, nil, SW_SHOWNORMAL);
Application.Terminate;
end;
|
|
