Patcher

[DeddyH]

Sonst schau Dich doch mal bei Torry um.

[CallOfUnite]

Zitat von DeddyH:

Sonst schau Dich doch mal bei Torry um.

cool danke jetzt meine frage: darf ich das gewerblich nutzen? eher nicht oder?

[DeddyH]

Das sollte in den Lizenzbedingungen der Komponente Deiner Wahl stehen, es werden ja mehrere gefunden.

[shmia]

Also, das Herunterladen von Dateien unter Windows ist total einfach (wenn man seine Ansprüche etwas zurückschraubt)

Delphi-Quellcode:

uses ... UrlMon;

function DownLoadInternetFile(const URL, DestinationFile : String): Boolean;
begin
   Result := URLDownloadToFile(nil,PChar(DestinationFile),PChar(Dest),0,nil) = 0
end;

Es gibt halt keinen Progressbar während des Downloads, aber das ist vorerst mal egal.
Später kann du das immer noch durch INDY, Synapse oder was auch immer ersetzen.

Der Rest ist reine Fleissarbeit.
* Webserver aufsetzen
* Steuerdatei (INI-File oder XML Datei) herunterladen
* Steuerdatei auswerten
* Benutzer ggf. fragen ob er das Update installieren will
* Kucken was noch heruntergeladen werden muss
* Nach dem Herunterladen aller notwendigen Dateien die Anwendung
auf der lokaler Platte updaten

[Horst0815]

Delphi-Quellcode:

unit uUpdate;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, UrlMon, ActiveX, StdCtrls, ShellAPI, ComCtrls, WinINet;

type
  TfrmUpdate = class(TForm)
    btnUpdateCheck: TButton;
    MemoInfo: TMemo;
    Fortschritt: TProgressBar;
    procedure btnUpdateCheckClick(Sender: TObject);
    Function GetHTML(AUrl: string): string;
  private
    { Private-Deklarationen }
  public
    { Pu
      blic-Deklarationen }
  end;

type
  cDownloadStatusCallback = class(TObject, IUnknown, IBindStatusCallback)
  private
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    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;

var
  frmUpdate: TfrmUpdate;
  actual_version, last_version, waiting: string;
  cDownStatus: cDownloadStatusCallback;
  Datei, Ziel: PChar;
  rounds: Integer;
  usercancel: Boolean = False;

implementation

{$R *.dfm}

procedure TfrmUpdate.btnUpdateCheckClick(Sender: TObject);
begin
  if btnUpdateCheck.Tag = 1 then
  begin
    waiting := '';
    rounds := 0;
    sleep(10);
    MemoInfo.clear;
    application.ProcessMessages;
    cDownStatus := cDownloadStatusCallback.Create;
    try
      Datei := 'http://www.DeineHP.de/Setup.exe';
      Ziel := 'Setup.exe';
      UrlDownloadToFile(nil, Datei, Ziel, 0, cDownStatus);
      if MessageBox(0, 'DOWNLOAD COMPLETE, RESTART', 'Info',
        MB_OKCANCEL) = IDOK then
      Begin
        ShellExecute(application.Handle, 'open', PChar('Setup.exe'), nil,
          nil, SW_ShowNormal);
        application.terminate;
      End
      else
      begin
        btnUpdateCheck.Caption := 'Please install Update';
        btnUpdateCheck.Enabled := False;
        Exit;
      end;
    except
      showmessage('Download aborted!');
    end;
  end;
  if btnUpdateCheck.Tag = 0 then
  begin
    MemoInfo.clear;
    last_version := GetHTML('http://www.DeineHP.de/version.txt');
    if actual_version <> last_version then
    begin
      MemoInfo.lines.add('NEW UPDATE AVAILABLE! ' + last_version);
      MemoInfo.lines.add
        ('PRESS "DOWNLOAD NEW UPDATE NOW!" Button to get newest update!');
      btnUpdateCheck.Tag := 1;
      btnUpdateCheck.Caption := 'DOWNLOAD NEW UPDATE NOW!';
      btnUpdateCheck.font.size := 18;
      btnUpdateCheck.font.style := [fsBold];
    end
    else
    begin
      MemoInfo.lines.add('YOU USE THE LATEST AVAILABLE VERSION');
      MemoInfo.lines.add(GetHTML('http://www.DeineHP.de/news.txt'));
      MemoInfo.Perform(WM_VSCROLL, SB_TOP, 0);
    end;
  end;
