{WebUpdate V1.00.3, 28.03.2008}
{Freeware-Komponente fuer ein automatisches Programmupdate.}
{Autor: Marco Steinebach - [email]marco.steinebach@t-online.de[/email]}
unit WebUpdate;
{ Compiler-Schalter:
wird der nachfolgende Schalter "NurAlsObjekt" gesetzt,
wird die Komponente ohne die möglichkeit der Einbindung
in den Objektinspektor compiliert, sinnvoll beispielsweise
bei Einsatz von Turbo-Explorer (keine Fremdkomponenten), oder KonsolenApps.
(Danke an WebCSS!) }
{.$DEFINE NurAlsObjekt}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
WebUpdateThread;
type
TWUDatei =
record // TWU steht für TWebUpdate
name,
Pfad:
string;
end;
TWUDateien =
array of TWUDatei;
// Liste aller runterzuladenden Dateien
TOnWorkEvent =
procedure(Sender: TThread; AWorkCount: Integer)
of object;
TOnUpdateGefunden =
Procedure (sender: TObject;
var Runterladen: boolean)
of object;
TOnDownloadKomplett =
Procedure (sender: TObject;
var Start: boolean)
of object;
{$IFDEF NurAlsObjekt}
TWebUpdate =
class(TObject)
{$ELSE}
TWebUpdate =
class(TComponent)
{$ENDIF}
private
{ Private-Deklarationen }
fIniName:
String;
// Name der Versionsdatei
fUpdateURL:
String;
// HTTP-Verzeichnis zur Versionsdatei und den Programmen
fNeueVersion:
String;
// im falle eines Updates, die neue Programmversion
fWhatsNewListe: TStringList;
// Im Falle eines Updates, die Neuerungen
fDateien: TWUDateien;
// Die Dateien, die heruntergeladen werden sollen
fNaechsteDatei: integer;
// welche Datei kommt als nächste?
fDirektesUpdate: boolean;
fIdHTTP: TIdHTTP;
fDownloadThread: TDownloadThread;
fOnUpdateGefunden: TOnUpdateGefunden;
fOnDownloadKomplett: TOnDownloadKomplett;
fOnDownloadFortschritt: TOnWorkEvent;
procedure SetIniName(
const value:
String);
procedure SetUpdateUrl (
const value:
string);
procedure DownloadStart;
// startet den DownloadThread für eine Datei.
procedure DownloadEnde (sender: TObject);
// wird nach beendigung des Download-Threads ausgeführt.
// ist noch eine Datei herunterzuladen, wird wieder
// DownloadStart ausgeführt.
procedure ErstelleBatchDatei;
// erstellt die Batch zum Starten des direkten Updates.
protected
{ Protected-Deklarationen }
public
{ Public-Deklarationen }
{$IFDEF NurAlsObjekt}
constructor Create;
override;
{$ELSE}
constructor Create (aOwner: TComponent);
override;
{$ENDIF}
destructor Destroy;
override;
property NeueVersion:
string read fNeueVersion;
property WhatsNewListe: TStringList
read fWhatsNewListe;
property Dateien: TWUDateien
read fDateien;
procedure CheckForUpdates;
published
{ Published-Deklarationen }
property IniName:
String read fIniName
write SetIniName;
property UpdateURL:
string read fUpdateURL
write SetUpdateURL;
property OnUpdateGefunden: TOnUpdateGefunden
read fOnUpdateGefunden
write fOnUpdateGefunden;
property OnDownloadKomplett: TOnDownloadKomplett
read fOnDownloadKomplett
write fOnDownloadKomplett;
property OnDownloadFortschritt: TOnWorkEvent
read fOnDownloadFortschritt
write fOnDownloadFortschritt;
end;
procedure Register;
implementation
uses
IniFiles, ShellApi, FileCtrl, MardyTools;
{$IFNDEF NurAlsObjekt}
procedure Register;
begin
RegisterComponents('
Standard', [TWebUpdate]);
end;
{$ENDIF}
{$IFDEF NurAlsObjekt}
constructor TWebUpdate.Create;
{$ELSE}
constructor TWebUpdate.Create (aOwner: TComponent);
{$ENDIF}
begin
inherited Create
{$IFNDEF NurAlsObjekt} (aOwner)
{$ENDIF } ;
fWhatsNewListe := TStringList.Create;
fIdHTTP := TIdHTTP.Create (self);
fUpdateUrl := '
';
fIniName := '
';
fNeueVersion := '
';
fDateien :=
nil;
fDirektesUpdate := false;
end;
Destructor TWebUpdate.Destroy;
begin
fWhatsNewListe.Free;
fIdHTTP.Destroy;
fDateien :=
nil;
inherited Destroy;
end;
procedure TWebUpdate.SetIniName(
const value:
string);
begin
if fIniName <> Value
then
fIniName := Value;
end;
procedure TWebUpdate.SetUpdateURL(
const value:
string);
begin
if fUpdateURL <> Value
then
begin
fUpdateURL := Value;
if copy (UpperCase (fUpdateUrl), 1, 7) <> '
HTTP://'
then
fUpdateURL := '
http://' + fUpdateURL;
if copy(fUpdateURL, Length(fUpdateURL), 1) <> '
/'
then
fUpdateURL := fUpdateURL + '
/';
end;
end;
procedure TWebUpdate.ErstelleBatchDatei;
var
l: TStringList;
Batchname, ProgLW, ProgPfad, ProgName:
String;
begin
l := TStringList.Create;
Batchname := ExtractFilePath (Application.Exename) + '
Update.bat';
ProgLW := ExtractFileDrive (Application.ExeName);
ProgPfad := ExtractFilePath (Application.ExeName);
ProgName := ExtractFileName (Application.ExeName);
with l
do
begin
add ('
@Echo off');
Add ('
PING -n 3 127.0.0.1>nul');
// für die Wartezeit.
Add (ProgLW);
Add ('
CD ' + ProgPfad);
Add ('
del ' + ProgName);
Add ('
ren ' + fDateien[0].
name + '
' + ProgName);
Add (ProgName);
// Programm wieder starten
Add ('
del ' + BatchName);
end;
l.SaveToFile (BatchName);
l.Free;
shellExecute (application.handle, '
open', PChar(BatchName), '
', PChar(ExtractFilePath(BatchName)), SW_HIDE);
end;
procedure TWebUpdate.DownloadStart;
begin
with fDateien[fNaechsteDatei]
do
// testen, ob der angegebene Pfad existiert, wenn nicht, anlegen!
if not DirectoryExists (Pfad)
then
if not CreateDir (pfad)
then
begin
Fehler ('
Verzeichnis '+Pfad+'
kann nicht erstellt werden!');
fNaechsteDatei := fNaechsteDatei + 1;
exit
end;
fDownloadThread := TDownloadThread.Create (true);
with fDownloadThread
do
begin
FreeOnTerminate := true;
OnTerminate := DownloadEnde;
Name := fDateien[fNaechsteDatei].
name;
Pfad := fDateien[fNaechsteDatei].pfad;
URL := fUpdateURL;
OnWork := fOnDownloadFortschritt;
Resume;
end;
fNaechsteDatei := fNaechsteDatei + 1;
end;
procedure TWebUpdate.DownloadEnde(sender: TObject);
var
start: boolean;
begin
if fNaechsteDatei <= Length (fDateien) -1
then
// es sind noch Dateien zum herunterladen da...
begin
DownloadStart;
exit
end;
start := false;
if assigned (OnDownloadKomplett)
then
OnDownloadKomplett (self, start);
if not start
then exit;
if fDirektesUpdate
then
ErstelleBatchDatei
else
with fDateien[0]
do
shellexecute (application.handle, '
open', PChar(pfad +
name), '
', PChar(pfad), SW_SHOWNORMAL);
Application.MainForm.Close;
end;
procedure TWebUpdate.CheckForUpdates;
var
ini: TIniFile;
fs: TFileStream;
rv, lv, TempDir, ProgDir:
string;
i, ma, mi, re, bu: integer;
Runterladen: boolean;
begin
// Tempverzeichnis festlegen.
TempDir := LeseUmgebungsVariable ('
TEMP');
SetLength (TempDir, length (TempDir)-1);
// Null am Ende weg!
if TempDir = '
'
then
begin
Fehler ('
Tempverzeichnis kann nicht ermittelt werden.');
exit
end;
TempDir := TempDir + '
\';
ProgDir := ExtractFilePath (Application.Exename);
// Datei aus dem Internet holen.
fs := TFileStream.Create (TempDir + fIniName, fmCreate
or fmShareExclusive);
try
fIdHTTP.Get (fUpdateURL + fIniName, fs);
finally
fs.Free;
end;
// Werte für Version auslesen
ini := TIniFile.Create (TempDir + IniName);
ma := ini.ReadInteger ('
Version', '
Major', 0);
mi := ini.ReadInteger ('
Version', '
Minor', 0);
re := ini.ReadInteger ('
Version', '
Release', 0);
bu := ini.ReadInteger ('
Version', '
Build', 0);
// Direktes Update oder nicht?
fDirektesUpdate := ini.ReadBool ('
Einstellungen', '
DirektesUpdate', false);
// Dateinamen, die runtergeladen werden sollen, auslesen.
i := 0;
repeat
SetLength (fDateien, Length(fDateien)+1);
with fDateien[i]
do
begin
name := ini.ReadString ('
Datei'+null(i+1, 3), '
Name', '
');
if ini.ReadBool ('
Datei'+null(i+1, 3), '
Temp', true)
then
pfad := TempDir
else
Pfad := ProgDir + ini.ReadString ('
Datei'+null(i+1, 3), '
Pfad', '
');
end;
i := i + 1;
until fDateien[i-1].
name = '
';
SetLength (fDateien, Length (fDateien)-1);
ini.Free;
// What's New Liste, erstmal, nur füllen.
fWhatsNewListe.LoadFromFile (TempDir + IniName);
if FileExists (TempDir + IniName)
then
DeleteFile (TempDir + IniName);
// den brauchen wir jetzt nicht mehr.
// Remote und lokale Version zerlegen und vergleichen.
rv := null (ma, 10) + null (mi, 10) + null(re, 10) + null(bu, 10);
fNeueVersion := null (ma, 1) + '
.' + null (mi, 1) + null(re, 1) + '
.' + null(bu, 1);
lv := FileVersionInfo (Application.ExeName).FileVersionOriginal;
ma := StrToInt (copy(lv, 1, pos('
.',lv)-1));
delete (lv, 1, pos('
.', lv));
mi := StrToInt (copy(lv, 1, pos('
.',lv)-1));
delete (lv, 1, pos('
.', lv));
re := StrToInt (copy(lv, 1, pos('
.',lv)-1));
delete (lv, 1, pos('
.', lv));
bu := StrToInt (lv);
lv := null (ma, 10) + null (mi, 10) + null(re, 10) + null(bu, 10);
if rv <= lv
then
exit;
while ((fWhatsNewListe.count > 0)
and
(UpperCase(fWhatsNewListe[0]) <> '
[NEUERUNGEN]'))
do
fWhatsNewListe.Delete (0);
if fWhatsNewListe.count > 0
then
fWhatsNewListe.Delete (0);
// das eigentliche [Neuerungen] raus!
runterladen := false;
if Assigned (OnUpdateGefunden)
then
OnUpdateGefunden (self, Runterladen);
if not runterladen
then exit;
fNaechsteDatei := 0;
DownloadStart;
end;
end.