📄 main.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 + -