unitmain.pas

文件传输,支持断点续传.支持各种协议,运用 WINSOCK 单元进行传送文件的程序

end;
//***********************************************

procedure TFormUpdate.BtnPriorClick(Sender: TObject);
begin
  if step > 0 then
    step := step - 1;
end;

procedure TFormUpdate.BtnNextClick(Sender: TObject);
begin
  if EditURL.Text = '' then Exit;
  stoped := false;
  case step of
    0:
      begin
        NotebookStep.PageIndex := NotebookStep.PageIndex + 1;
        step := 1;
        BtnNextClick(Sender);
      end;
    1:
      if CheckConnection then
      begin
        step := 2;
        BtnNextClick(Sender);
      end
      else
      begin
        BtnNext.Enabled := false;
        Exit;
      end;
    2:
      if DownloadInfo then
      begin
        step := 3;
        BtnNextClick(Sender);
      end
      else
      begin
        BtnNext.Enabled := false;
        Exit;
      end;
    3:
      if AnalysisInfo then
      begin
        if files.Count = 0 then
        begin
          step := 4;
          BtnNext.Enabled := false;
          Exit;
        end
        else
        begin
          step := 4;
          BtnNextClick(Sender);
        end;
      end
      else
      begin
        BtnNext.Enabled := false;
        Exit;
      end;
    4:
      if DownloadFiles then
      begin
        step := 5;
        BtnNextClick(Sender);
      end
      else
      begin
        BtnNext.Enabled := false;
        Exit;
      end;
    5:
      if UpdateFiles then
      begin
        BtnCancel.Caption := '更新完成';
        BtnPrior.Enabled := false;
        step := 6;
        BtnNextClick(Sender);
      end
      else
      begin
        BtnNext.Enabled := false;
        Exit;
      end;
    6:
      if runExe = '' then
        BtnNext.Enabled := false
      else
      begin
        ListViewFiles.Items.Add;
        ListViewFiles.Items.Item[ListViewFiles.Items.Count].StateIndex := 0;
        ListViewFiles.Items.Item[ListViewFiles.Items.Count].Caption := '单击下一步运行文件...';
        ListviewFiles.Scroll(0, Abs(ListviewFiles.Font.Height));
        ShellExecute(handle, 'open', PChar(runExe), nil, nil, sw_show);
        Close;
      end;
  end;
end;

procedure TFormUpdate.BtnCancelClick(Sender: TObject);
begin
  stoped := true;
  if (step >= 6) or (step = 0) then
    Close;
end;

function TFormUpdate.CheckConnection: Boolean;
var
  item: TListItem;
begin
  result := false;
  try
    item := ListViewFiles.Items.Add;
    item.StateIndex := 0;
    item.Caption := '检测本地网络...';
    Memo1.Lines.Add('正在检测本地网络...');
    if InternetGetConnectedState(nil, 0) then
    begin
      item.StateIndex := 1;
      Memo1.Lines.Add('连接本地网络成功');
      result := true;
    end
    else
    begin
      item.StateIndex := 2;
      Memo1.Lines.Add('不能连接，请检查本地网络设置');
      Exit;
    end;
    Application.ProcessMessages;

    item := ListViewFiles.Items.Add;
    item.StateIndex := 0;
    item.Caption := '检测服务器...';
    Memo1.Lines.Add('正在检测服务器...');
    if InternetCheckConnection(PChar(EditURL.Text), 1, 0) then
    begin
      item.StateIndex := 1;
      Memo1.Lines.Add('连接服务器成功');
      result := true;
    end
    else
    begin
      item.StateIndex := 2;
      Memo1.Lines.Add('不能连接，请检查服务器状态');
		  Exit;
    end;
    Application.ProcessMessages;
  except
    raise;
    Exit;
  end;
end;

function TFormUpdate.DownloadInfo: Boolean;
var
  item: TListItem;
  remote, local: String;
