Delphi经典实例13------文件信息处理

最新推荐文章于 2025-11-09 07:59:07 发布

原创最新推荐文章于 2025-11-09 07:59:07 发布 · 772 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#delphi #integer #button #forms #windows #class

Delphi未了情专栏收录该内容

66 篇文章

订阅专栏

本文提供了一系列关于文件操作、文件流管理和无类型文件处理的技术实例，涵盖了文本文件读写、复制文件到新目录及递归查找特定类型的文件等核心功能。通过这些实例，读者可以深入理解文件系统交互的基础知识，掌握高效处理文件数据的编程技巧。

部署运行你感兴趣的模型镜像

1.文本文件处理

如下图所示建立工程：

代码如下：

unit mainunit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; GroupBox1: TGroupBox; Memo1: TMemo; Label1: TLabel; Button2: TButton; Button3: TButton; Button4: TButton; OpenDialog1: TOpenDialog; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; ATextFile:TextFile; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin With OpenDialog1 do if execute then begin Label1.Caption:='当前打开的文件:'+FileName; if FileName<>'' then begin AssignFile(ATextFile,Opendialog1.FileName); ShowMessage('文件文件变量和具体的磁盘文件成功建立关联'); Button2.Enabled:=True; Memo1.Lines.Clear; end; end; end; procedure TForm1.FormCreate(Sender: TObject); begin OpenDialog1.FileName:=''; OpenDialog1.InitialDir:=ExtractFileDir(Application.ExeName); end; procedure TForm1.Button2Click(Sender: TObject); var TextStr:String; begin if MessageDlg('是否选择只读(Reset)模式打开该文本文件?',mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin Memo1.ReadOnly:=True; Button3.Enabled:=False; end else begin Memo1.ReadOnly:=False; Button3.Enabled:=True; end; Reset(ATextFile); Memo1.Lines.Clear; Memo1.Lines.BeginUpdate; try While Not Eof(ATextFile) do begin ReadLn(ATextFile,TextStr); Memo1.Lines.Add(TextStr); end finally Memo1.Lines.EndUpdate; CloseFile(ATextFile); end end; procedure TForm1.Button3Click(Sender: TObject); var i:Integer; begin //AssignFile(ATextFile,Opendialog1.FileName); Rewrite(ATextFile); try for i:=0 to Memo1.Lines.Count-1 do begin WriteLn(ATextFile,Memo1.Lines[i]) end; ShowMessage('该文件已经被成功保存到磁盘上!'); finally CloseFile(ATextFile); end end; procedure TForm1.Button4Click(Sender: TObject); begin Close; end; end.

2.文件流对象处理

如下图所示建立工程：

代码如下：

unit mainunit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, Buttons; type TForm1 = class(TForm) GroupBox1: TGroupBox; Label1: TLabel; Edit1: TEdit; Edit2: TEdit; Label2: TLabel; BitBtn1: TBitBtn; BitBtn2: TBitBtn; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; BitBtn3: TBitBtn; BitBtn4: TBitBtn; procedure FormCreate(Sender: TObject); procedure BitBtn1Click(Sender: TObject); procedure BitBtn2Click(Sender: TObject); procedure BitBtn4Click(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure BitBtn3Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; Copying:Boolean; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin OpenDialog1.FileName:=''; OpenDialog1.InitialDir:=ExtractFileDir(Application.ExeName); SaveDialog1.FileName:=''; SaveDialog1.InitialDir:=ExtractFileDir(Application.ExeName); BitBtn3.Enabled:=False; Copying:=False; end; procedure TForm1.BitBtn1Click(Sender: TObject); begin With Opendialog1 do if Execute then Edit1.Text:=Opendialog1.FileName; if ((Edit1.Text<>'') and (Edit2.Text<>'')) then BitBtn3.Enabled:=True else BitBtn3.Enabled:=False; end; procedure TForm1.BitBtn2Click(Sender: TObject); begin With SaveDialog1 do if Execute then Edit2.Text:=Savedialog1.FileName; if ((Edit1.Text<>'') and (Edit2.Text<>'')) then BitBtn3.Enabled:=True else BitBtn3.Enabled:=False; end; procedure TForm1.BitBtn4Click(Sender: TObject); begin Close; end; procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin if Copying then CanClose:=False else CanClose:=True; end; procedure TForm1.BitBtn3Click(Sender: TObject); var FromFile,ToFile:TFileStream; begin FromFile:=TFileStream.Create(Edit1.Text,fmOpenRead); try ToFile:=TFileStream.Create(Edit2.Text,fmCreate); BitBtn3.Enabled:=False; Copying:=True; try ToFile.CopyFrom(FromFile,0); ShowMessage('复制文件过程成功完成.') finally BitBtn3.Enabled:=True; ToFile.Free end finally FromFile.Free; Copying:=False end end; end.

3. 无类型文件处理

如下图所示建立工程：

代码如下：

unit mainunit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, Buttons; type TForm1 = class(TForm) GroupBox1: TGroupBox; Label1: TLabel; Edit1: TEdit; Edit2: TEdit; Label2: TLabel; ProgressBar1: TProgressBar; Label3: TLabel; BitBtn1: TBitBtn; BitBtn2: TBitBtn; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; BitBtn3: TBitBtn; BitBtn4: TBitBtn; procedure FormCreate(Sender: TObject); procedure BitBtn1Click(Sender: TObject); procedure BitBtn2Click(Sender: TObject); procedure BitBtn4Click(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure BitBtn3Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; Copying:Boolean; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin OpenDialog1.FileName:=''; OpenDialog1.InitialDir:=ExtractFileDir(Application.ExeName); SaveDialog1.FileName:=''; SaveDialog1.InitialDir:=ExtractFileDir(Application.ExeName); BitBtn3.Enabled:=False; Copying:=False; end; procedure TForm1.BitBtn1Click(Sender: TObject); begin With Opendialog1 do if Execute then Edit1.Text:=Opendialog1.FileName; if ((Edit1.Text<>'') and (Edit2.Text<>'')) then BitBtn3.Enabled:=True else BitBtn3.Enabled:=False; end; procedure TForm1.BitBtn2Click(Sender: TObject); begin With SaveDialog1 do if Execute then Edit2.Text:=Savedialog1.FileName; if ((Edit1.Text<>'') and (Edit2.Text<>'')) then BitBtn3.Enabled:=True else BitBtn3.Enabled:=False; end; procedure TForm1.BitBtn4Click(Sender: TObject); begin Close; end; procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin if Copying then CanClose:=False else CanClose:=True; end; procedure TForm1.BitBtn3Click(Sender: TObject); var FromFile,ToFile:File; NumRead,NumWrite:Integer; Buf:Array[1..2048] of byte; begin AssignFile(FromFile,Opendialog1.FileName); Reset(FromFile,1); AssignFile(ToFile,SaveDialog1.FileName); Rewrite(ToFile,1); ProgressBar1.Max:=(FileSize(FromFile)*2 div sizeof(buf)); repeat BlockRead(FromFile,Buf,Sizeof(Buf),NumRead); ProgressBar1.StepIt; BlockWrite(ToFile,Buf,NumRead,NumWrite); ProgressBar1.StepIt; Copying:=True; Application.ProcessMessages; until ((NumRead=0) or (NumWrite<>NumRead)); CloseFile(FromFile); CloseFile(ToFile); Copying:=False; ShowMessage('复制文件过程成功完成.'); end; end.

4.复制所有文件到新目录

如下图所示建立工程：

代码如下：

unit mainunit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons,ShellApi,FileCtrl; type TForm1 = class(TForm) Memo1: TMemo; Label2: TLabel; BitBtn1: TBitBtn; Edit1: TEdit; BitBtn2: TBitBtn; BitBtn3: TBitBtn; Label1: TLabel; BitBtn4: TBitBtn; Edit2: TEdit; procedure BitBtn1Click(Sender: TObject); procedure BitBtn4Click(Sender: TObject); procedure Edit1Change(Sender: TObject); procedure Edit2Change(Sender: TObject); procedure BitBtn2Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure BitBtn3Click(Sender: TObject); private { Private declarations } public function CurrentIsValidDir(SearchRec:TSearchRec):integer; procedure RecurSearchFile(CurrentDir:string;SearchFileType:string;SearchResult:TStrings;var Number:integer); procedure Xcopy(SourceDir,TargetDir:String); { Public declarations } end; var Form1: TForm1; TotalFileNumbers:Integer; SearchFileType:String; Copying:Boolean; implementation {$R *.dfm} function TForm1.CurrentIsValidDir(SearchRec:TSearchRec):integer; begin if ((SearchRec.Attr <> 16) and (SearchRec.Name<>'.') and (SearchRec.Name<>'..')) then Result:=0 else if ((SearchRec.Attr = 16) and (SearchRec.Name<>'.') and (SearchRec.Name<>'..')) then Result:=1 else Result:=2; end; Procedure TForm1.RecurSearchFile(CurrentDir:string;SearchFileType:string;SearchResult:TStrings;var Number:integer); var i:integer; Subdir:TStringList; SearchRec:TsearchRec; begin //第一次调用FindFirst和FindNext查找符合要求的文件 if (FindFirst(CurrentDir+SearchFileType, faAnyFile, SearchRec)=0) then begin repeat if CurrentIsValidDir(SearchRec)=0 then begin Inc(Number); Searchresult.Add(CurrentDir+SearchRec.Name); end; application.ProcessMessages ; until (FindNext(SearchRec) <> 0); end; FindClose(SearchRec); //以下是递归部分，查找各子目录。 Subdir:=TStringList.Create; if (FindFirst(CurrentDir+'*.*', faDirectory, SearchRec)=0) then begin repeat if CurrentIsValidDir(SearchRec)=1 then begin Subdir.Add(SearchRec.Name); end; application.ProcessMessages ; until (FindNext(SearchRec) <> 0); end; FindClose(SearchRec); for i:=0 to Subdir.Count-1 do begin RecurSearchfile(CurrentDir+Subdir.Strings[i]+'/',SearchFileType,Searchresult,Number); end; //资源释放并返回结果。 Subdir.Free; end; procedure TForm1.Xcopy(SourceDir,TargetDir:String); var OpStruc: TSHFileOpStruct;//声明一个TSHFileOpStruct记录结构 FromBuf, ToBuf: Array [0..128] of Char;//定义源和目的缓冲区 begin FillChar(FromBuf, Sizeof(FromBuf), 0 ); FillChar(ToBuf, Sizeof(ToBuf), 0 ); StrPCopy(FromBuf, SourceDir+'*.*' ); StrPCopy(ToBuf, TargetDir); With OpStruc do begin Wnd:= Handle;//设定句柄为当前Form窗体，因此对话框为系统对话框 wFunc:= FO_Copy;//操作类型为从源到目的地的拷贝操作 pFrom:= @FromBuf; pTo:=@ ToBuf; fFlags:= FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;//控制方式为无确认与命名冲突的组合 fAnyOperationsAborted:= False; hNameMappings:= Nil; lpszProgressTitle:= Nil; end; ShFileOperation( OpStruc );//调用Api函数，传入参数完成操作 end; procedure TForm1.BitBtn1Click(Sender: TObject); var SelectDir:string; begin if SelectDirectory(SelectDir, [sdAllowCreate, sdPerformCreate, sdPrompt],0) then begin if length(SelectDir) > 3 then SelectDir:=SelectDir+'/'; Edit1.Text:=SelectDir; end; end; procedure TForm1.BitBtn4Click(Sender: TObject); var SelectDir:string; begin if SelectDirectory(SelectDir, [sdAllowCreate, sdPerformCreate, sdPrompt],0) then begin if length(SelectDir) > 3 then SelectDir:=SelectDir+'/'; Edit2.Text:=SelectDir; end; end; procedure TForm1.Edit1Change(Sender: TObject); begin if ((Edit1.Text='')or(Edit2.Text='')) then BitBtn2.Enabled:=False else BitBtn2.Enabled:=True; end; procedure TForm1.Edit2Change(Sender: TObject); begin if ((Edit1.Text='')or(Edit2.Text='')) then BitBtn2.Enabled:=False else BitBtn2.Enabled:=True; end; procedure TForm1.BitBtn2Click(Sender: TObject); begin BitBtn2.Enabled:=False; Copying:=True; memo1.lines.Clear ; TotalFileNumbers:=0; RecurSearchFile(Edit1.Text,SearchFileType,memo1.lines, TotalFileNumbers); Xcopy(Edit1.Text,Edit2.Text); Copying:=False; Memo1.Lines.Add('拷贝操作全部结束,一共拷贝'+IntToStr(TotalFileNumbers)+'个文件到目标目录.'); Edit1.Clear; Edit2.Clear; end; procedure TForm1.FormCreate(Sender: TObject); begin TotalFileNumbers:=0; SearchFileType:='*.*'; Copying:=False; end; procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin if Copying then CanClose:=False else CanClose:=True; end; procedure TForm1.BitBtn3Click(Sender: TObject); begin Close; end; end.

5.递归查找文件

如下图所示建立工程：

代码如下：

unit mainunit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons,FileCtrl; type TForm1 = class(TForm) Memo1: TMemo; Label1: TLabel; Label2: TLabel; ComboBox1: TComboBox; Edit1: TEdit; BitBtn1: TBitBtn; BitBtn2: TBitBtn; BitBtn3: TBitBtn; Label3: TLabel; procedure FormCreate(Sender: TObject); procedure ComboBox1Change(Sender: TObject); procedure Edit1Change(Sender: TObject); procedure BitBtn1Click(Sender: TObject); procedure BitBtn2Click(Sender: TObject); procedure BitBtn3Click(Sender: TObject); private { Private declarations } public function CurrentIsValidDir(SearchRec:TSearchRec):integer; procedure RecurSearchFile(CurrentDir:string;SearchFileType:string;SearchResult:TStrings;var Number:integer); { Public declarations } end; var Form1: TForm1; TotalFileNumbers:Integer; SearchFileType:String; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin TotalFileNumbers:=0; SearchFileType:='*.txt'; end; function TForm1.CurrentIsValidDir(SearchRec:TSearchRec):integer; begin if ((SearchRec.Attr <> 16) and (SearchRec.Name<>'.') and (SearchRec.Name<>'..')) then Result:=0 else if ((SearchRec.Attr = 16) and (SearchRec.Name<>'.') and (SearchRec.Name<>'..')) then Result:=1 else Result:=2; end; Procedure TForm1.RecurSearchFile(CurrentDir:string;SearchFileType:string;SearchResult:TStrings;var Number:integer); var i:integer; Subdir:TStringList; SearchRec:TsearchRec; begin //第一次调用FindFirst和FindNext查找符合要求的文件 if (FindFirst(CurrentDir+SearchFileType, faAnyFile, SearchRec)=0) then begin repeat if CurrentIsValidDir(SearchRec)=0 then begin Inc(Number); Searchresult.Add(CurrentDir+SearchRec.Name); end; application.ProcessMessages ; until (FindNext(SearchRec) <> 0); end; FindClose(SearchRec); //以下是递归部分，查找各子目录。 Subdir:=TStringList.Create; if (FindFirst(CurrentDir+'*.*', faDirectory, SearchRec)=0) then begin repeat if CurrentIsValidDir(SearchRec)=1 then begin Subdir.Add(SearchRec.Name); end; application.ProcessMessages ; until (FindNext(SearchRec) <> 0); end; FindClose(SearchRec); for i:=0 to Subdir.Count-1 do begin RecurSearchfile(CurrentDir+Subdir.Strings[i]+'/',SearchFileType,Searchresult,Number); end; //资源释放并返回结果。 Subdir.Free; end; procedure TForm1.ComboBox1Change(Sender: TObject); begin Case ComboBox1.ItemIndex of 0:SearchFileType:='*.txt'; 1:SearchFileType:='*.bmp'; 2:SearchFileType:='*.mp3'; 3:SearchFileType:='*.*'; end; end; procedure TForm1.Edit1Change(Sender: TObject); begin if Edit1.Text='' then BitBtn2.Enabled:=False else BitBtn2.Enabled:=True; end; procedure TForm1.BitBtn1Click(Sender: TObject); var SelectDir:string; begin if SelectDirectory(SelectDir, [sdAllowCreate, sdPerformCreate, sdPrompt],0) then begin if length(SelectDir) > 3 then SelectDir:=SelectDir+'/'; Edit1.Text:=SelectDir; end; end; procedure TForm1.BitBtn2Click(Sender: TObject); begin memo1.lines.Clear ; TotalFileNumbers:=0; RecurSearchFile(Edit1.Text,SearchFileType,memo1.lines, TotalFileNumbers); Label3.Caption:='查找结果显示:'+'一共在当前目录下找到'+IntToStr(TotalFileNumbers)+'个'+SearchFileType+'类型的文件'; end; procedure TForm1.BitBtn3Click(Sender: TObject); begin Close; end; end.

您可能感兴趣的与本文相关的镜像