如何得到一个文件夹的大小？

Question

关于："如何获得一个目录的大小？"
-----------------------------------------------------------------------------
这样吧！
function getdirsize (dir: string; subdir: boolean): longint; 
var rec: TSearchRec; 
    found: integer; 
begin 
 result:=0; 
 if dir[length(dir)]<>'\' then dir:=dir+'\'; 
 found:= findfirst(dir+'*.*', faAnyFile, rec); 
 while found=0 do begin 
  inc(result, rec.size); 
  if (rec.Attr and faDirectory > 0) and (rec.Name[1]<>'.') and (subdir=true) then 
  inc(result, getdirsize(dir+rec.Name, true)); 
  found:=findnext(rec); 
 end; 
 findclose(rec); 
end; procedure TForm1.Button1Click(Sender: TObject); 
begin 
  label1.Caption:=FloatToStr(getdirsize('e:\download', false)/sqr(1024)) + ' MBytes'; 
  label2.Caption:=FloatToStr(getdirsize('e:\download', true)/sqr(1024)) + ' MBytes'; 
end;

Answer 1

以下函数有你用的你选有用的看吧。
uses FileCtrl; 
 private
    { Private declarations }
    FFileName: string;
    //得到路径。
    function GetPath: string;
    //获得目录名称。
    function GetDirectoryName(Dir: string): string;
    procedure FindFiles(aPath: string);
    //磁盘检查
    function CheckDisk(Drive: Byte; aSize: Int64): Boolean;
    //检查目录的大小
    function CheckFileSize(aPath: string): Int64;
    //检查备份文件是否存在，不存在或存在按'确定'返回“真”
    function CheckFileExists(aFileNameString: string): Boolean;
  public
    { Public declarations }
  end;var
  FormBackUp: TFormBackUp;
  IsClickStop: Boolean = False;//按‘取消’按钮时返回‘真’。
  DirectorySize: Int64;//文件夹大小。implementation{$R *.DFM}
const
  a1 = '系统已经完成对记录“';
  a2 = '”的备份。是否将记录“';
  a3 = '”删除？';
function TFormBackUp.GetPath: string;
begin
  if RbAlias.Checked then
  begin
    if cbAlias.Text = '' then
      raise Exception.Create('请选择别名。');
    Result := 'D:\aaa\' + CbAlias.Text;
  end
  else if RbFlolder.Checked then
    Result := edPath.Text
  else
    Result := '';
  if Result = '' then
    raise Exception.Create('您没有选择路径！');
  if not DirectoryExists(Result) then
    raise Exception.CreateFmt('文件夹 “%s”不存在。', [Result]);
end;function TFormBackUp.CheckFileSize(aPath: string): Int64;
begin
  DirectorySize := 0;
  try
    Screen.Cursor := crHourGlass;
    FFileName := '*.*';
    FindFiles(aPath);
    Result := DirectorySize;
    Result := Result div 5;
  finally
    Screen.Cursor := crDefault;
  end;
end;function TFormBackUp.GetDirectoryName(Dir: string): string;
begin
  if Dir[Length(Dir)] <> '\' then
    Result := Dir + '\'
  else
    Result := Dir;
end;procedure TFormBackUp.FindFiles(aPath: string);
var
  FSearchRec, DSearchRec: TSearchRec;
  FindResult: Integer;  function IsDirNotation(aDirName: string): Boolean;
  begin
    Result := (aDirName = '.') or (aDirName = '..');
  end;begin
  aPath := GetDirectoryName(aPath);
  FindResult := FindFirst(aPath + FFileName, faAnyFile + faHidden
    + faSysFile + faReadOnly, FSearchRec);
  try
    while FindResult = 0 do
    begin
      DirectorySize := DirectorySize + FSearchRec.Size;
      FindResult := FindNext(FSearchRec);
    end;    FindResult := FindFirst(aPath + '*.*', faDirectory, DSearchRec);
    while FindResult = 0 do
    begin
      if ((DSearchRec.Attr and faDirectory) = faDirectory) and
        not IsDirNotation(DSearchRec.Name) then
      begin
        FindFiles(aPath + DSearchRec.Name); //递归。
        DirectorySize := DirectorySize + DSearchRec.Size;
      end;
      FindResult := FindNext(DSearchRec);
    end;
  finally
    FindClose(FSearchRec);
    FindClose(DSearchRec);
  end;