end;

function cDownloadStatusCallback._AddRef: Integer;
begin
  Result := 0;
end;

function cDownloadStatusCallback._Release: Integer;
begin
  Result := 0;
end;

function cDownloadStatusCallback.QueryInterface(const IID: TGUID;
  out Obj): HResult;
begin
  if (GetInterface(IID, Obj)) then
  begin
    Result := 0
  end
  else
  begin
    Result := E_NOINTERFACE;
  end;
end;

function cDownloadStatusCallback.OnStartBinding(dwReserved: DWORD;
  pib: IBinding): HResult;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.GetPriority(out nPriority): HResult;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnLowResource(reserved: DWORD): HResult;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnStopBinding(HResult: HResult;
  szError: LPCWSTR): HResult; stdcall;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.GetBindInfo(out grfBINDF: DWORD;
  var bindinfo: TBindInfo): HResult; stdcall;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD;
  formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnObjectAvailable(const IID: TGUID;
  punk: IUnknown): HResult; stdcall;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnProgress(ulProgress, ulProgressMax,
  ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
begin

  case ulStatusCode of
    BINDSTATUS_FINDINGRESOURCE:
      begin
        frmUpdate.MemoInfo.lines.add('File found on server.');
        if (usercancel) then
        begin
          Result := E_ABORT;
          Exit;
        end;
      end;
    BINDSTATUS_CONNECTING:
      begin
        frmUpdate.MemoInfo.lines.add('Connecting to Server..');
        if (usercancel) then
        begin
          Result := E_ABORT;
          Exit;
        end;
      end;
    BINDSTATUS_BEGINDOWNLOADDATA:
      begin
        frmUpdate.Fortschritt.Position := 0;
        frmUpdate.MemoInfo.lines.add('Start Downloading...');
        if (usercancel) then
        begin
          Result := E_ABORT;
          Exit;
        end;
      end;
    BINDSTATUS_DOWNLOADINGDATA:
      begin
        frmUpdate.Fortschritt.Position :=
          MulDiv(ulProgress, 100, ulProgressMax);
        // Form1.memo2.lines.add('Downloading.. PLEASE WAIT');

        rounds := rounds + 1;
        // if rounds = 50 then
        // begin
        // rounds := 0;
        // frmUpdate.MemoInfo.lines.Delete(frmUpdate.MemoInfo.lines.Count - 1);
        // waiting := waiting + '.';
        // frmUpdate.MemoInfo.lines.add('Downloading new Update' + waiting);
        // end;

        if (usercancel) then
        begin
          Result := E_ABORT;
          Exit;
        end;
      end;
    BINDSTATUS_ENDDOWNLOADDATA:
      begin
        frmUpdate.MemoInfo.lines.add('DOWNLOAD FINISHED!');
      end;
  end;
  Result := S_OK;
end;

Function TfrmUpdate.GetHTML(AUrl: string): string;
var
  databuffer: array [0 .. 4095] of char;
  ResStr: string;
  hSession, hfile: hInternet;
  dwindex, dwcodelen, dwread, dwNumber: cardinal;
  dwcode: array [1 .. 20] of char;
  res: PChar;
  Str: PChar;
begin
  ResStr := '';
  Result := '';
  if pos('http://', lowercase(AUrl)) = 0 then
    AUrl := 'http://' + AUrl;
  hSession := InternetOpen('InetURL:/1.0', INTERNET_OPEN_TYPE_PRECONFIG,
    nil, nil, 0);
  If assigned(hSession) Then
    Try
      hfile := InternetOpenUrl(hSession, PChar(AUrl), nil, 0,
        INTERNET_FLAG_RELOAD, 0);
      if assigned(hfile) then
        Try
          dwindex := 0;
          dwcodelen := 10;
          HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode,
            dwcodelen, dwindex);
          res := PChar(@dwcode);
          dwNumber := sizeof(databuffer) - 1;
          if (res = '200') or (res = '302') then
          begin
            while (InternetReadfile(hfile, @databuffer, dwNumber, dwread)) AND
              (dwread <> 0) do
            begin
              databuffer[dwread] := #0;
              Str := PChar(@databuffer);
              ResStr := ResStr + Str;
            end;
          end
          else
            ResStr := 'Status:' + res;
        Finally
          InternetCloseHandle(hfile);
        End;
    Finally
      InternetCloseHandle(hSession);
    End;
  Result := ResStr;
end;

end.