appwebupdater.pas

Delphi VCL Component Pack

      begin
         if XmlParser.CurPartType = ptXmlProlog then
            begin
               AddLog('Parsing XML Head section');
               Result := True;
               exit;
            end
         else
            begin
               AddLog('Error parsing XML Head section');
               ErrMessagesHandler(emXMLError, '(  XML Head)');
            end;
      end;
end;

function TWebUpdater.GetXmlTag(const TagName: string): boolean;
begin
   Result := False;
   if Quit then
      begin
         ExitUser();
         Exit;
      end;
   while XmlParser.Scan() do
      begin
         if ((XmlParser.CurPartType = ptStartTag)
            or (XmlParser.CurPartType = ptEmptyTag))
            and (XmlParser.CurName = TagName) then
            begin
               AddLog('Parsing XML tag: ' + TagName);
               Result := True;
               Exit;
            end;
      end;
end;

function TWebUpdater.GetXmlData(): boolean;
begin
   Result := False;
   if Quit then
      begin
         ExitUser();
         Exit;
      end;
   while XmlParser.Scan() do
      begin
         if ((XmlParser.CurPartType = ptContent) or (XmlParser.CurPartType = ptCData)) then
            begin
               AddLog('Parsing XML data');
               Result := True;
               exit;
            end
         else
            begin
               ErrMessagesHandler(emXMLError, ' (XML Data)');
               AddLog('Error parsing XML data');
            end;
      end;
end;

function TWebUpdater.DownloadFile(SourceFile, DestFile: string): Boolean;
var
   st: string;
begin
   Result := False;
   if Quit then
      begin
         ExitUser();
         Exit;
      end;
   Dcb := TDownloadCallback.Create;
   Dcb.ProgressMax := 100;
   try
      st := 'Application folder\' + DestFile;
      AddLog('Trying to download: ' + SourceFile + '  To: ' + st);
      if UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, dcb) = 0 then
         begin
            UpdateProgressControls(100, Dcb.Position);
            Result := True;
            AddLog(OnProgressStatusList.Text + LineBrk + 'Downloading ' + SourceFile +
               ' To: ' + st + ' was successful.')
         end
      else
         begin
            Result := False;
            ErrMessagesHandler(emDownloadInfo, SourceFile);
         end;
   except
      begin
         Result := False;
         ErrMessagesHandler(emDownloadInfo, SourceFile);
      end;
   end;
end;

