⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 configupdateini,AutoUpgrader.Pro.v4.6.4的升级配置源码
💻 PAS
字号:
{*******************************************************************************

  AutoUpgrader Professional
  FILE: auAutoUpgraderEditor.pas - property editor for auAutoUpgrade component.

  Copyright (c) 1999-2004 UtilMind Solutions
  All rights reserved.
  E-Mail: info@utilmind.com
  WWW: http://www.utilmind.com, http://www.appcontrols.com

  The entire contents of this file is protected by International Copyright
Laws. Unauthorized reproduction, reverse-engineering, and distribution of all
or any portion of the code contained in this file is strictly prohibited and
may result in severe civil and criminal penalties and will be prosecuted to
the maximum extent possible under the law.

*******************************************************************************}
{$I auDefines.inc}

unit main;

interface

uses
  Windows, Classes, Controls, Forms, StdCtrls, Menus, Graphics,
  ExtCtrls, ComCtrls, SysUtils, Dialogs,
  Registry,ImgList,auExtAssociation, syXMLDoc;

type
  TfrmMain = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    DateEdit: TEdit;
    NumberEdit: TEdit;
    Label3: TLabel;
    ByDateRadio: TRadioButton;
    ByNumberRadio: TRadioButton;
    GroupBox2: TGroupBox;
    OKBtn: TButton;
    ExportBtn: TButton;
    SaveDialog: TSaveDialog;
    AddBtn: TButton;
    DeleteBtn: TButton;
    CheckURLBtn: TButton;
    Panel1: TPanel;
    ImageList: TImageList;
    PopupMenu: TPopupMenu;
    ListView: TListView;
    AddItem: TMenuItem;
    DeleteItem: TMenuItem;
    RenameItem: TMenuItem;
    CheckURLItem: TMenuItem;
    N2: TMenuItem;
    Label6: TLabel;
    ReplaceRadio: TRadioButton;
    SetupRadio: TRadioButton;
    RedirectRadio: TRadioButton;
    sdProject: TSaveDialog;
    xmlProject: TsyXMLDocument;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    About1: TMenuItem;
    About2: TMenuItem;
    miNewProject: TMenuItem;
    miSaveProject: TMenuItem;
    N1: TMenuItem;
    miExport: TMenuItem;
    N3: TMenuItem;
    miExit: TMenuItem;
    GroupBox3: TGroupBox;
    Memo1: TMemo;
    TestBtn: TButton;
    OpenProject1: TMenuItem;
    odProject: TOpenDialog;
    Label4: TLabel;
    procedure ExportBtnClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure OKBtnClick(Sender: TObject);
    procedure TestBtnClick(Sender: TObject);
    procedure ByDateRadioClick(Sender: TObject);
    procedure DateEditExit(Sender: TObject);
    procedure AddBtnClick(Sender: TObject);
    procedure ListViewChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure FormShow(Sender: TObject);
    procedure DeleteBtnClick(Sender: TObject);
    procedure CheckURLBtnClick(Sender: TObject);
    procedure RenameItemClick(Sender: TObject);
    procedure ListViewDblClick(Sender: TObject);
    procedure miExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure miSaveProjectClick(Sender: TObject);
    procedure miNewProjectClick(Sender: TObject);
    procedure OpenProject1Click(Sender: TObject);
    procedure About2Click(Sender: TObject);
    procedure Label4Click(Sender: TObject);
  private
    FNewProject: string;
    procedure AddURLToList(URL: String);
    procedure doEnable;
    procedure InitProject(value: string);
    procedure buildProjectxml;
  public
    procedure newProject;
  end;

var
  frmMain:TfrmMain;
implementation

{$R *.DFM}

uses Messages, ClipBrd, auUtils, auAutoUpgraderAddURL, auAutoUpgraderUpgradeMsg;

const
  InfoFileSeparator = '#############################################################';

// ---------------------------------------------------
procedure TfrmMain.ExportBtnClick(Sender: TObject);
var
  I: Integer;
  ListItem: TListItem;
  TF: TextFile;

  procedure WriteCenterStr(St: String);
  var
    I, BQuote: Integer;
  begin
    BQuote := (Length(InfoFileSeparator) - 2 - Length(St)) div 2;
    Write(TF, '#');
    for I := 1 to BQuote do Write(TF, ' ');
    Write(TF, St);
    for I := 1 to BQuote do Write(TF, ' ');
    if not Odd(Length(St)) then Write(TF, ' ');
    WriteLn(TF, '#');
  end;

  procedure WriteRightStr(St: String);
  var
    I, BQuote: Integer;
  begin
    BQuote := (Length(InfoFileSeparator) - 6 - Length(St));
    Write(TF, '#');
    for I := 1 to BQuote do Write(TF, ' ');
    Write(TF, St);
    WriteLn(TF, '   #');
  end;

