hxupdate.pas

delphi 开发的自动升级源码

{ TDownloadFiles }

constructor TDownloadFilesThread.Create(UpdateClient: ThxUpdateClient;  CreateSuspended: Boolean; ClientSocket: TClientSocket;
  ProjectName: string; FileNames: TStrings; DownloadCallback: TDownloadCallback);
begin
  inherited Create(CreateSuspended);
  FUpdateClient:= UpdateClient;
  FreeOnTerminate:= True;
  FClientSocket:= ClientSocket;
  FProjectName:= ProjectName;
  FDownloadCallback:= DownloadCallback;
  FFileNames:= TStringList.Create;
  FFileNames.Assign(FileNames);
  FDownloadFileName:= '';
  Assert(FClientSocket.Socket.Connected = True);
end;

destructor TDownloadFilesThread.Destroy;
begin
  FFileNames.Free;
  inherited Destroy;
end;

procedure TDownloadFilesThread.DownloadAFile(AFileName: string);
var
  CMD: Cardinal;
  wss: TWinSocketStream;
  fs: TFileStream;
  FileName: string;
  FileSize: Integer;
  Buf: array[0..PACKET_SIZE - 1] of char;
  WriteCount: Integer;
  szDir: string;
begin
  Assert(FClientSocket.Socket.Connected = True);
  wss:= TWinSocketStream.Create(FClientSocket.Socket, G_TIMEOUT);
  try
    // 请求下载文件列表
    StreamWriteInteger(wss, FILE_DOWNLOAD);
    StreamWriteString(wss, FProjectName);
    StreamWriteString(wss, AFileName);
    // 等待下载文件列表
    if wss.WaitForData(G_TIMEOUT) then
    begin
      CMD:= StreamReadInteger(wss);
      Assert(CMD = FILE_DOWNLOAD);
      FileName:= StreamReadString(wss);
      FileSize:= StreamReadInteger(wss);

      FDownloadFileName:= FileName;

      //开始下载
      SyncDownloadCallback(dsFileBegin, FileSize);

      //下载指定文件
      FileName:= ExtractFilePath(Application.ExeName) + FDownloadFileName;
      szDir:= ExtractFilePath(FileName);
      if not ForceDirectories(szDir) then
        raise Exception.Create('创建目录失败！');
      fs:= TFileStream.Create(FileName, fmCreate);
      try
        while fs.Size < FileSize do
        begin
          FillChar(Buf, PACKET_SIZE, #0);
          WriteCount:= wss.Read(Buf, PACKET_SIZE);
          fs.WriteBuffer(Buf, WriteCount);

          //下载中....
          SyncDownloadCallback(dsFileData, WriteCount);
        end;

        //下载完毕
        SyncDownloadCallback(dsFileEnd, fs.Size);
      finally
        fs.Free;
      end;
    end
    else
      FClientSocket.Close;
  finally
    wss.Free;
  end;
end;

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

procedure TDownloadFilesThread.Execute;
var
  I: Integer;
begin
  Assert(FClientSocket.Socket.Connected = True);
  // 下载指定文件
  for I:= 0 to FFileNames.Count - 1 do
  begin
    if (not Terminated) and (FClientSocket.Socket.Connected) then
      DownloadAFile(FFileNames[I])
    else
      Break;
  end;
  FDownloadFileName:= '';

  SyncDownloadCallback(dsEnd, 0);

  Terminate;
end;

procedure TDownloadFileListThread.SyncDownloadCallback(
  DownloadStatus: TDownloadStatus; WorkCount: Integer);
begin
  FDownloadStatus:= DownloadStatus;
  FWorkCount:= WorkCount;
  if Application.Handle = 0 then
    DoDownloadCallback
  else
    Synchronize(Self, DoDownloadCallback);
end;

{ ThxUpdateClient }

procedure ThxUpdateClient.Close;
begin
  FClientSocket.Close;
end;

function ThxUpdateClient.ConnectByProxy(Socket: TSocket; RemoteIP: string;
  RemotePort: Integer): Boolean;
var
  Buf: array[0..1023] of Byte;
  Ret: Integer;
  saRemote: TSockAddr;
begin
  Result:= False;

  FillChar(saRemote, SizeOf(saRemote), #0);
  saRemote.sin_family:= AF_INET;
  saRemote.sin_addr.S_addr:= inet_addr(PChar(RemoteIP));
  saRemote.sin_port:= htons(RemotePort);

  Buf[0]:= SOCKS_VER5;    // 代理协议版本号(Socks5)
  Buf[1]:= CMD_CONNECT;   // Reply
  Buf[2]:= RSV_DEFAULT;   // 保留字段
  Buf[3]:= ATYP_IPV4;     // 地址类型(IPV4)
  CopyMemory(@Buf[4], @saRemote.sin_addr, 4); // 目标地址
  CopyMemory(@Buf[8], @saRemote.sin_port, 2); // 目标端口号
  Ret:= send(Socket, Buf, 10, 0);
  if Ret = -1 then Exit;
  Ret:= recv(Socket, Buf, 1023, 0);
  if Ret = -1 then Exit;
  if Buf[1] <> REP_SUCCESS then Exit;
  Result:= True;
end;

constructor ThxUpdateClient.Create(ProjectName: string);
var
  wsData: TWSAData;
begin
  FProjectName:= ProjectName;
  FResTree:= TResTree.Create;
  Assert(WSAStartup(MAKEWORD(1, 1), wsData) = 0);
  FClientSocket:= TClientSocket.Create(nil);
  FClientSocket.ClientType:= ctBlocking;
end;

destructor ThxUpdateClient.Destroy;
begin
  if FClientSocket.Socket.Connected then
    FClientSocket.Close;
  FreeAndNil(FClientSocket);
  FreeAndNil(FResTree);
  WSACleanup;
  inherited Destroy;
end;

procedure ThxUpdateClient.DownloadFileList(DownloadCallback: TDownloadCallback);
begin
  FResTree.Clear;
  TDownloadFileListThread.Create(False, FClientSocket, FProjectName, FResTree, DownloadCallback);
end;

procedure ThxUpdateClient.DownloadFiles(FileNames: TStrings; DownloadCallback: TDownloadCallback);
begin
  TDownloadFilesThread.Create(Self, False, FClientSocket, FProjectName, FileNames, DownloadCallback);
end;

function ThxUpdateClient.GetActive: Boolean;
begin
  Result:= FClientSocket.Socket.Connected;
end;

function ThxUpdateClient.Handclasp(Socket: TSocket; AuthenType: TAuthenType): Boolean;
var
  Buf: array[0..254] of Byte;
  I, Ret: Integer;
  Username, Password: string;
begin
  Result:= False;
  case AuthenType of
    // 无需验证
    atNone:
    begin
      Buf[0]:= SOCKS_VER5;
      Buf[1]:= $01;
      Buf[2]:= $00;
      Ret:= send(Socket, Buf, 3, 0);
      if Ret = -1 then Exit;
      Ret:= recv(Socket, Buf, 255, 0);
      if Ret < 2 then Exit;
      if Buf[1] <> $00 then Exit;
      Result:= True;
    end;
    // 用户名密码验证
    atUserPass:
    begin
      Buf[0]:= SOCKS_VER5;
      Buf[1]:= $02;
      Buf[2]:= $00;
      Buf[3]:= $02;
      Ret:= send(Socket, Buf, 4, 0);
      if Ret = -1 then Exit;
      FillChar(Buf, 255, #0);
      Ret:= recv(Socket, Buf, 255, 0);
      if Ret < 2 then Exit;
      if Buf[1] <> $02 then Exit;
      Username:= FProxyInfo.Username;
      Password:= FProxyInfo.Password;
      FillChar(Buf, 255, #0);
      Buf[0]:= $01;
      Buf[1]:= Length(Username);
      for I:= 0 to Buf[1] - 1 do
        Buf[2 + I]:= Ord(Username[I + 1]);
      Buf[2 + Length(Username)]:= Length(Password);
      for I:= 0 to Buf[2 + Length(Username)] - 1 do
        Buf[3 + Length(Username) + I]:= Ord(Password[I + 1]);
      Ret:= send(Socket, Buf, Length(Username) + Length(Password) + 3, 0);
      if Ret = -1 then Exit;
      Ret:= recv(Socket, Buf, 255, 0);
      if Ret = -1 then Exit;
      if Buf[1] <> $00 then Exit;
      Result:= True;
    end;
  end;
end;

procedure ThxUpdateClient.Open(ServerIP: string; Port: Integer);
begin
  Assert(FClientSocket.Socket.Connected = False);
  try
    if not FProxyInfo.Enabled then
    begin
      FClientSocket.Host:= ServerIP;
      FClientSocket.Port:= Port;
      FClientSocket.Open;
    end
    else begin  { 使用代理服务器 }
      // 连接到Socks服务器
      FClientSocket.Host:= FProxyInfo.IP;
      FClientSocket.Port:= FProxyInfo.Port;
      FClientSocket.Open;
      if Trim(FProxyInfo.Username) <> '' then
        Handclasp(FClientSocket.Socket.SocketHandle, atUserPass)
      else
        Handclasp(FClientSocket.Socket.SocketHandle, atNone);
      // 连接到目标地址
      ConnectByProxy(FClientSocket.Socket.SocketHandle, ServerIP, Port);
    end;
  except
    raise Exception.Create('无法连接到LiveUpdate服务器，请检查网络配置！');
  end;
end;

{ TProjectMgr }

function TProjectCollection.Add(ProjectName, Descripton, RootDir: string): TProjectItem;
begin
  Result:= TProjectItem(inherited Add);
  Result.ProjectName:= ProjectName;
  Result.Description:= Descripton;
  Result.RootDir:= RootDir;
end;

procedure TProjectCollection.Clear;
begin
  inherited Clear;
end;

constructor TProjectCollection.Create(AOwner: TPersistent; FileName: string);
begin
  inherited Create(TProjectItem);
  FOwner:= AOwner;

  FFileName:= FileName;
  LoadFromFile;
end;

procedure TProjectCollection.Delete(Index: Integer);
begin
  inherited Delete(Index);
end;

destructor TProjectCollection.Destroy;
begin
  SaveToFile;
  Clear;
  inherited Destroy;
end;

function TProjectCollection.GetItem(Index: Integer): TProjectItem;
begin
  Result:= TProjectItem(inherited GetItem(Index));
end;


function TProjectCollection.IndexOf(const ProjectName: string): Integer;
var
  I: Integer;
begin
  Result:= -1;
  for I:= 0 to Count - 1 do
    if SameText(TProjectItem(Items[I]).ProjectName, ProjectName) then
    begin
      Result:= I;
      Break;
    end;
end;

procedure TProjectCollection.LoadFromFile;
var
  I, C: Integer;
  Stream: TStream;
  szProjectName, szRootDir, szDescription: string;
begin
  Clear;
  if not FileExists(FFileName) then Exit;
  Stream:= TFileStream.Create(FFileName, fmOpenRead);
  try
    C:= StreamReadInteger(Stream);
    for I:= 0 to C - 1 do
    begin
      szProjectName:= StreamReadString(Stream);
      szRootDir:= StreamReadString(Stream);
      szDescription:= StreamReadString(Stream);;
      Add(szProjectName, szDescription, szRootDir);
    end;
  finally
    Stream.Free;
  end;
end;


procedure TProjectCollection.SaveToFile;
var
  I: Integer;
  Stream: TFileStream;
begin
  Stream:= TFileStream.Create(FFileName, fmCreate);
  try
    StreamWriteInteger(Stream, Count);
    for I:= 0 to Count - 1 do
      with Items[I] do
      begin
        StreamWriteString(Stream, ProjectName);
        StreamWriteString(Stream, RootDir);
        StreamWriteString(Stream, Description);
      end;
  finally
    Stream.Free;
  end;
end;

{ TProjectItem }

constructor TProjectItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FResTree:= TResTree.Create;
end;

destructor TProjectItem.Destroy;
begin
  FResTree.Free;
  inherited Destroy;
end;

function TProjectItem.GetResTreeFileName: string;
begin
  Result:= ExtractFilePath(ParamStr(0)) + 'Projects\' + FProjectName + '.vf';
end;

procedure TProjectItem.LoadResTree;
begin
  if FileExists(GetResTreeFileName) then
    FResTree.LoadFromFile(GetResTreeFileName);
end;

procedure TProjectItem.RemoveResTree;
var
  ResFileName: string;
begin
  ResFileName:= GetResTreeFileName;
  if FileExists(ResFileName) then
    DeleteFile(ResFileName);
end;

procedure TProjectItem.SaveResTree;
var
  ResFilePath, ResFileName: string;
begin
  ResFileName:=  GetResTreeFileName;
  ResFilePath:= ExtractFilePath(ResFileName);
  if not DirectoryExists(ResFilePath) then
    ForceDirectories(ResFilePath);
  FResTree.SaveToFile(ResFileName);
end;

procedure TDownloadFilesThread.SyncDownloadCallback(
  DownloadStatus: TDownloadStatus; WorkCount: Integer);
begin
  FDownloadStatus:= DownloadStatus;
  FWorkCount:= WorkCount;
  {
  if Application.Handle = 0 then
    DoDownloadCallback
  else
    Synchronize(Self, DoDownloadCallback);
  }
  DoDownloadCallback;
end;

end.