📄 frmmain.pas
字号:
unit frmMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ActnList, ComCtrls, RzListVw, RzTreeVw, RzPrgres, IniFiles,
StdCtrls, RzLstBox, RzLabel, ExtCtrls, GIFImage, RzButton, RzPanel, hxConst,
ShellApi, RzRadChk;
const
CM_FINISHUPDATE = WM_USER + 1;
type
TMainForm = class(TForm)
RzPanel1: TRzPanel;
RzButton2: TRzButton;
RzButton3: TRzButton;
RzButton4: TRzButton;
RzPanel2: TRzPanel;
RzPanel3: TRzPanel;
Image1: TImage;
Notebook1: TNotebook;
RzPanel5: TRzPanel;
RzLabel9: TRzLabel;
RzLabel10: TRzLabel;
pbFileList: TRzProgressBar;
lblDownloadFileList: TRzLabel;
RzPanel6: TRzPanel;
RzLabel1: TRzLabel;
pbTotalDownload: TRzProgressBar;
lblDownloadFileName: TRzLabel;
pbFileDownload: TRzProgressBar;
RzLabel12: TRzLabel;
RzLabel2: TRzLabel;
lvUpdateFiles: TRzListView;
RzPanel7: TRzPanel;
RzLabel3: TRzLabel;
RzLabel8: TRzLabel;
Label1: TRzLabel;
ActionList1: TActionList;
actOpen: TAction;
actClose: TAction;
actDownloadFileList: TAction;
actDowloadSelectedFiles: TAction;
actDownloadNewFiles: TAction;
actBack: TAction;
actNext: TAction;
actCancel: TAction;
actFinish: TAction;
actConfig: TAction;
actViewFileInfo: TAction;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
RzPanel4: TRzPanel;
RzLabel4: TRzLabel;
RzLabel5: TRzLabel;
RzLabel6: TRzLabel;
RzLabel7: TRzLabel;
RzButton1: TRzButton;
lvOldVersions: TRzListView;
lvNewVersions: TRzListView;
chkRunExe: TRzCheckBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure actBackExecute(Sender: TObject);
procedure actBackUpdate(Sender: TObject);
procedure actNextExecute(Sender: TObject);
procedure actNextUpdate(Sender: TObject);
procedure actCancelExecute(Sender: TObject);
procedure actCancelUpdate(Sender: TObject);
procedure actFinishExecute(Sender: TObject);
procedure actFinishUpdate(Sender: TObject);
procedure actConfigExecute(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
FLibHandle: THandle;
protected
procedure FinishUpdate(var Msg: TMessage); message CM_FINISHUPDATE;
public
{ Public declarations }
end;
PVerInfo = ^TVerInfo;
TVerInfo = record
FileName: PChar;
Version: PChar;
end;
TInitDll = function(ProjectName: PChar; Host: PChar; Port: Integer;
ASocksInfo: PSocksInfo = nil): Boolean; stdcall;
TCheckVersion = function: Boolean; stdcall;
TUpdateProduct = function(DownloadProgress: TDownloadProgress): Boolean; stdcall;
TGetVersions = function(VerInfo: PVerInfo; Index: Integer): Integer; stdcall;
procedure DoDownloadProgress(DownloadStatus: TDownloadStatus; FileName: string;
WorkCount: Integer);
var
MainForm: TMainForm;
implementation
uses
frmConfig;
{$R *.dfm}
procedure DoDownloadProgress(DownloadStatus: TDownloadStatus; FileName: string;
WorkCount: Integer);
begin
with MainForm do
begin
case DownloadStatus of
dsBegin:
begin
pbTotalDownload.TotalParts:= WorkCount;
pbTotalDownload.Percent:= 0;
end;
dsFileBegin:
begin
lblDownloadFileName.Caption:= Format('正在下载%s....', [FileName]);
pbFileDownload.TotalParts:= WorkCount;
pbFileDownload.Percent:= 0;
end;
dsFileData:
begin
pbFileDownload.IncParts(WorkCount);
pbTotalDownload.IncParts(WorkCount);
end;
dsFileEnd:
begin
//ShowMessage('Download ok.');
lblDownloadFileName.Caption:= '下载完毕!';
end;
dsEnd:
begin
//所有文件下载完毕
lblDownloadFileName.Caption:= '所有文件已经下载完毕.';
//Notebook1.PageIndex:= Notebook1.Pages.Count - 1;
PostMessage(Handle, CM_FINISHUPDATE, 0, 0);
end;
end;
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
var
Ini: TIniFile;
I, C: Integer;
VerInfo: PVerInfo;
SocksInfo: PSocksInfo;
AProxyIP, AUsername, APassword: string;
AProxyPort: Integer;
InitDll: TInitDll;
GetOldVersions: TGetVersions;
begin
if ParamCount < 1 then
chkRunExe.Visible:= False;
FLibHandle:= LoadLibrary('LiveUpdate.dll');
if FLibHandle = 0 then
raise Exception.Create('无法加载LiveUpdate.dll文件!');
@InitDll:= GetProcAddress(FLibHandle, 'Init');
if @InitDll = nil then
raise Exception.Create('无法找到Dll入口函数Init!');
with GetApp.Settings.ConnectInfo, GetApp.Settings.LiveUpdateInfo do
begin
case ConnectType of
ctDirect, ctNat:
begin
if not InitDll(PChar(Project), PChar(ServerIP), ServerPort) then
Close;
end;
ctProxy:
begin
AProxyIP:= ProxyIP;
AProxyPort:= ProxyPort;
AUsername:= ProxyUser;
APassword:= ProxyPass;
New(SocksInfo);
with SocksInfo^ do
begin
ProxyIP:= AllocMem(256);
ProxyUser:= AllocMem(256);
ProxyPass:= AllocMem(256);
end;
try
with SocksInfo^ do
begin
StrPCopy(ProxyIP, AProxyIP);
ProxyPort:= AProxyPort;
StrPCopy(ProxyUser, AUsername);
StrPCopy(ProxyPass, APassword);
end;
if not InitDll(PChar(Project), PChar(ServerIP), ServerPort, SocksInfo) then
Close;
finally
with SocksInfo^ do
begin
FreeMem(ProxyIP, 256);
FreeMem(ProxyUser, 256);
FreeMem(ProxyPass, 256);
end;
Dispose(SocksInfo);
end;
end;
end;
end;
//显示已安装的文件信息
New(VerInfo);
with VerInfo^ do
begin
FileName:= AllocMem(256);
Version:= AllocMem(256);
end;
@GetOldVersions:= GetProcAddress(FLibHandle, 'GetOldVersions');
if @GetOldVersions = nil then
raise Exception.Create('无法找到Dll入口函数GetOldVersions');
C:= GetOldVersions(nil, 0);
for I:= 0 to C - 1 do
begin
with lvOldVersions.Items.Add do
begin
Caption:= VerInfo^.FileName;
SubItems.Add(VerInfo^.Version);
end;
end;
with VerInfo^ do
begin
FreeMem(FileName, 256);
FreeMem(Version, 256);
end;
Dispose(VerInfo);
Notebook1.PageIndex:= 0;
end;
procedure TMainForm.actBackExecute(Sender: TObject);
begin
Notebook1.PageIndex:= Notebook1.PageIndex - 1;
end;
procedure TMainForm.actBackUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled:= (Notebook1.PageIndex > 0) and
(Notebook1.PageIndex <> Notebook1.Pages.Count - 1) and
((Sender as TAction).Tag = 0);
end;
procedure TMainForm.actNextExecute(Sender: TObject);
var
I, C: Integer;
VerInfo: PVerInfo;
slFiles: TStrings;
FileSize: Integer;
CheckNewVersion: TCheckVersion;
GetNewVersions: TGetVersions;
UpdateProduct: TUpdateProduct;
begin
Notebook1.PageIndex:= Notebook1.PageIndex + 1;
case Notebook1.PageIndex of
1: // download file list
begin
@CheckNewVersion:= GetProcAddress(FLibHandle, 'CheckNewVersion');
if @CheckNewVersion = nil then
raise Exception.Create('无法找到Dll入口函数CheckNewVersion!');
if CheckNewVersion then
begin
//找到新版本,显示文件版本信息
New(VerInfo);
with VerInfo^ do
begin
FileName:= AllocMem(256);
Version:= AllocMem(256);
end;
@GetNewVersions:= GetProcAddress(FLibHandle, 'GetNewVersions');
if @GetNewVersions = nil then
raise Exception.Create('无法找到Dll入口函数GetNewVersions!');
C:= GetNewVersions(nil, 0);
for I:= 0 to C - 1 do
begin
GetNewVersions(VerInfo, I);
with lvNewVersions.Items.Add do
begin
Caption:= VerInfo^.FileName;
SubItems.Add(VerInfo^.Version);
Checked:= True;
end;
end;
with VerInfo^ do
begin
FreeMem(FileName, 256);
FreeMem(Version, 256);
end;
Dispose(VerInfo);
end
else
begin
//Notebook1.PageIndex:= Notebook1.Pages.Count - 1;
PostMessage(Handle, CM_FINISHUPDATE, 0, 0);
end;
end;
2: // download files
begin
@UpdateProduct:= GetProcAddress(FLibHandle, 'UpdateProduct');
if @UpdateProduct = nil then
raise Exception.Create('无法找到Dll入口函数UpdateProduct!');
UpdateProduct(DoDownloadProgress);
end;
end;
end;
procedure TMainForm.actNextUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled:= Notebook1.PageIndex < Notebook1.Pages.Count - 1;
end;
procedure TMainForm.actCancelExecute(Sender: TObject);
begin
Close;
end;
procedure TMainForm.actCancelUpdate(Sender: TObject);
begin
if Notebook1.PageIndex = Notebook1.Pages.Count - 1 then
(Sender as TAction).Caption:= '关闭'
else
(Sender as TAction).Caption:= '取消';
end;
procedure TMainForm.actFinishExecute(Sender: TObject);
begin
Close;
end;
procedure TMainForm.actFinishUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled:= Notebook1.PageIndex = Notebook1.Pages.Count - 1;
end;
procedure TMainForm.actConfigExecute(Sender: TObject);
begin
// 配置网络
ShowConfigForm
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
if FLibHandle <> 0 then
FreeLibrary(FLibHandle);
GetApp.Free;
end;
procedure TMainForm.FinishUpdate(var Msg: TMessage);
begin
Notebook1.PageIndex:= Notebook1.Pages.Count - 1;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if (chkRunExe.Visible) and (chkRunExe.Checked) then
ShellExecute(0, 'open', PChar(ParamStr(1)), '', '', SW_NORMAL);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -