?? main.pas.~14~
字號:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics
, Controls, Forms,
Dialogs
, UrlMon
, StrUtils
, autoupdate, Gauges, ComCtrls, StdCtrls
;
type
MD5Digest = array[0..15] of Byte;
TForm1 = class(TForm)
Label1: TLabel;
cbb1: TComboBox;
Label2: TLabel;
lv1: TListView;
g1: TGauge;
Label3: TLabel;
lblCount: TLabel;
Label4: TLabel;
lblSpeed: TLabel;
chk1: TCheckBox;
chk2: TCheckBox;
btn1: TButton;
procedure FormShow(Sender: TObject);
procedure chk1Click(Sender: TObject);
procedure chk2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btn1Click(Sender: TObject);
private
xmlHash:string;
remoteUrl:string;
LocalPath:string;
filePathList:TStringList;
UpdateString:TStringList;
{ Private declarations }
function downFile(URL,apath:string): boolean;
function adjustPath(apath:string): string;
function checkFiles(): boolean;
procedure intLV(lv:TListView);
procedure intCbb(Cbb:TCombobox);
function intUpdate(lv:TListView): boolean;
public
{ Public declarations }
end;
const
FILENOTEXIST='File doesn''t exist!';
DOWNERROR='Download file error!';
var
Form1: TForm1;
myCfg:IXMLConfigType;
implementation
function MD5String(M: string): MD5Digest;stdcall;external 'md5hash.dll';
function MD5File(N: string): MD5Digest;stdcall;external 'md5hash.dll';
function MD5Print(D: MD5Digest): string;stdcall;external 'md5hash.dll';
function MD5Match(D1, D2: MD5Digest): boolean;stdcall; external 'md5hash.dll';
{$R *.dfm}
{ TForm1 }
function TForm1.adjustPath(apath: string): string;
begin
apath:=StringReplace(apath,'/','\',[rfReplaceAll]);
while RightStr(apath,1)='\' do
begin
apath:=Copy(apath,1,Length(apath)-1);
end;
Result:=apath;
end;
procedure TForm1.btn1Click(Sender: TObject);
var
i,n:Integer;
s,s1:string;
begin
if intUpdate(lv1) then
begin
for I := 0 to UpdateString.Count - 1 do
begin
n:=Pos('@',UpdateString[i]);
s1:=Copy(UpdateString[i],1,n-1);
s:=Copy(UpdateString[i],n+1,Length(UpdateString[i])-n);
if FileExists(s) then
DeleteFile(s);
if downFile(s1,adjustPath(ExtractFilePath(s))) then
Sleep(200);
end;
ShowMessage('所有更新下載完成');
end
else
begin
ShowMessage('必須升級的選項,必須被勾選上');
Exit;
end;
end;
function TForm1.checkFiles: boolean;
var
i:Integer;
newItem:TListItem;
begin
Result:=False;
filePathList:=TStringList.Create;
myCfg:=Loadconfig(LocalPath+'\autoupdate.xml');
with myCfg.FileList do
begin
for I := 0 to Count - 1 do
begin
if (FileInfo[i].FileHash
<>
MD5Print(MD5File(LocalPath+'\'+FileInfo[i].FilePath)))
or
(not FileExists(LocalPath+'\'+fileinfo[i].FilePath))
then
begin
Result:=True;
newItem:=lv1.Items.Add;
newItem.Caption:='';
newItem.SubItems.Add(FileInfo[i].FileName);
newItem.SubItems.Add(FileInfo[i].FileVersion);
newItem.SubItems.Add(FileInfo[i].FileLevel);
filePathList.Add(FileInfo[i].FilePath);
end;
end;
end;
end;
procedure TForm1.chk1Click(Sender: TObject);
var
i:Integer;
begin
for I := 0 to lv1.Items.Count - 1 do
begin
lv1.Items[i].Checked:=chk1.Checked;
end;
chk2.Checked:=chk1.Checked;
end;
procedure TForm1.chk2Click(Sender: TObject);
var
i:Integer;
begin
with lv1 do
begin
for I := 0 to Items.Count - 1 do
begin
if StrToBool(Items[i].SubItems[2]) then
Items[i].Checked:=chk2.Checked;
// ShowMessage(Items[i].SubItems[1]);
end;
end;
end;
function TForm1.downFile(URL,apath: string): boolean;
begin
try
Result:=URLDownloadToFile(nil,PChar(URL),PChar(apath),0,nil)=0;
except
Result:=False;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
filePathList.Free;
UpdateString.Free;
end;
procedure TForm1.FormShow(Sender: TObject);
var
F1:TextFile;
s:string;
begin
remoteUrl:='http://savagers.go3.icpcn.com/update';
LocalPath:=adjustPath(ExtractFilePath(Application.ExeName));
//-----------------------------------------------------------------
if downFile(remoteUrl+'/xmlCode.txt',LocalPath+'\xmlCode.txt') then
begin
try
//read the xmlhash code;
AssignFile(F1,'xmlCode.txt');
Reset(F1);
xmlHash:='';
while not Eof(F1) do
begin
Readln(F1,s);
xmlHash:=xmlHash+s;
end;
xmlHash:=Trim(xmlHash);
//need to download autoupdate.xml or not
if (not FileExists(LocalPath+'\autoupdate.xml'))
or
(xmlHash<>MD5Print(MD5File(LocalPath+'\autoupdate.xml'))) then
begin
downFile(remoteUrl+'/autoupdate.xml',LocalPath+'\autoupdate.xml')
end
finally
CloseFile(F1);
end;
intLV(lv1);
//return while or not
if not checkFiles then
Close;
intCbb(cbb1);
end
else //download xmlCode.txt error
ShowMessage(DOWNERROR);
// ShowMessage(xmlHash);
end;
procedure TForm1.intCbb(Cbb: TCombobox);
var
i:Integer;
begin
with Cbb do
begin
Items.Clear;
with myCfg do
begin
for I := 0 to SrvList.Count - 1 do
begin
Items.Append(SrvList.SrvInfo[i].SrvName);
end;
end;
ItemIndex:=0;
end;
end;
procedure TForm1.intLV(lv: TListView);
var
// CaptionArr:array[0..2] of string;
// nwidth,i:Integer;
nwidth:Integer;
newItem:TListColumn;
begin
lv.Items.Clear;
lv.ViewStyle:=vsReport;
lv.Checkboxes:=True;
nwidth:=Round((lv.Width-50)/3);
//-------------------------
with lv do
begin
newItem:=Columns.Add;
newItem.Caption:='升級';
newItem.Width:=50;
newItem:=Columns.Add;
newItem.Caption:='文件名';
newItem.Width:=nwidth;
newItem:=Columns.Add;
newItem.Caption:='版本號';
newItem.Width:=nwidth;
newItem:=Columns.Add;
newItem.Caption:='必須';
newItem.Width:=nwidth;
end;
lv.AlphaSort;
end;
function TForm1.intUpdate(lv: TListView): boolean;
var
i:Integer;
s:string;
srvURL:string;
begin
Result:=True;
UpdateString:=TStringList.Create;
UpdateString.Clear;
srvURL:=myCfg.SrvList.SrvInfo[cbb1.ItemIndex].SrvPath;
for I := 0 to lv.Items.Count - 1 do
begin
s:='';
if lv.Items[i].Checked then
begin
s:=srvURL+'/'+filepathList[i];
s:=s+'@'+localpath+'\'+filepathlist[i];
UpdateString.Add(s);
end;
if (not lv.Items[i].Checked)and(StrToBool(lv.Items[i].SubItems[2])) then
begin
Result:=False;
Exit;
end;
end;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -