hxupdate.pas

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

unit hxUpdate;

interface

uses
  Windows, Classes, Forms, ScktComp, SysUtils, WinSock, hxFileRes, Contnrs,
  SyncObjs;

const
  { 数据包长度 }
  PACKET_SIZE   = 1024;

  { 定义消息 }
  FILE_LIST     = $00000001;
  FILE_INFO     = $00000002;
  FILE_DOWNLOAD = $00000003;

  { 网络超时 }
  G_TIMEOUT     = 60000;

  { 代理信息 }
  SOCKS_VER5 = $05;
  CMD_CONNECT = $01;
  RSV_DEFAULT = $00;
  ATYP_DN = $03;
  REP_SUCCESS = $00;
  ATYP_IPV4 = $01;

type
  TAuthenType = (atNone, atUserPass);
  TDownloadStatus = (dsBegin, dsFileBegin, dsFileData, dsFileEnd, dsEnd, dsError);
  TDownloadCallback = procedure(Sender: TObject; DownloadStatus: TDownloadStatus;
    const WorkCount: Integer) of object;

  //下载进度
  TDownloadProgress = procedure(DownloadStatus: TDownloadStatus; FileName: string;
    WorkCount: Integer);

  { 代理服务器属性 }
  TProxyInfo = record
    Enabled: Boolean;
    IP: string;
    Port: Integer;
    Username: string;
    Password: string;
  end;

  PSocksInfo = ^TSocksInfo;
  TSocksInfo = record
    ProxyIP: PChar;     //代理服务器IP
    ProxyPort: Integer; //代理服务器端口
    ProxyUser: PChar;   //代理服务器用户名
    ProxyPass: PChar;   //代理服务器密码
  end;

  { 项目 }
  TProjectItem = class(TCollectionItem)
  private
    FDescription: string;
    FProjectName: string;
    FResTree: TResTree;
    FRootDir: string;
    function GetResTreeFileName: string;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure RemoveResTree;
    procedure SaveResTree;
    procedure LoadResTree;
    property ProjectName: string read FProjectName write FProjectName;
    property Description: string read FDescription write FDescription;
    property RootDir: string read FRootDir write FRootDir;
    property ResTree: TResTree read FResTree;
  end;

  { 项目管理器 }
  TProjectCollection = class(TCollection)
  private
    FFileName: string;
    FOwner: TPersistent;
    procedure SaveToFile;
    procedure LoadFromFile;
    function GetItem(Index: Integer): TProjectItem;
  public
    constructor Create(AOwner: TPersistent; FileName: string);
    destructor Destroy; override;
    function Add(ProjectName, Descripton, RootDir: string): TProjectItem;
    procedure Delete(Index: Integer);
    procedure Clear;
    function IndexOf(const ProjectName: string): Integer;
    property Items[Index: Integer]: TProjectItem read GetItem; default;
  end;

  TMyServerClientThread = class(TServerClientThread)
  private
    procedure SendFileList(ProjectName: string);
    procedure SendFile(ProjectName, FileName: string);
  protected
    procedure ClientExecute; override;
  public
    constructor Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket);
    destructor Destroy; override;
  end;

  ThxUpdateServer = class(TObject)
  private
    FServerSocket: TServerSocket;
    procedure FServerSocketGetThread(Sender: TObject; ClientSocket: TServerClientWinSocket;
      var SocketThread: TServerClientThread);
    procedure FServerSocketThreadStart(Sender: TObject; Thread: TServerClientThread);
    procedure FServerSocketThreadEnd(Sender: TObject; Thread: TServerClientThread);
    procedure FServerSocketListen(Sender: TObject; Socket: TCustomWinSocket);
    function GetActive: Boolean;
  public
    constructor Create(APort: Integer);
    destructor Destroy; override;

    procedure StartService;
    procedure StopServerice;
    property Active: Boolean read GetActive;
  end;

  { 下载文件列表，共用一个连接，下载完毕后连接不断开}
  TDownloadFileListThread = class(TThread)
  private
    FClientSocket: TClientSocket;
    FResTree: TResTree;
    FProjectName: string;
    FDownloadCallback: TDownloadCallback;
    FDownloadStatus: TDownloadStatus;
    FWorkCount: Integer;
    procedure DoDownloadCallback;
    procedure SyncDownloadCallback(DownloadStatus: TDownloadStatus; WorkCount: Integer);
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean; ClientSocket: TClientSocket;
      ProjectName: string; ResTree: TResTree; DownloadCallback: TDownloadCallback);
    property ResTree: TResTree read FResTree;
  end;

  ThxUpdateClient = class;

  { 下载多个文件，共用一个连接，下载完毕后连接不断开 }
  TDownloadFilesThread = class(TThread)
  private
    FClientSocket: TClientSocket;
    FFileNames: TStrings;
    FDownloadCallback: TDownloadCallback;
    FUpdateClient: ThxUpdateClient;
    FProjectName: string;
    FDownloadFileName: string;
    FDownloadStatus: TDownloadStatus;
    FWorkCount: Integer;
    procedure DoDownloadCallback;
    procedure SyncDownloadCallback(DownloadStatus: TDownloadStatus; WorkCount: Integer);
    procedure DownloadAFile(AFileName: string);
  protected
    procedure Execute; override;
  public
    constructor Create(UpdateClient: ThxUpdateClient; CreateSuspended: Boolean; ClientSocket: TClientSocket;
      ProjectName: string; FileNames: TStrings; DownloadCallback: TDownloadCallback);
    destructor Destroy; override;
    property DownloadFileName: string read FDownloadFileName;
  end;

  ThxUpdateClient = class(TObject)
  private
    FClientSocket: TClientSocket;
    FResTree: TResTree;
    FProjectName: string;
    FProxyInfo: TProxyInfo;
    function GetActive: Boolean;
    function Handclasp(Socket: TSocket; AuthenType: TAuthenType): Boolean;
    function ConnectByProxy(Socket: TSocket; RemoteIP: string; RemotePort: Integer): Boolean;
  public
    constructor Create(ProjectName: string);
    destructor Destroy; override;

    procedure Open(ServerIP: string; Port: Integer);
    procedure Close;
    procedure DownloadFileList(DownloadCallback: TDownloadCallback);
    procedure DownloadFiles(FileNames: TStrings; DownloadCallback: TDownloadCallback);

    property Active: Boolean read GetActive;
    property ProxyInfo: TProxyInfo read FProxyInfo write FProxyInfo;
  end;

  function GetProjectCollection: TProjectCollection;

implementation

uses
  hxSysUtils, TypInfo;

var
  G_ProjectCollection: TProjectCollection = nil;

function GetProjectCollection: TProjectCollection;
begin
  if G_ProjectCollection = nil then
    G_ProjectCollection:= TProjectCollection.Create(nil, ExtractFilePath(ParamStr(0)) + 'myprjs.dat');

  Result:= G_ProjectCollection;
end;

{ TMyServerClientThread }

procedure TMyServerClientThread.ClientExecute;
var
  Stream: TWinSocketStream;
  CMD: Cardinal;
  ProjectName, FileName: string;
begin
  while (not Terminated) and ClientSocket.Connected do
  begin
    try
      Stream := TWinSocketStream.Create(ClientSocket, G_TIMEOUT);
      try
        if Stream.WaitForData(G_TIMEOUT) then
        begin
          if ClientSocket.ReceiveLength = 0 then
          begin
            ClientSocket.Close;
            Break;
          end;
          try
            CMD:= StreamReadInteger(Stream);
            ProjectName:= StreamReadString(Stream);

            if GetProjectCollection.IndexOf(ProjectName) = -1 then
              ClientSocket.Close;

            case CMD of
              // 下载文件列表
              FILE_LIST:
              begin
                SendFileList(ProjectName);
              end;
              // 下载文件
              FILE_DOWNLOAD:
              begin
                FileName:= StreamReadString(Stream);
                SendFile(ProjectName, FileName);
              end;
            end;
          except
            ClientSocket.Close;
          end;
        end
        else
          ClientSocket.Close;
      finally
        Stream.Free;
      end;
    except
      HandleException;
    end;
  end;
  Terminate;
end;

constructor TMyServerClientThread.Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket);
begin
  inherited Create(CreateSuspended, ASocket);
  FreeOnTerminate:= True;
end;

destructor TMyServerClientThread.Destroy;
begin
  inherited Destroy;
end;

procedure TMyServerClientThread.SendFile(ProjectName, FileName: string);
var
  fs: TFileStream;
  wss: TWinSocketStream;
  Buf: array[0..PACKET_SIZE - 1] of char;
  ReadCount: Integer;
  Index: Integer;
  RootDir: string;
