hxdllclient.pas

一个基于Socket的在线更新程序

unit hxDllClient;

interface

uses
  Windows, Forms, Dialogs, Classes, SysUtils, hxUpdate, hxClasses, hxFileRes;

type
  ThxDllClient = class(TObject)
  private
    FDownloadProgress: TDownloadProgress;
    FTotalSize: Integer;
    FWorking: Boolean;
    FNewVersions: TVersionList;
    FOldVersions: TVersionList;
    FClient: ThxUpdateClient;
    FHost: string;
    FPort: Integer;
    FProjectName: string;
    FProxyInfo: TProxyInfo;
    procedure DoDownloadFileList(Sender: TObject; DownloadStatus: TDownloadStatus;
      const WorkCount: Integer);
    procedure DoDownloadFiles(Sender: TObject; DownloadStatus: TDownloadStatus;
      const WorkCount: Integer);
    procedure RefreshNewFileList(ResTree: TResTree; var TotalSize: Integer);
    function GetOldVersion(FileName: string): TVersion;
    function GetNewVersion(FileName: string): TVersion;
    procedure SetActive(const Value: Boolean);
    function GetActive: Boolean;
  public
    constructor Create;
    destructor Destroy; override;
    function CheckNewVersion: Boolean;
    procedure UpdateProduct(DownloadProgress: TDownloadProgress);

    property Host: string read FHost write FHost;
    property Port: Integer read FPort write FPort;
    property ProxyInfo: TProxyInfo read FProxyInfo write FProxyInfo;
    property ProjectName: string read FProjectName write FProjectName;
    property OldVersions: TVersionList read FOldVersions;
    property NewVersions: TVersionList read FNewVersions; 
    property Active: Boolean read GetActive write SetActive;
  end;

implementation

{ ThxDllClient }

function ThxDllClient.CheckNewVersion: Boolean;
var
  T: Cardinal;
begin
  Active:= True;
  T:= GetTickCount;

  FClient.DownloadFileList(DoDownloadFileList);
  while GetTickCount - T < G_TimeOut do
  begin
    if not FWorking then
    begin
      Result:= FTotalSize <> 0;
      Active:= False;
      Exit;
    end;
    if Application.Terminated then
      Break;
    Application.ProcessMessages;
  end;
  raise Exception.Create('网络超时，无法连接到LiveUpdate服务器!');
end;

constructor ThxDllClient.Create;
var
  VerName: string;
begin
  FNewVersions:= TVersionList.Create('');
  VerName:= ExtractFilePath(Application.ExeName) + ProjectName + '.ver';
  //VerName:= StringReplace(Application.ExeName, '.exe', '.ver', [rfReplaceAll]);
  FOldVersions:= TVersionList.Create(VerName);
  FTotalSize:= 0;
  FWorking:= True;
  FClient:= nil;
  FDownloadProgress:= nil;
  FProjectName:= ProjectName;
end;

destructor ThxDllClient.Destroy;
begin
  FOldVersions.Free;
  if Assigned(FClient) then
    FClient.Free;
  inherited Destroy;
end;

procedure ThxDllClient.DoDownloadFileList(Sender: TObject;
  DownloadStatus: TDownloadStatus; const WorkCount: Integer);
begin
  case DownloadStatus of
    dsBegin:
    begin
    end;
    dsFileData:
    begin
    end;
    dsEnd:
    begin
      FTotalSize:= 0;
      RefreshNewFileList((Sender as TDownloadFileListThread).ResTree, FTotalSize);
      FWorking:= False;
    end;
  end;
end;

procedure ThxDllClient.DoDownloadFiles(Sender: TObject; DownloadStatus: TDownloadStatus;
  const WorkCount: Integer);
var
  FileName: string;
  NewVersion: TVersion;
begin
  FileName:= (Sender as TDownloadFilesThread).DownloadFileName;
  case DownloadStatus of
    dsBegin, dsFileBegin, dsFileData, dsEnd:
    begin
      if Assigned(FDownloadProgress) then
        FDownloadProgress(DownloadStatus, FileName, WorkCount);
    end;
    dsFileEnd:  //更新版本号
    begin
      NewVersion:= GetNewVersion(FileName);
      FOldVersions.Update(FileName, NewVersion);
      if Assigned(FDownloadProgress) then
        FDownloadProgress(dsFileEnd, FileName, WorkCount);
    end;
  end;
end;

function ThxDllClient.GetActive: Boolean;
begin
  Result:= FClient.Active;
end;

function ThxDllClient.GetNewVersion(FileName: string): TVersion;
var
  Index: Integer;
begin
  Index:= FNewVersions.IndexOf(FileName);
  if Index <> -1 then
    Result:= FNewVersions.Items[Index]^.Version;
end;

function ThxDllClient.GetOldVersion(FileName: string): TVersion;
var
  Index: Integer;
begin
  Index:= FOldVersions.IndexOf(FileName);
  if Index <> -1 then
    Result:= FOldVersions[Index].Version
  else
    Result:= 'Unknown';
end;

procedure ThxDllClient.RefreshNewFileList(ResTree: TResTree;
  var TotalSize: Integer);

  procedure TravelTree(Node: TNode);
  var
    I: Integer;
    pInfo: PResInfo;
  begin
    if Node = nil then Exit;
    pInfo:= PResInfo(Node.Data);
    if pInfo^.ResType = rtFile then
    begin
      if not SameVersion(pInfo^.Version, GetOldVersion(pInfo^.DownloadURL)) then
      begin
        FNewVersions.Update(pInfo^.DownloadURL, pInfo^.Version);
        Inc(TotalSize, pInfo^.FileSize);
      end;
    end;

    for I:= 0 to Node.Count - 1 do
      TravelTree(Node.Children[I]);
  end;

var
  I: Integer;
  Node: TNode;
begin
  FNewVersions.Clear;
  Node:= ResTree.RootNode;
  for I:= 0 to Node.Count - 1 do
    TravelTree(Node.Children[I]);
end;
procedure ThxDllClient.SetActive(const Value: Boolean);
var
  T: Cardinal;
begin
  if FProjectName = '' then
    raise Exception.Create('Dll未初始化，必须先调用Init函数进行初始化!');

  if not Assigned(FClient) then
    FClient:= ThxUpdateClient.Create(FProjectName);

  if FClient.Active <> Value then
  begin
    if not FClient.Active then
    begin
      T:= GetTickCount;
      FClient.ProxyInfo:= FProxyInfo;
      FClient.Open(Host, Port);
      //异步转为同步
      while GetTickCount - T < 60000 do
      begin
        if FClient.Active = True then Exit;
        Application.ProcessMessages;
      end;
      raise Exception.CreateFmt('连接超时，错误码是%d', [GetLastError]);
    end
    else
      FClient.Close;
  end;
end;

procedure ThxDllClient.UpdateProduct(DownloadProgress: TDownloadProgress);
var
  I: Integer;
  slFiles: TStrings;
begin
  Active:= True;
  Assert(FClient.Active = True);
  FDownloadProgress:= DownloadProgress;
  if Assigned(FDownloadProgress) then
    FDownloadProgress(dsBegin, '', FTotalSize);

  slFiles:= TStringList.Create;
  try
    for I:= 0 to FNewVersions.Count - 1 do
      slFiles.Add(FNewVersions[I].FileName);
    FClient.DownloadFiles(slFiles, DoDownloadFiles);
  finally
    slFiles.Free;
  end;
end;

end.