怎样实现用delphi读取一个文件夹里的所有文件，并都写入到一个新的文件里

Question

怎样实现用delphi读取一个文件夹里的所有文件，然后所有文件的信息都写入到一个新的文件里。哪位大侠帮助下，非常感谢！

Answer 1

var
  sr: TSearchRec;//文件信息代码请参考delphi帮助文档实例
procedure TForm1.Button1Click(Sender: TObject);var
  sr: TSearchRec;
  FileAttrs: Integer;
begin
  StringGrid1.RowCount := 1;
  if CheckBox1.Checked then
    FileAttrs := faReadOnly
  else
    FileAttrs := 0;
  if CheckBox2.Checked then
    FileAttrs := FileAttrs + faHidden;
  if CheckBox3.Checked then
    FileAttrs := FileAttrs + faSysFile;
  if CheckBox4.Checked then
    FileAttrs := FileAttrs + faVolumeID;
  if CheckBox5.Checked then    FileAttrs := FileAttrs + faDirectory;
  if CheckBox6.Checked then
    FileAttrs := FileAttrs + faArchive;
  if CheckBox7.Checked then    FileAttrs := FileAttrs + faAnyFile;  with StringGrid1 do
  begin
    RowCount := 0;    if FindFirst(Edit1.Text, FileAttrs, sr) = 0 then    begin
      repeat
        if (sr.Attr and FileAttrs) = sr.Attr then
        begin
        RowCount := RowCount + 1;
        Cells[1,RowCount-1] := sr.Name;
        Cells[2,RowCount-1] := IntToStr(sr.Size);
        end;
      until FindNext(sr) <> 0;
      FindClose(sr);
    end;
  end;
end;

Answer 2

class function TForm1.FindFile(AList: TStrings; const APath: TFileName;
  const Ext: String; const Recurisive, RelativePath: Boolean): Integer;
var
  FSearchRec: TSearchRec;
  FPath: TFileName;
begin
  Result := -1;
  if Assigned(AList) then
  try
    AList.BeginUpdate;
    FPath := IncludeTrailingPathDelimiter(APath);
    if FindFirst(FPath + '*.*', faAnyFile, FSearchRec) = 0 then
      repeat
        if (FSearchRec.Attr and faDirectory) = faDirectory then
        begin
          if Recurisive and (FSearchRec.Name <> '.') and (FSearchRec.Name <> '..') then
            FindFile(AList, FPath + FSearchRec.Name, Ext, Recurisive, RelativePath);
        end
        else if SameText(Ext, EXT_ANY_FILE) or
          SameText(LowerCase(Ext), LowerCase(ExtractFileExt(FSearchRec.Name))) then
        begin
          if RelativePath then
            AList.Add(ExtractRelativePath(FPath,  FPath + FSearchRec.Name))
          else AList.Add(FPath + FSearchRec.Name);
        end;
      until FindNext(FSearchRec) <> 0;
  finally
    AList.EndUpdate;
    SysUtils.FindClose(FSearchRec);
    Result := AList.Count;
  end;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
  FindFile(ListBox1.Items, 'D:\Budded');
end;procedure TForm1.Button2Click(Sender: TObject);
var
  FData: TStrings;
  FDest, FSource: TFileStream;
  I: Integer;
begin
  FData := ListBox1.Items;
  if Assigned(FData) and (FData.Count > 0) then
  begin
    FDest := TFileStream.Create('D:\Budded\Budded.dat', fmCreate);
    try
      for I := 0 to FData.Count - 1 do
      begin
        FSource := TFileStream.Create(FData[I], fmOpenRead);
        try
          FDest.CopyFrom(FSource, FSource.Size);
        finally
          FSource.Free;
        end;
        Application.ProcessMessages;
      end;
    finally
      FDest.Free;
    end;
  end;
end;

Answer 3

================================================================
// 遍历某个文件夹下某种文件,
// 使用说明
//       _GetFileList(ListBox1.Items,'c:\*.doc');
//           _GetFileList(MyTStringList,'c:\*.exe');
// ================================================================
procedure TForm1._GetFileList(AStrings: TStrings ; ASourFile: string);
var sour_path,sour_file: string;
    TmpList:TStringList;
    FileRec:TSearchrec;
begin   sour_path:=ExtractFilePath(ASourFile);
   sour_file:=ExtractFileName(ASourFile);   if not DirectoryExists(sour_path) then
   begin
     AStrings.Clear;
     exit;
   end;   TmpList:=TStringList.Create;
   TmpList.Clear;   if FindFirst(sour_path+sour_file,faAnyfile,FileRec) = 0 then
   repeat
      if ((FileRec.Attr and faDirectory) = 0) then
         begin
           TmpList.Add(sour_path+FileRec.Name)
         end;
   until FindNext(FileRec)<>0;   SysUtils.FindClose(FileRec);   AStrings.Assign(TmpList);   TmpList.Free;
end;// ================================================================
// 遍历某个文件夹及子文件夹下某种文件,
// 使用说明
//       _GetFileList(ListBox1.Items, 'c:\', '*.doc');
//           _GetFileList(MyTStringList, 'c:\', '*.exe');
// ================================================================
procedure _GetFileList(AStrings: TStrings; ASourFile,
  FileName: string);
var sour_path,sour_file: string;
    TmpList:TStringList;
    FileRec, subFileRec:TSearchrec;
    i: Integer;
begin
   if rightStr(trim(ASourFile), 1) <> '\' then
     sour_path :=trim(ASourFile) + '\'
   else
     sour_path :=trim(ASourFile);
   sour_file:= FileName;   if not DirectoryExists(sour_path) then
   begin
     AStrings.Clear;
     exit;
   end;   TmpList:=TStringList.Create;
   TmpList.Clear;   if FindFirst(sour_path+'*.*',faAnyfile,FileRec) = 0 then
   repeat
      if ((FileRec.Attr and faDirectory) <> 0) then
         begin
           if ((FileRec.Name<> '.') and (FileRec.Name  <> '..')) then
             _GetFileList(AStrings, sour_path+ FileRec.Name + '\',  sour_file);
         end
      else
        if FindFirst(sour_path + FileName,faAnyfile,subFileRec) = 0 then
        repeat
          if ((subFileRec.Attr and faDirectory) = 0) then
            TmpList.Add(sour_path+subFileRec.Name);
        until FindNext(subFileRec)<>0;   until FindNext(FileRec)<>0;   SysUtils.FindClose(FileRec);
   for i := 0 to TmpList.Count -1 do
     AStrings.Add(TmpList.Strings[i]);   TmpList.Free;
end;