end;function TFormBackUp.CheckDisk(Drive: Byte; aSize: Int64): Boolean;
var
  Bn, Chk: Integer;
  MySize: Int64;
begin
  Result := True;
  Chk := 0;
  while Chk = 0 do
  begin
    MySize := DiskFree(Drive);
    if MySize = -1 then
    begin
      Bn := MessageDlg('未插入磁盘或提供备份文件的位置不正确！如果未插入磁盘，请插入后单击“是”。', mtWarning, [mbYes, mbNo], 0);
      if bn = mrYes then Continue
      else
      begin
        Result := False;
        break;
      end;
    end
    else
    begin
      if MySize < aSize then
      begin
        bn := MessageDlg('驱动器剩余空间不足，如果使用磁盘，请插入另一张后单击“是”。', mtWarning, [mbYes, mbNo], 0);
        if bn = mrYes then Continue
        else
        begin
          Result := False;
          break;
        end;
      end
      else
        break;
    end;
  end;
end;function TFormBackUp.CheckFileExists(aFileNameString: string): Boolean;
var
  aFileExistText: string;
begin
  Result := True;
  while FileExists(aFileNameString) do
  begin
    aFileExistText := '文件' + aFileNameString + '已存在，如果单击“确定”，将会以覆盖原文件的形式备份，继续吗？';
    if (MessageDlg(aFileExistText, mtConfirmation, mbOKCancel, 0) <> idCancel) then
    begin
      Result := True;
      break;
    end
    else
    begin
      Result := False;
      break;
    end;
  end;
end;procedure TFormBackUp.SpRestoreClick(Sender: TObject);
begin
  if not FileExists(edFileName.Text) then
  begin
    MessageDlg(Format('文件 %s 不存在！', [edFileName.Text]), mtError, [mbOk], 0);
    Exit;
  end;
  with Archiver1 do
  begin
    FileName := edFileName.Text;
    ExtractPath := GetPath;
    Open;
    try
      ExtractFiles;
    finally
      Close;
    end;
  end;
end;procedure TFormBackUp.SpSelectFileClick(Sender: TObject);
begin
  with OpenDialog1 do
  begin
    if Execute then
      edFileName.Text := FileName;
  end;
end;procedure TFormBackUp.SpBackUpClick(Sender: TObject);
var
  tmp: string;
  mmmPath: string;
  DriveNumber: Integer;
  vByte: Char;
  DirectorySize: LongInt;
  aAliasText: string;
begin
  try
    tmp := GetPath;
    mmmPath := UpperCase(trim(edFileName.Text));
    vByte := mmmPath[1];
    DirectorySize := CheckFileSize(tmp);
    DriveNumber := Ord(vByte) - Ord('A') + 1;
    if CheckDisk(DriveNumber, DirectorySize) = False then
      Exit;
    if CheckFileExists(mmmPath) then
    begin
      with Archiver1 do
      begin
        FileName := edFileName.Text;
        Open;
        try
          AddDirectory(tmp);
        finally
          Close;
        end;
      end;
      if RbAlias.Checked then
      begin
        aAliasText := a1 + CbAlias.Text + a2 + CbAlias.Text + a3;
        if (MessageDlg(aAliasText, mtConfirmation, [mbYes, mbNo], 0) <> MrNo) then
        begin
          Bggl_Form.N1Click(nil);
          Form_DM.ADOD_Hzxx.Delete;
        end;
      end;
    end;
  except
    if IsClickStop then
    begin
      IsClickStop := False;
      raise Exception.Create('进程被取消。');
    end
    else
      raise Exception.Create('文件路径不合法，请仔细检查！');
  end;
end;procedure TFormBackUp.btnAbortClick(Sender: TObject);
begin
  Archiver1.RequestAbort;
  IsClickStop := True;
end;procedure TFormBackUp.Archiver1DisplayMessage(Sender: TObject;
  const msg: string);
begin
  LFile.Caption := msg;
end;procedure TFormBackUp.Archiver1FileProgress(Sender: TObject;
  Percent: Integer);
begin
  ProgressBar1.Position := Percent;
  btnAbort.Enabled := Archiver1.CanAbort;
  Application.ProcessMessages;
end;procedure TFormBackUp.Archiver1FinishOperation(Sender: TObject);
begin
  NoteBook1.PageIndex := 0;
  Application.ProcessMessages;
end;procedure TFormBackUp.Archiver1StartOperation(Sender: TObject);
begin
  with Sender as TArchiver do
  begin
    if Operation = opAdd then
    begin
      lTitle.Caption := '正在备份...';
      AnimateBackUp.Visible := True;
      AnimateRestore.Visible := False;
    end
    else if Operation = opExtract then
    begin
      lTitle.Caption := '正在恢复...';
      AnimateBackUp.Visible := False;
      AnimateRestore.Visible := True;
    end
    else
    begin
      lTitle.Caption := '';
      AnimateBackUp.Visible := False;
      AnimateRestore.Visible := False;
    end;
  end;
  NoteBook1.PageIndex := 1;
end;procedure TFormBackUp.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  CanClose := not Archiver1.IsBusy;
  if not CanClose then
    MessageDlg('操作正在进行中...按“取消”按钮会退出操作。', mtWarning, [mbOk], 0);
end;procedure TFormBackUp.FormCreate(Sender: TObject);
var
  ApplicationPath: string;
begin
  ApplicationPath := ExtractFilePath(Application.ExeName);
  RbAlias.Checked := True;
  with Form_DM.ADODataSet1 do
  begin
    try
      Close;
      OPen;
      CbAlias.Items.Clear;
      First;
      while not Eof do
      begin
        CbAlias.Items.Add(Fields[0].AsString);
        Next;
      end;
    finally
      Close;
    end;
  end;
  AnimateBackUp.FileName := ReturnFileName(aviBackUp);
  AnimateRestore.FileName := ReturnFileName(aviRestore);
  AnimateBackUp.Active := True;
  AnimateRestore.Active := True;
  AnimateRestore.Visible := False;
  Notebook1.PageIndex := 0;
end;procedure TFormBackUp.FormShow(Sender: TObject);
var
  iCount: Integer;
begin
  with CbAlias do
  begin
    for iCount := 0 to Items.Count - 1 do
    begin
      if Items.Strings[iCount] = Form_DM.ADOD_HzxxPatient_Name.Value then
      begin
        ItemIndex := iCount;
        Break;
      end;
    end;
  end;
  edFileName.Text := 'G:\' + cbAlias.Text + '.mmm';
end;procedure TFormBackUp.SpOpenFolderClick(Sender: TObject);
var
  S: string;
begin
  S := '';
  if SelectDirectory('请选择文件夹：', '', S) then
    edPath.Text := S;
  edPath.SetFocus;
  RbFlolder.Checked := True;
end;procedure TFormBackUp.CbAliasEnter(Sender: TObject);
begin
  RbAlias.Checked := True;
end;procedure TFormBackUp.edPathEnter(Sender: TObject);
begin
  RbFlolder.Checked := True;
end;procedure TFormBackUp.cbAliasChange(Sender: TObject);
begin
  Form_DM.LocateName(cbAlias.Text);
  edFileName.Text := 'G:\' + cbAlias.Text + '.mmm';
  ActiveControl := nil;
end;end.