function TWebUpdater.DeleteFiles(FileName: string): Boolean;
begin
   Result := False;
   if Quit then
      begin
         ExitUser();
         Exit;
      end;
   if not FileExists(FileName) then
      FileName := (GetCurrentDir + '\' + TrimLeft(FileName));
   begin
      FileName := TrimLeft(FileName);
      if DeleteFile(PChar(FileName)) then
         begin
            if FileName <> FLogFileName then
               begin
                  AddLog('File deleted: ' + FileName);
                  Result := True;
               end;
         end;
   end;
end;

function TWebUpdater.DeleteFolder(FolderName: string): Boolean;
var
   st: string;
   i: integer;
begin
   Result := False;
   if Quit then
      begin
         ExitUser();
         Exit;
      end;
   st := GetCurrentDir + '\' + FolderName;
   if FolderName = FUpdatesFolder then
      try
         for i := 0 to UpdateRec.NoRestartList.Count - 1 do
            begin
               DeleteFiles(st + TrimLeft(UpdateRec.NoRestartList[i]));
               Addlog('File deleted: ' + st + TrimLeft(UpdateRec.NoRestartList[i]));
            end;
         for i := 0 to UpdateRec.WithRestartList.Count - 1 do
            begin
               DeleteFiles(st + TrimLeft(UpdateRec.WithRestartList[i]));
               Addlog('File deleted: ' + st + TrimLeft(UpdateRec.WithRestartList[i]));
            end;
      except
      end;
   i := Length(st) - 1;
   SetLength(st, i);
   if RemoveDir(st) then
      begin
         Addlog('Folder deleted: ' + st);
         Result := True;
      end;
end;

function TWebUpdater.OpenFolder(FolderName: string): Boolean;
begin
   Result := False;
   if Quit then
      begin
         ExitUser();
         Exit;
      end;
   ShellExecute(Forms.Application.Handle, 'explore', Pchar(FolderName), nil,
      nil, SW_SHOWNORMAL);
   Addlog('Open folder : ' + FolderName);
   Result := True;
end;

procedure TWebUpdater.ProcessFolderNames();
begin
   if Quit then
      begin
         ExitUser();
         Exit;
      end;
   AddLog('Start processing file names. ');
   UpdateProgressControls(100, 20);
{$IFDEF DELPHI_6_UP}
{$WARN SYMBOL_PLATFORM OFF}
{$ENDIF}
   XmlFile := Pchar(FWebURL + '/' + (fWebInfoFileName));
   FBatFileName := ChangeFileExt(Application.ExeName, '.bat');
   FExeName := ExtractFileName(Application.ExeName);
   FUpdatesFolder := IncludeTrailingBackslash(fUpdatesFolder);
   ApplicationFolder := IncludeTrailingBackslash(UpperCase(ExtractFilePath(Application.ExeName)));
   if Trim(fBackupFolder) = ''
      then
      FBackupFolder := ApplicationFolder + FBackupFolder
   else
      FBackupFolder := IncludeTrailingBackslash(fBackupFolder);
   AddLog('Finished processing files names.');
{$IFDEF DELPHI_6_UP}
{$WARN SYMBOL_PLATFORM ON}
{$ENDIF}
end;

procedure TWebUpdater.InitialUpdating();
begin
   ClearLog();
   WriteLog();
   AddLog('Initializing the updater.');
   NeedTerminate := False;
   FUpdateText.Clear();
   UpdateAppControls();
   UpdateProgressControls(100, 10);
   UpdateTextControls('Checking for updates...');
   ProcessFolderNames();
   if FDeleteBackups then
      if DeleteFile(fBackUpFolder + '\*.*') then
         DeleteFolder(Trim(fBackUpFolder));
end;

function TWebUpdater.ParseXML(): boolean;
var
   Node: TNvpNode;
   i: integer;
   UpdRec: PUpRec;
   MS: TMemoryStream;
   Zero: Char;
   Container: string;
   {$IFDEF DELPHI_7_UP}
   FormatSettings: TFormatSettings;
   {$ENDIF}
begin
   Result := False;
   if Quit then
      begin
         ExitUser();
         Exit;
      end;
   AddLog('Start downloading xml remote file.');
   if DownloadFile(XmlFile, FWebInfoFileName) then
      begin
         if not FileExists(ExtractFilePath(ParamStr(0)) + FWebInfoFileName) then
            begin
               ErrMessagesHandler(emFileNotExist, FWebInfoFileName);
               ExitError(fErrorMessage + 'trying to locate the web info file.');
               Exit;
            end
         else
            begin
               Zero := #0;
               MS := TMemoryStream.Create;
               MS.Write(Zero, 1);
               MS.LoadFromFile(fWebInfoFileName);
               XmlParser.SetBuffer(MS.Memory);
               XmlParser.Normalize := False;
               XmlParser.StartScan();
               if not GetXmlHead() then
                  if FQuitOnError then
                     begin
                        ExitError('An error has been found in the update XML file (Head Section)');
                        Exit;
                     end;
               if not GetXmlTag('Updates') then
                  if FQuitOnError then
                     begin
                        ExitError('An error has been found in the update XML file (Updates Section)');
                        Exit;
                     end;
               if not GetXmlTag('Details') then
                  if FQuitOnError then
                     begin
                        ExitError('An error has been found in the update XML file (Details)');
                        Exit;
                     end;
               if not GetXmlTag('ApplicationName') then
                  if FQuitOnError then
                     begin
                        ExitError('An error has been found in the update XML file (Application Name)');
                        Exit;
                     end;
               if not GetXmlData() then
                  if FQuitOnError then
                     begin
                        ExitError('An error has been found in the update XML file (Application Name)');
                        Exit;
                     end;
               if MatchDetails then
                  if not PerformMatchDetails(Trim(fApplicationName),
                     Trim(XmlParser.CurContent)) then
                     begin
                        ExitMatch();
                        Exit;
                     end;
               FApplicationName := XmlParser.CurContent;
               if not GetXmlTag('Author') then
                  if FQuitOnError then
                     begin
                        ExitError('An error has been found in the update XML file (Author)');
                        Exit;
                     end;
               if not GetXmlData() then
                  if FQuitOnError then
                     begin
                        ExitError('An error has been found in the update XML file (Author)');
                        Exit;
                     end;
               if MatchDetails then
                  if not PerformMatchDetails(Trim(fAuthor),
                     Trim(XmlParser.CurContent)) then
                     begin
                        ExitMatch();
                        Exit;
                     end;
               FAuthor := XmlParser.CurContent;
               if not GetXmlTag('Company') then
                  if FQuitOnError then
                     begin
                        ExitError('An error has been found in the update XML file (Company)');
                        Exit;
                     end;
               if not GetXmlData() then
                  if FQuitOnError then
                     begin
                        ExitError('An error has been found in the update XML file (Company)');
                        Exit;
                     end;
               if MatchDetails then
                  if not PerformMatchDetails(Trim(fCompany),
                     Trim(XmlParser.CurContent)) then
                     begin
                        ExitMatch();
                        Exit;
                     end;
               FCompany := XmlParser.CurContent;
               if not GetXmlTag('Version') then
                  if FQuitOnError then
                     begin
                        ExitError('An error has been found in the update XML file (Version)');
                        Exit;
                     end;
               if not GetXmlData() then
                  if FQuitOnError then
                     begin
                        ExitError('An error has been found in the update XML file (Version)');
                        Exit;
                     end;
                {$IFDEF DELPHI_7_UP}
               GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT, formatSettings);
               FormatSettings.DecimalSeparator := '.';
               fAppNewVer := StrToFloat(XmlParser.CurContent, FormatSettings);
               {$ELSE}
               fAppNewVer := StrToFloat(XmlParser.CurContent);
                    {$ENDIF}
               AddLog('Application current version is: ' + FloatToStr(AppCurrentVer) +
                  LineBrk + '  Update version is: ' + XmlParser.CurContent);

               if not GetXmlTag('ChangeLog') then
                  if FQuitOnError then
                     begin
                        ExitError('An error has been found in the update XML file (ChangeLog section)');
                        Exit;
                     end;
               FUpdateText.Add(LineBrk);
               while GetXmlTag('Info') do
                  begin
                     for i := 0 to XmlParser.CurAttr.Count - 1 do
                        begin
                           Node := TNvpNode(XmlParser.CurAttr[i]);
                           if Node.Name = 'Text' then
                              FUpdateText.Add(TrimLeft(Node.Value));
                        end;
                  end;
               XmlParser.StartScan;
               if not GetXmlTag('Instructions') then
                  if FQuitOnError then
                     begin
                        ExitError('An error has been found in the update XML file (Instructions section)');
                        Exit;
                     end;
               while GetXmlTag('File') do
                  begin
                     New(UpdRec);
                     UpdRec.dlFileName := '';
                     UpdRec.dlDestination := '';
                     UpdRec.dlTerminate := False;
                     for i := 0 to XmlParser.CurAttr.Count - 1 do
                        begin
                           Node := TNvpNode(XmlParser.CurAttr[i]);
                           Container := Trim(Node.Name);
                           if Container = 'Name' then
                              UpdRec.dlFileName := Trim(Node.Value)
                           else
                              if (Container = 'Destination') then
                                 begin
                                    UpdRec.dlDestination := Trim(Node.Value) + '\';
                                    if UpdRec.dlDestination = 'ApplicationFolder\' then
                                       UpdRec.dlDestination := '';
                                 end
                              else
                                 if (Container = 'Terminate') then
                                    begin
                                       if Trim(Node.Value) = 'yes' then
                                          begin
                                             UpdRec.dlTerminate := True;