begin
  if SaveDialog.Execute then
   try
     AssignFile(TF, SaveDialog.FileName);
     Rewrite(TF);

     WriteLn(TF, InfoFileSeparator);
     WriteCenterStr('Generated by AutoUpgrader Pro at: ' + DateTimeToStr(Now));
     WriteLn(TF, InfoFileSeparator);
     WriteLn(TF);
     WriteLn(TF, '#message={' + Memo1.Text + '}'#13#10);
     I := ListView.Items.Count;
     if I <> 0 then
      for I := 0 to I - 1 do
       begin
        ListItem := ListView.Items[I];
        WriteLn(TF, '#url' + IntToStr(I + 1) + '=' + ListItem.Caption);
       end;

     Write(TF, #13#10'#method=');
     if ReplaceRadio.Checked then
       WriteLn(TF, '0 (self-upgrade)')
     else
       if SetupRadio.Checked then
         WriteLn(TF, '1 (use setup)')
       else
         WriteLn(TF, '2 (redirect)');
     WriteLn(TF);

     if ByDateRadio.Checked then
       WriteLn(TF, '#date=' + DateEdit.Text)
     else
       WriteLn(TF, '#version=' + NumberEdit.Text);

     CloseFile(TF);
   except
   end;
end;

procedure TfrmMain.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmMain.AddURLToList(URL: String);
var
  ListItem: TListItem;
begin
  ListItem := ListView.Items.Add;
  ListItem.Caption := URL;
  ListItem.ImageIndex := ImageList.Count;

  with TauExtAssociation.Create(Self) do
   try
     Extension := ExtractFileExt(URL);
     if Extension = '' then Extension := 'autmp'; // anything
     ImageList.AddIcon(SmallIcon);
   except
     Free;
   end; 
end;

procedure TfrmMain.FormShow(Sender: TObject);
(*var
  I: Integer;*)
begin
  ListView.Columns[0].Width := ListView.Width - GetSystemMetrics(SM_CXVSCROLL);
  {$IFDEF D3}
  ListView.RowSelect := True;
  {$ENDIF}
  doEnable;
end;

procedure TfrmMain.OKBtnClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.TestBtnClick(Sender: TObject);
begin
  ShowUpgradeBox(Memo1.Text);
end;

procedure TfrmMain.ByDateRadioClick(Sender: TObject);
begin
  (*TODO: extracted code
  if ByDateRadio.Checked then
   begin
    DateEdit.Enabled := True;
    NumberEdit.Enabled := False;
    DateEdit.Color := clWindow;
    NumberEdit.Color := clBtnFace;
   end
  else
   begin
    DateEdit.Enabled := False;
    NumberEdit.Enabled := True;
    DateEdit.Color := clBtnFace;
    NumberEdit.Color := clWindow;
   end;
  *)
  doEnable;
end;


{ sort of spell checking }
procedure TfrmMain.DateEditExit(Sender: TObject);
var
  I: Integer;
  St: String;
  Valid: Boolean;
  Separators: Byte;
begin
  Valid := True;
  Separators := 0;

  St := DateEdit.Text;
  I := Length(St);
  if I <> 0 then
   for I := 1 to I do
    if ((St[I] < '0') or (St[I] > '9')) and (St[I] <> '/') then
      Valid := False
    else
     if St[I] = '/' then inc(Separators);

  if Separators <> 2 then Valid := False;

  if not Valid then
   begin
    Application.MessageBox('Date format is not valid "MM/DD/YYYY"', 'Invalid date format', mb_Ok or mb_IconExclamation);
    DateEdit.SetFocus;
   end;
end;

procedure TfrmMain.ListViewChange(Sender: TObject;
  Item: TListItem; Change: TItemChange);
begin
  DeleteBtn.Enabled := ListView.Selected <> nil;
  DeleteItem.Enabled := DeleteBtn.Enabled;
  RenameItem.Enabled := DeleteBtn.Enabled;
  CheckURLBtn.Enabled := DeleteBtn.Enabled;
  CheckURLItem.Enabled := DeleteBtn.Enabled;
end;

procedure TfrmMain.AddBtnClick(Sender: TObject);
begin
  with TauAddURLForm.Create(Application) do
   try
     if ShowModal = ID_OK then
       AddURLToList(URLEdit.Text);
   except
     Free;
   end;
end;

procedure TfrmMain.RenameItemClick(Sender: TObject);
begin
  ListView.Selected.EditCaption;
end;

procedure TfrmMain.DeleteBtnClick(Sender: TObject);
begin
  if ListView.Selected <> nil then
    ListView.Items.Delete(ListView.Selected.Index);

  if ListView.Items.Count = 0 then
    Imagelist.Clear;  
end;

procedure TfrmMain.CheckURLBtnClick(Sender: TObject);
begin
  if ListView.Selected <> nil then
    OpenURL(ListView.Selected.Caption, True);
end;

procedure TfrmMain.doEnable;
begin
  if ByDateRadio.Checked then
   begin
    DateEdit.Enabled := True;
    NumberEdit.Enabled := False;
    DateEdit.Color := clWindow;
    NumberEdit.Color := clBtnFace;
   end
  else
   begin
    DateEdit.Enabled := False;
    NumberEdit.Enabled := True;
    DateEdit.Color := clBtnFace;
    NumberEdit.Color := clWindow;
   end;
end;

procedure TfrmMain.ListViewDblClick(Sender: TObject);
begin
  if ListView.Selected <> nil then
   ListView.Selected.EditCaption
end;

procedure TfrmMain.miExitClick(Sender: TObject);
begin
  close;
end;

procedure TfrmMain.newProject;
begin
  InitProject(FNewProject);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FNewProject := xmlProject.XMLText.Text;
end;

procedure TfrmMain.InitProject(value: string);
var
  I: Integer;
  node: TsyxmlNode;
begin
  (*
  project xml struct:
  <Project>
    <URLS>
        <URL>http://www.appcontrols.com/download/exe/AutoUpgraderPro2.exe</URL>
        <URL>http://www.appcontrols.com/download/exe/readme.txt</URL>
    </URLS>
    <MSG>having updating</MSG>
    <value>self;setup;redirect</value>
    <VersionControl value='number' >
        <Value>1</Value>
    </VersionControl>
  </Project>
*)
  xmlProject.XMLText.Text := value;
  xmlProject.AnalyseXML;

  // parse memo text
  Memo1.Text := xmlProject.OpenNode('Project\MSG',true).Value;

  //parse method
  value:=xmlProject.OpenNode('Project\Method',true).Value;
  if value='self' then ReplaceRadio.Checked:= true
  else
    if value='setup' then SetupRadio.Checked := true
    else
        RedirectRadio.Checked := true;

  // parse version control
  value:=xmlProject.OpenNode('Project\VersionControl',
    true).AttrSet.Values['value'];
  if value='number' then
  begin
    ByNumberRadio.Checked := true;
    NumberEdit.Text := xmlProject.OpenNode('Project\VersionControl\Value', true).Value;
  end else
    begin
      ByDateRadio.Checked := true;
      DateEdit.Text := xmlProject.OpenNode('Project\VersionControl\Value', true).Value;
    end;
   ListView.Items.Clear;
   //Add URL To List
   node:=xmlProject.OpenNode('Project\URLS',true);
   for I := 0 to node.Count - 1 do    // Iterate
   begin
     AddURLToList(node.Items[I].Value);
   end;    // for;
   doEnable;
end;

procedure TfrmMain.miSaveProjectClick(Sender: TObject);
begin
  if sdProject.Execute then
  begin
    buildProjectxml;
    xmlProject.SaveToFile(sdProject.FileName);
  end;
end;

procedure TfrmMain.miNewProjectClick(Sender: TObject);
begin
  newProject;
end;

procedure TfrmMain.buildProjectxml;
var
  ListItem: TListItem;
  I: Integer;
  node: TsyxmlNode;
  value: string;
begin
  (*
    project xml struct:
    <Project>
      <URLS>
          <URL>http://www.appcontrols.com/download/exe/AutoUpgraderPro2.exe</URL>
          <URL>http://www.appcontrols.com/download/exe/readme.txt</URL>
      </URLS>
      <MSG>having updating</MSG>
      <Method>self;setup;redirect</Method>
      <VersionControl Method='number' >
          <Value>1</Value>
      </VersionControl>
    </Project>
  *)
    xmlProject.Clear;
  // save memo text
    xmlProject.OpenNode('Project\MSG', true).Value := Memo1.Text;

    //save method
    if ReplaceRadio.Checked then value :='self'
    else
      if SetupRadio.Checked then value:='setup'
      else
          value:='redirect';
    xmlProject.OpenNode('Project\Method', true).Value := value;

    // save version control

    if ByNumberRadio.Checked  then
    begin
      xmlProject.OpenNode('Project\VersionControl\Value', true).Value :=
        NumberEdit.Text;
      value:='number';
    end else
      begin
        xmlProject.OpenNode('Project\VersionControl\Value', true).Value :=
          DateEdit.Text;
        value:='date';
      end;
    xmlProject.OpenNode('Project\VersionControl',true).
      AttrSet.Values['value'] := value;

     //Add URLs To xml
     node:=xmlProject.OpenNode('Project\URLS',true);
     for I := 0 to ListView.Items.Count - 1 do
     begin
      ListItem := ListView.Items[I];
      with node.Add do
      begin
        Name := 'URL';
        Value:= ListItem.Caption;
      end;
     end;
end;

procedure TfrmMain.OpenProject1Click(Sender: TObject);
begin
  if odProject.Execute then
  begin
    xmlProject.LoadFromFile( odProject.FileName);
    InitProject(xmlProject.XMLText.Text);
  end;
end;

procedure TfrmMain.About2Click(Sender: TObject);
begin
  Application.MessageBox(PChar('This tool for UtilMind.AutoUpgrader.Pro.v4.6.7 Component.' + #13 + #10 + 'Writed ' +
  'by Bona Shen.' + #13 + #10 + #13 + #10 + 'Email:jssy163163.com'), 'About', MB_OK + MB_ICONINFORMATION);
end;

procedure TfrmMain.Label4Click(Sender: TObject);
begin
  OpenURL('http://jssy.cnblogs.com',true);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -