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

📄 frmmain.pas

📁 一个基于Socket的在线更新程序
💻 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 + -