<?xml version="1.0" encoding="iso-8859-1"?>
<programme>
  <programm>
    <id>1</id>
   <name>Programmbeschreibung</name>
   <int-name>OwnPrgName</int-name>
   <version>0.4</version>
   <build>2000</build>
   <author>Sascha Nickel</author>
   <file>http://www.yourdomain.de/download/v1.0/update10.exe</file>
    <updatepossible>
      <build>1531</build>
    </updatepossible>
  </programm>
</programme>

<?xml version="1.0" encoding="iso-8859-1"?>
<programme>
  <programm>
    <id>1</id>
   <name>Programmbeschreibung</name>
   <int-name>OwnPrgName</int-name>
   <version>1.0</version>
   <build>2000</build>
   <author>Sascha Nickel</author>
   <file>http://www.yourdomain.de/download/Prg1/v1.0/update10.exe</file>
    <updatepossible>
      <build>1531</build>
    </updatepossible>
  </programm>
  <programm>
    <id>2</id>
   <name>Programmbeschreibung für 2. Programm</name>
   <int-name>OwnPrgName2</int-name>
   <version>1.4</version>
   <build>7</build>
   <author>Sascha Nickel</author>
   <file>http://www.yourdomain.de/download/Prg2/v1.4/update14.exe</file>
    <updatepossible>
      <build>2</build>
      <build>3</build>
      <build>4</build>
      <build>5</build>
      <build>6</build>
    </updatepossible>
  </programm>
</programme>

function GetInetFile (const fileURL, FileName: String; Progress : TProgressBar): boolean;
const
  BufferSize = 1024;
var
  hSession, hURL: HInternet;
  Buffer: array[1..BufferSize] of Byte;
  code : array[1..20] of char;
  BufferLen,
  Index,
  CodeLen,
  FileSize : DWord;
  f: File;
  sAppName: string;
  f1 : Integer;
begin
 result := false;
 sAppName := ExtractFileName(Application.ExeName) ;
 hSession := InternetOpen(PChar(sAppName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0) ;
 try
  hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, INTERNET_FLAG_DONT_CACHE, 0) ;
  try
   AssignFile(f, FileName) ;
   Rewrite(f,1);
   if Progress <> NIL then
   begin
     Index := 0;
     CodeLen := 10;
     HttpQueryInfo(hURL, HTTP_QUERY_CONTENT_LENGTH, @code, codeLen, Index);
     Progress.Visible := true;
     Progress.max := strtoint(code);
   end;
   repeat
    InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen);
    BlockWrite(f, Buffer, BufferLen);
    if Progress <> NIL then
    begin
      Progress.StepBy(SizeOf(Buffer));
      fOnlUpdate.Panel4.Refresh;
    end;
   until BufferLen = 0;
   CloseFile(f) ;
   result := True;
  finally
   InternetCloseHandle(hURL)
  end;
 finally
  InternetCloseHandle(hSession)
 end;
end;

procedure TFOnlUpdate.CheckUpdateClick(Sender: TObject);
const updateURL = 'http://www.the-microborgs.de/download/update.xml';
      int_name = 'OwnPrgName';
      prg_ID = 1;
var Programme : IXMLDOMNodeList;
     updatepossible : IXMLDOMNodeList;
     tmpfile : string;
     Pos : Integer;
     i,j : Integer;
     RunUpdate : Boolean;
    tmpexefile : string;
    reg : TRegistry;
    f : File;