begin
  wss:= TWinSocketStream.Create(ClientSocket, G_TIMEOUT);
  try
    Index:= GetProjectCollection.IndexOf(ProjectName);
    RootDir:= FormatDirectoryName(GetProjectCollection.Items[Index].RootDir);
    fs:= TFileStream.Create(RootDir + FileName, fmOpenRead);
    try
      StreamWriteInteger(wss, FILE_DOWNLOAD);
      StreamWriteString(wss, FileName);
      StreamWriteInteger(wss, fs.Size);
      while fs.Position < fs.Size do
      begin
        ReadCount:= fs.Read(Buf, PACKET_SIZE);
        wss.WriteBuffer(Buf, ReadCount);
      end;
    finally
      fs.Free;
    end;
  finally
    wss.Free;
  end;
end;

procedure TMyServerClientThread.SendFileList(ProjectName: string);
var
  Index: Integer;
  wss: TWinSocketStream;
begin
  Index:= GetProjectCollection.IndexOf(ProjectName);
  wss:= TWinSocketStream.Create(ClientSocket, G_TIMEOUT);
  try
    StreamWriteInteger(wss, FILE_LIST);
    // 需要时才加载，可以节约资源
    with GetProjectCollection.Items[Index] do
    begin
      LoadResTree;
      ResTree.SaveToStream(wss);
      //ResTree.Clear;
    end;
  finally
    wss.Free;
  end;
end;

{ ThxUpdateServer }

constructor ThxUpdateServer.Create(APort: Integer);
begin
  FServerSocket:= TServerSocket.Create(nil);
  FServerSocket.ServerType:= stThreadBlocking;
  FServerSocket.ThreadCacheSize:= 0;
  FServerSocket.Port:= APort;
  FServerSocket.OnGetThread:= FServerSocketGetThread;
  FServerSocket.OnThreadStart:= FServerSocketThreadStart;
  FServerSocket.OnThreadEnd:= FServerSocketThreadEnd;
  FServerSocket.OnListen:= FServerSocketListen;
end;

destructor ThxUpdateServer.Destroy;
begin
  FServerSocket.Free;
  inherited Destroy;
end;

procedure ThxUpdateServer.FServerSocketGetThread(Sender: TObject;
  ClientSocket: TServerClientWinSocket; var SocketThread: TServerClientThread);
begin
  Assert(ClientSocket.Connected);
  SocketThread:= TMyServerClientThread.Create(False, ClientSocket);
end;

procedure ThxUpdateServer.FServerSocketListen(Sender: TObject; Socket: TCustomWinSocket);
begin

end;

procedure ThxUpdateServer.FServerSocketThreadEnd(Sender: TObject; Thread: TServerClientThread);
begin

end;

procedure ThxUpdateServer.FServerSocketThreadStart(Sender: TObject; Thread: TServerClientThread);
begin

end;

function ThxUpdateServer.GetActive: Boolean;
begin
  Result:= FServerSocket.Active;
end;

procedure ThxUpdateServer.StartService;
begin
  FServerSocket.Open;
end;

procedure ThxUpdateServer.StopServerice;
begin
  FServerSocket.Close;
end;

{ TDownloadFileListThread }

constructor TDownloadFileListThread.Create(CreateSuspended: Boolean; ClientSocket: TClientSocket;
  ProjectName: string; ResTree: TResTree; DownloadCallback: TDownloadCallback);
begin
  inherited Create(CreateSuspended);
  FreeOnTerminate:= True;
  FClientSocket:= ClientSocket;
  FProjectName:= ProjectName;
  FResTree:= ResTree;
  FDownloadCallback:= DownloadCallback;
end;

procedure TDownloadFileListThread.DoDownloadCallback;
begin
  if Assigned(FDownloadCallback) then
    FDownloadCallback(Self, FDownloadStatus, FWorkCount);
end;

procedure TDownloadFileListThread.Execute;
var
  wss: TWinSocketStream;
  CMD: Cardinal;
begin
  // 下载文件列表
  if (not Terminated) and (FClientSocket.Socket.Connected) then
  begin
    wss:= TWinSocketStream.Create(FClientSocket.Socket, G_TIMEOUT);
    try
      // 请求下载文件列表
      StreamWriteInteger(wss, FILE_LIST);
      StreamWriteString(wss, FProjectName);

      SyncDownloadCallback(dsBegin, 0);

      // 等待下载文件列表
      if wss.WaitForData(G_TIMEOUT) then
      begin
        CMD:= StreamReadInteger(wss);
        Assert(CMD = FILE_LIST);
        FResTree.LoadFromStream(wss);

        SyncDownloadCallback(dsEnd, wss.Size);

        Terminate;
      end
      else
        FClientSocket.Close;
    finally
      wss.Free;
    end;
  end;
end;