begin
  try
    result := false;
    item := ListViewFiles.Items.Add;
    item.StateIndex := 0;
    item.Caption := '下载升级信息...';
    Memo1.Lines.Add('正在下载升级信息...');
    remote := EditURL.Text + subSysFile;
    local := updatePath + UPDATEINFO;
    DeleteFile(PChar(updatePath + local));
    if Download(remote, local) then
    begin
      item.StateIndex := 1;
      Memo1.Lines.Add('下载升级信息完成');
      result := true;
    end
    else
    begin
      item.StateIndex := 2;
      Memo1.Lines.Add('不能下载升级信息');
      Exit;
    end;
    Application.ProcessMessages;
  except
    raise;
    Exit;
  end
end;

function TFormUpdate.AnalysisInfo: Boolean;
var
  item: TListItem;
  i, n: Integer;
  fileHandle: LongInt;
  fileDate: TdateTime;
  infofiles: TStringList;
begin
  result := false;
  infofiles := TStringList.Create;
	files := TStringList.Create;

  n := ListViewFiles.Items.Count + 1;
  item := ListViewFiles.Items.Add;
  item.StateIndex := 0;
  item.Caption := '分析升级信息...';
  Memo1.Lines.Add('正在分析升级信息...');
  try
    iniFile := TIniFile.Create(updatePath + UPDATEINFO);
    iniFile.ReadSections(infofiles);
    try
      //比较UPDATEINFO和程序目录的文件时间
      for i := 0 to infofiles.Count - 1 do
      begin
        if FormUpdate.stoped = true then raise EMathError.Create('用户中断');
        fileHandle := FileOpen(ExtractFilePath(Application.ExeName) + infofiles[i], fmOpenRead);
        if fileHandle <> -1 then
          fileDate := FileDateToDateTime(FileGetDate(fileHandle))
        else
          fileDate := 0;
        FileClose(fileHandle);

        ListViewFiles.Items.Add;
        ListViewFiles.Items[n + i].Caption := infofiles[i];
        ListViewFiles.Items[n + i].StateIndex := -1;
        ListviewFiles.Items[n + i].SubItems.Add(iniFile.ReadString(infofiles[i], 'DateTime', ''));
        if fileDate < StrToDateTime(iniFile.ReadString(infofiles[i], 'DateTime', '')) then
        begin
          ListviewFiles.Items[n + i].SubItems.Add('需要下载');
          files.Add(infofiles[i]);
        end
        else
        begin
          ListviewFiles.Items[n + i].SubItems.Add('不需下载');
        end;
        Application.ProcessMessages;
      end;
      ListviewFiles.Scroll(0, Abs(ListviewFiles.Font.Height) * (ListviewFiles.Items.Count - infofiles.Count));
      item.StateIndex := 1;
      if files.Count > 0 then
        Memo1.Lines.Add('分析升级信息完成，有可用更新')
      else
        Memo1.Lines.Add('分析升级信息完成，无可用更新');
      result := true;
    except
      raise;
      item.StateIndex := 2;
      Memo1.Lines.Add('不能分析升级信息');
      Exit;
    end;
  finally
    iniFile.Free;
  end;
end;

function TFormUpdate.DownloadFiles: Boolean;
var
  i, n: Integer;
  fileHandle: LongInt;
  filedate: TdateTime;
  remote, local: String;
begin
  result := false;
  try
    try
      n := ListviewFiles.Items.Count - files.Count;
      iniFile := TIniFile.Create(updatePath + UPDATEINFO);

      //比较UPDATEINFO和updatePath的文件时间
      for i := 0 to files.Count - 1 do
      begin
        fileHandle := FileOpen(updatePath + files[i], fmOpenRead);
        if fileHandle <> -1 then
          fileDate := FileDateToDateTime(FileGetDate(fileHandle));
        FileClose(fileHandle);

        ListViewFiles.Items[n + i].StateIndex := 0;
        remote := EditURL.Text + files[i];
        local := updatePath + files[i];
        Memo1.Lines.Add('连接远程文件：' + remote);

        if GetFileDate(updatePath + files[i], fileDate) then
        begin
          if fileDate < StrToDateTime(iniFile.ReadString(files[i], 'DateTime', '')) then
          begin
            ListViewFiles.Items[n + i].SubItems.Strings[1] := '更新中';
            if Download(remote, local) then
            begin
              ListViewFiles.Items[n + i].StateIndex := 1;
              ListViewFiles.Items[n + i].SubItems.Strings[1] := '更新成功';
            end
            else
            begin
              ListViewFiles.Items[n + i].StateIndex := 2;
              ListViewFiles.Items[n + i].SubItems.Strings[1] := '更新失败';
            end;
          end
          else
          begin
            ListViewFiles.Items[n + i].StateIndex := 3;
            ListViewFiles.Items[n + i].SubItems.Strings[1] := '跳过更新';
            Memo1.Lines.Add(ListViewFiles.Items[n + i].Caption + '文件不需要更新，跳过下载');
          end;
        end
        else
        begin
          ListViewFiles.Items[n + i].SubItems.Strings[1]:='创建中';
          if Download(remote, local) then
          begin
            ListViewFiles.Items[n + i].StateIndex := 1;
            ListViewFiles.Items[n + i].SubItems.Strings[1] := '创建成功';
          end
          else
          begin
            ListViewFiles.Items[n + i].StateIndex := 2;
            ListViewFiles.Items[n + i].SubItems.Strings[1] := '创建失败';
          end;
        end;
        ListviewFiles.Scroll(0, Abs(ListviewFiles.Font.Height));
        Application.ProcessMessages;
        if i = files.Count - 1 then
          result := true;
      end;
    except
      raise;
      Memo1.Lines.Add(ListViewFiles.Items[n + i].Caption+'不能下载文件');
      Exit;
    end;
  finally
    iniFile.Free;
  end;
end;

function TFormUpdate.UpdateFiles: Boolean;
var
  i, n: Integer;
  item: TListItem;
begin
  try
    n := ListviewFiles.Items.Count - files.Count;
    item := ListViewFiles.Items.Add;
    item.StateIndex := 0;
    item.Caption := '复制新文件...';
    Memo1.Lines.Add('正在复制新文件...');
    for i := 0 to files.Count - 1 do //备份旧文件到backupPath
    begin
      CopyFile(PChar(ExtractFilePath(Application.ExeName) + files[i]), PChar(backupPath + files[i] + '.bak'), false);
    end;
    for i := 0 to files.Count - 1 do //从updatePath复制新文件到AppPath//删除updatePath的文件
    begin
      ListViewFiles.Items[n + i].SubItems.Strings[1] := '复制中';
      if Copyfile(PChar(updatePath + files[i]), PChar(ExtractFilePath(Application.ExeName) + files[i]), false) and
        DeleteFile(PChar(updatePath + files[i])) then
        ListViewFiles.Items[n + i].SubItems.Strings[1] := '复制完成'
      else
        ListViewFiles.Items[n + i].SubItems.Strings[1] := '复制失败';
    end;
    ListviewFiles.Scroll(0, Abs(ListviewFiles.Font.Height));
    item.StateIndex := 1;
    Memo1.Lines.Add('新文件复制完成');
    result := true;
  except
    raise;
    item.StateIndex := 2;
    Memo1.Lines.Add('不能复制新文件');
    Exit;
  end;
end;

procedure TFormUpdate.ListBoxHostsClick(Sender: TObject);
begin
  EditURL.Text := hosts[ListBoxHosts.ItemIndex];
end;

procedure TFormUpdate.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if (step >= 6) or (step = 0) then
    CanClose := true
  else if MessageBox(handle, '本次更新没有完成，要退出吗？', '信息提示', MB_YESNO + MB_ICONQUESTION) = ID_YES then
    CanClose := true;
end;

procedure TFormUpdate.BtnLogClick(Sender: TObject);
begin
  if Height = 300 then Height := 386 else Height := 300;
end;

procedure TFormUpdate.EditURLChange(Sender: TObject);
begin
  BtnNext.Enabled := (EditURL.Text <> '');
end;

end.