begin
  Label2.Caption := 'MyApp führt die gelisteten Aufgaben aus...';
  Panel1.Refresh;
  RunUpdate := false;
  with CheckVersionCheck do
  begin
    glyph := igRound;
    Checked := true;
    refresh;
    Glyph := igCheck;
    caption := 'Laufende Version Gefunden : v' + inttostr(Version.Hauptversion) + '.' + inttostr(Version.Nebenversion) + ' (Build '+ inttostr(Version.build) + ')';
    Refresh;
    sleep(20);
  end;
  with ConnServerCheck do
  begin
    glyph := igRound;
    Checked := true;
    Refresh;
    sleep(20);
  end;
  tmpfile := 'C:\updatetemp.xml'; // Man kann auch jeden anderen Pfad benutzen das ist egal.
  if GetInetFile(updateURL, tmpfile,NIL) then
  begin
    with ConnServerCheck do
    begin
      Glyph := igCheck;
      Caption := 'Verbindung zum Server Hergestellt';
      refresh;
    end;
    with CheckUpdatesExists do
    begin
      Glyph := igRound;
      Checked := true;
      refresh;
    end;
    xmlUpdateDoc := CoDOMDocument.Create;
    xmlUpdateDoc.load(tmpfile);
    if (xmlUpdateDoc <> nil) then
    begin
      Programme := xmlUpdateDoc.selectNodes('/programme/programm');
      if Programme.length > 0 then
      begin
        // Checken ob überhaupt einträge in der XML-Datei sind
        for I := 0 to Programme.Length - 1 do
        begin
          // Den internen Namen die ID und die Build version checken
          if (Programme.item[i].selectSingleNode('int-name').text = int_Name) and
             (strtoint(Programme.item[i].selectSingleNode('id').text) = prg_ID) and
             (strtoint(Programme.item[i].selectSingleNode('build').text) > Version.Build) then
          begin
            updatepossible := Programme.item[i].selectNodes('updatepossible/build');
            // Checken mit welchem Laufenden build man das Update runterladen darf
            for J := 0 to updatePossible.Length - 1 do
            begin
              if (updatepossible.item[j].nodeName = 'build') and (UpdatePossible.item[j].text = inttostr(Version.Build)) then
              begin
                with CheckUpdatesExists do
                begin
                  Glyph := igCheck;
                  Caption := 'Neue Version Gefunden : v' +
                      Programme.item[i].selectSingleNode('version').text + ' (Build ' +
                      Programme.item[i].selectSingleNode('build').text + ')';
                  refresh;
                end;
                RunUpdate := true;
                // Dateiname der heruntergeladen werden muss auslesen
                UpdateFileDownload := Programme.item[i].selectSingleNode('file').text;
              end else if not RunUpdate then
              begin
                if (j = (UpdatePossible.Length-1)) then
                with CheckUpdatesExists do
                begin
                  Glyph := igCross;
                  Caption := 'Es existieren keine Upates für die Version : v' + inttostr(Version.Hauptversion) + '.' + inttostr(Version.Nebenversion) + ' (Build '+ inttostr(Version.build) + ')';
                  refresh;
                end;
              end;
            end;
          end else if not RunUpdate then
          with CheckUpdatesExists do
          begin
            Glyph := igCross;
            Caption := 'Es existieren keine Upates für die Version : v' + inttostr(Version.Hauptversion) + '.' + inttostr(Version.Nebenversion) + ' (Build '+ inttostr(Version.build) + ')';
            refresh;
          end;
        end;
      end;
    end;

  // Update Procedure an sich ! Herunterladen und starten ! :)
  if RunUpdate then
  begin
    tmpexefile := 'C:\Programme\MyApp\update.exe';
    DownloadUpdates.Visible := true;
    DownloadUpdates.Glyph := igRound;
    DownloadUpdates.Caption := 'Download von update.exe...';
    DownloadUpdates.Checked := true;
    Panel4.Refresh;
    if GetInetFile(UpdateFileDownload, tmpexefile, ProgressBar1) then
    begin
      DownloadUpdates.Glyph := igCheck;
      DownloadUpdates.Caption := 'Download von update.exe...Abgeschlossen';
      Panel4.Refresh;
      tmpfile := 'C:\updatetemp.xml';
      if FileExists(tmpfile) then
      begin
        assignFile(f, tmpFile);
        erase(f);
      end;
      UpdateRun := TFileRun.Create(self);
      UpdateRun.Browse := false;
      UpdateRun.FileName := tmpexefile;
      UpdateRun.Execute;
    end;
  end;
  end else
  ShowMessage('Fehler beim Versuch nach updates zu schauen !!');
end;

unit verInfo;
interface

uses windows, types, sysutils;

//Auslesen der Versionsnummer aus einer Datei
type
  T_Version = Record
    Hauptversion, Nebenversion, Ausgabe, Build : Integer;
  end;


  function GetVersion(Datei : String): T_Version;
implementation


function GetVersion(Datei : String): T_Version;
var
  VerInfoSize: DWORD;
  VerInfo: Pointer;
  VerValueSize: DWORD;
  VerValue: PVSFixedFileInfo;
  Dummy: DWORD;

begin
  Result.Hauptversion := 0;
  Result.Nebenversion := 0;
  Result.Ausgabe := 0;
  Result.Build := 0;

  If FileExists(Datei) Then begin
    VerInfoSize := GetFileVersionInfoSize(PChar(Datei), Dummy);
    if VerInfoSize = 0 then Exit;
    GetMem(VerInfo, VerInfoSize);
    GetFileVersionInfo(PChar(Datei), 0, VerInfoSize, VerInfo);
    VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
    with VerValue^ do
    begin
      Result.Hauptversion := (dwFileVersionMS shr 16);
      Result.Nebenversion := (dwFileVersionMS and $FFFF);
      Result.Ausgabe := (dwFileVersionLS shr 16);
      Result.Build := (dwFileVersionLS and $FFFF);
    end;
    FreeMem(VerInfo, VerInfoSize);
  end
  else begin
    Result.Hauptversion := 0;
    Result.Nebenversion := 0;
    Result.Ausgabe := 0;
    Result.Build := 0;
  end;
end;

end.

procedure TFOnlUpdate.FormCreate(Sender: TObject);
begin
  Version := GetVersion(Paramstr(0));
end;

function InitializeSetup(): Boolean;
var WinID : Integer;
begin
Result :=not Erkennen('myApp.exe'); // Der dateiname der ausgeführt wird.
if not Result then
  if Msgbox('Das Programm läuft noch,' + #13 + 'Soll das Programm beendet werden ?' , mbConfirmation, MB_YESNO) = IDYES then
  begin
    Result := True;
    WinID := FindWindowByWindowName('My Application'); // Der Name der im Fenster steht.
    if WinID <> 0 then
     // Mit dem SendMessage befehl wird das Programm beendet !
    SendMessage(FindWindowByWindowName('My Application'),WM_CLOSE,0,0) else
    begin
      WinID := FindWindowByWindowName('My Application - [Daten erfassen]'); // Der Name der im Fenster steht.
      // für den fall das man
      //eine MDI anwenung gemacht hat und hinten dran noch etwas steht !

      if WinID <> 0 then SendMessage(FindWindowByWindowName('My Application - [Daten erfassen]'),WM_CLOSE,0,0) else
      MsgBox('My Application konnte nicht beendet werden,' + #13 + 'Bitte beenden sie Das Programm manuell oder Starten sie das Setup zu einem Späteren Zeitpunkt.', mbError, MB_OK);
    end;
  end else result := false;
end;