您的位置:首页 > 其它

文件磁盘相关函数[24]-文本文件读写-汇总

2010-11-14 15:15 363 查看
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Memo1: TMemo;
GroupBox1: TGroupBox;
Button1: TButton;
Button2: TButton;
Button3: TButton;
GroupBox2: TGroupBox;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N21: TMenuItem;
N8: TMenuItem;
N22: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N23: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
N16: TMenuItem;
N24: TMenuItem;
N17: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
N25: TMenuItem;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
Button10: TButton;
Button11: TButton;
Panel1: TPanel;
Edit1: TEdit;
Button12: TButton;
N20: TMenuItem;
N26: TMenuItem;
procedure N5Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure N12Click(Sender: TObject);
procedure N13Click(Sender: TObject);
procedure N14Click(Sender: TObject);
procedure N15Click(Sender: TObject);
procedure N16Click(Sender: TObject);
procedure N17Click(Sender: TObject);
procedure N25Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure N18Click(Sender: TObject);
procedure N19Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure Button10Click(Sender: TObject);
procedure Button11Click(Sender: TObject);
procedure N20Click(Sender: TObject);
procedure N26Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
var
estr:string;

procedure TForm1.N5Click(Sender: TObject); //判断文件(包括隐藏文件)是否存在 FileExists
var
f:string;
begin
f := 'f:\test\test.txt';
if FileExists(f) then
begin
if MessageBox(0,'是否打开?','文件存在',MB_YESNO) = IDYES then
begin
Memo1.Lines.LoadFromFile(f);
ShowMessage('文件已打开');
end;
end
else
ShowMessage('文件不存在');
end;

procedure TForm1.N6Click(Sender: TObject); //建立新文件 FileCreate
var
FileName: string;
i: Integer;
begin
FileName := 'f:\test\test.txt';
i := FileCreate(FileName);
if i>0 then
ShowMessage('新文件的句柄是: ' + IntToStr(i))
else
ShowMessage('创建失败!');
FileClose(i);
end;

procedure TForm1.N7Click(Sender: TObject);
//删除文件 DeleteFile; Windows.DeleteFile
var
f: string;
Bool: Boolean;
begin
f := 'f:\test\test.txt';
bool:= DeleteFile(f);  //返回 Boolean
if Bool then
begin
ShowMessage('文件删除成功');
end
else
ShowMessage('文件删除失败');

//或者用系统API:
//Windows.DeleteFile(PChar(f));  //返回 Boolean
end;

procedure TForm1.N8Click(Sender: TObject); //文件改名 RenameFile
var
OldName,NewName: string;
begin
OldName := 'f:\test\test.txt';
NewName := 'f:\test\new.txt';

if RenameFile(OldName,NewName) then
ShowMessage('改名成功!');

//也可以:
{
SetCurrentDir('f:\test');
OldName := 'test.txt';
NewName := 'new.txt';

if RenameFile(OldName,NewName) then
ShowMessage('改名成功!');
}
end;

procedure TForm1.N9Click(Sender: TObject);
//查找一个文件 FileSearch
var
FileName,Dir,s: string;
begin
FileName := 'notepad.exe';
Dir := 'c:\windows';
s := FileSearch(FileName,Dir);

if s<>'' then
ShowMessage(s)  //c:\windows\notepad.exe
else
ShowMessage('没找到');
end;

procedure TForm1.N10Click(Sender: TObject);
//搜索文件 FindFirst; FindNext; FindClose
var
sr: TSearchRec;     //定义 TSearchRec 结构变量
Attr: Integer;      //文件属性
begin
estr := Edit1.Text;
Attr := faAnyFile;              //文件属性值faAnyFile表示是所有文件
if FindFirst(estr,Attr,sr)=0 then  //开始搜索,并给 sr 赋予信息, 返回0表示找到第一个
repeat                        //如果有第一个就继续找
Memo1.Lines.Add(sr.Name);   //用Memo1记下结果
until(FindNext(sr)<>0);       //因为sr已经有了搜索信息, FindNext只要这一个参数, 返回0表示找到
FindClose(sr);                  //需要结束搜索, 搜索是内含句柄的

//更多注释:
//TSearchRec 结构是内涵文件大小、名称、属性与时间等信息
//TSearchRec 中的属性是一个整数值, 可能的值有:
//faReadOnly  1   只读文件
//faHidden    2   隐藏文件
//faSysFile   4   系统文件
//faVolumeID  8   卷标文件
//faDirectory 16  目录文件
//faArchive   32  归档文件
//faSymLink   64  链接文件
//faAnyFile   63  任意文件
//s 的值也可以使用?通配符,好像只支持7个?, 如果没有条件就是*, 譬如: C:\*
//实际使用中还应该在 repeat 中提些条件, 譬如判断如果是文件夹就递归搜索等等
end;

procedure TForm1.N11Click(Sender: TObject); //判断文件夹是否存在 DirectoryExists
var
dir: string;
begin
dir := 'f:\test';
if DirectoryExists(dir) then
begin
ShowMessage('文件夹存在');
end
else
ShowMessage('文件夹不存在');
end;

procedure TForm1.N12Click(Sender: TObject);
//建立文件夹 CreateDir; CreateDirectory; ForceDirectories
var
dir: string;
Bool: Boolean;
begin
dir := 'f:\test';
if not DirectoryExists(dir) then
Bool:=CreateDir(dir);  //返回 Boolean
if Bool then
ShowMessage('建立文件夹成功')
else
ShowMessage('建立文件夹失败');

//也可以直接用API:
//CreateDirectory(PChar(dir),nil);  //返回 Boolean

//如果缺少上层目录将自动补齐:
//dir := 'f:\test\CodeGear\Delphi\巅枫';
//ForceDirectories(dir);  //返回 Boolean
end;

procedure TForm1.N13Click(Sender: TObject); //删除文件夹 RemoveDir; RemoveDirectory
var
dir: string;
Bool: Boolean;
begin
dir := 'f:\test';
bool:=RemoveDir(dir);  //返回 Boolean
if Bool then
ShowMessage('删除文件夹成功')
else
ShowMessage('删除文件夹失败');

//或者用系统 API:
//RemoveDirectory(PChar(dir));  //返回 Boolean
end;

procedure TForm1.N14Click(Sender: TObject);
//获取当前文件夹 GetCurrentDir
var
dir: string;
begin
dir := GetCurrentDir;
ShowMessage(dir);
end;

procedure TForm1.N15Click(Sender: TObject);
//设置当前文件夹 SetCurrentDir; ChDir; SetCurrentDirectory
var
dir: string;
begin
dir := 'f:\test';
if SetCurrentDir(dir) then
ShowMessage('当前文件夹是' + GetCurrentDir)
else
ShowMessage('设置失败');

//或者
//ChDir(dir);  //无返回值

//也可以使用API:
//SetCurrentDirectory(PChar(Dir));  //返回 Boolean
end;

procedure TForm1.N16Click(Sender: TObject);
//获取指定文件的版本号 GetFileVersion
var
s: string;
i: Integer;
dt: TDate;
begin
s := 'C:\WINDOWS\notepad.exe';
i := GetFileVersion(s);  //如果没有版本号返回 -1
ShowMessage(IntToStr(i));  //327681 这是当前记事本的版本号(还应该再转换一下)
end;

procedure TForm1.N17Click(Sender: TObject);
//读取文件属性 FileGetAttr;
var
FileName: string;
Attr: Integer;  //属性值是一个整数
begin
FileName := 'F:\test\Test.txt';
Attr := FileGetAttr(FileName);
ShowMessage(IntToStr(Attr));
//属性可选值(有些用不着):
//FILE_ATTRIBUTE_READONLY = 1; 只读
//FILE_ATTRIBUTE_HIDDEN = 2; 隐藏
//FILE_ATTRIBUTE_SYSTEM = 4; 系统
//FILE_ATTRIBUTE_DIRECTORY = 16
//FILE_ATTRIBUTE_ARCHIVE = 32; 存档
//FILE_ATTRIBUTE_DEVICE = 64
//FILE_ATTRIBUTE_NORMAL = 128; 一般
//FILE_ATTRIBUTE_TEMPORARY = 256
//FILE_ATTRIBUTE_SPARSE_FILE = 512
//FILE_ATTRIBUTE_REPARSE_POINT = 1204
//FILE_ATTRIBUTE_COMPRESSED = 2048; 压缩
//FILE_ATTRIBUTE_OFFLINE = 4096
//FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = 8192; 不被索引
//FILE_ATTRIBUTE_ENCRYPTED = 16384
end;

procedure TForm1.N25Click(Sender: TObject);
//设置文件属性FileSetAttr
var
FileName: string;
Attr: Integer;  //属性值是一个整数
begin
FileName := 'F:\test\Test.txt';
//设置为隐藏和只读文件:
Attr := FILE_ATTRIBUTE_READONLY or FILE_ATTRIBUTE_HIDDEN;
if FileSetAttr(FileName,Attr)=0 then  //返回0表示成功
ShowMessage('设置成功!');
end;

procedure TForm1.Button1Click(Sender: TObject); //打开
begin
if OpenDialog1.Execute then
Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
end;

procedure TForm1.Button2Click(Sender: TObject); //保存
begin
if SaveDialog1.Execute then
Memo1.Lines.SaveToFile(SaveDialog1.FileName);
end;

procedure TForm1.Button3Click(Sender: TObject); //清空
begin
Memo1.Clear;
end;

procedure TForm1.N18Click(Sender: TObject);
//获取文件的创建时间 FileAge; FileDateToDateTime
var
FileName: string;
ti: Integer;
dt: TDateTime;
begin
FileName := 'f:\test\Test.txt';
ti := FileAge(FileName);
ShowMessage(IntToStr(ti));  //返回: 1030115371, 需要转换

dt := FileDateToDateTime(ti);  //转换
ShowMessage(DateTimeToStr(dt));  //2010-11-6 10:01:22
end;

procedure TForm1.N19Click(Sender: TObject);
//获取磁盘空间信息 WinAPI:GetDiskFreeSpaceEx;
var
dfree,dg,p: int64;
begin
if GetDiskFreeSpaceEx('f:',dfree,dg,@p) then
begin
Memo1.Clear;
with Memo1.Lines do
begin
Add('F盘磁盘信息:');
Add('');
Add(Format('可用空间 %f GB',[dfree/1024/1024/1024]));
Add(Format('总空间 %f GB',[dg/1024/1024/1024]));
Add(Format('剩余空间 %f GB',[p/1024/1024/1024]));
end;
end
else
ShowMessage('获取磁盘空间信息失败');
end;

procedure TForm1.Button4Click(Sender: TObject); //覆写文件
var
fvar:TextFile;  //声明文本文件变量
f: string;
begin
f:='f:\test\Test.txt'; //被操作的文件
AssignFile(fvar,f); //变量与文件建立关联
Rewrite(fvar); //覆写打开,会覆盖已存在文件中的内容
Writeln(fvar,'第一行');
Writeln(fvar,'第二行');
CloseFile(fvar); //关闭文件
end;

procedure TForm1.Button5Click(Sender: TObject); //读取文件
var
fvar:TextFile;  //声明文本文件变量
f,s: string;
begin
f:='f:\test\Test.txt';
AssignFile(fvar,f);  //变量与文件建立关联
Reset(fvar);  //只读打开
Readln(fvar, s);   //读取
ShowMessage(s); //显示: 第一行
Readln(fvar, s);   //继续读取
ShowMessage(s); //显示: 第二行
CloseFile(fvar); //关闭文件
end;

procedure TForm1.Button6Click(Sender: TObject); //追加写入文件
var
fvar:TextFile;  //声明文本文件变量
f: string;
begin
f:='f:\test\Test.txt';
AssignFile(fvar,f);  //变量与文件建立关联
Append(fvar);  //以追加写入方式打开

Writeln(fvar, '第三行');
Writeln(fvar, '第四行');

CloseFile(fvar);
end;

procedure TForm1.Button7Click(Sender: TObject); //读取全部
var
fvar:TextFile;  //声明文本文件变量
f,s: string;
begin
f:='f:\test\Test.txt';
AssignFile(fvar,f);  //变量与文件建立关联
Reset(fvar);  //只读打开
Memo1.Clear;
while not Eof(fvar) do  //如果不是文件末尾(用eof函数判断)就一直循环
begin
Readln(fvar, s);    //读取一行
Memo1.Lines.Add(s);
end;

CloseFile(fvar);   //全部读取后关闭文件

end;
//这个过程级函数的功能是: 用空格把 s 凑够 n 的长度
function AddSpace(s: string; n: Word): string;  //自定义函数
begin
while Length(s) < n do
begin
s := s + ' ';
end;
Result := s;
end;

procedure TForm1.Button8Click(Sender: TObject);

var
name: string[8];
address: string[16];
fvar:TextFile;  //声明文本文件变量
f: string;
begin
f:='f:\test\Test.txt';
AssignFile(fvar,f);
Rewrite(fvar);  //只读打开

name := '张三';
name := AddSpace(name,8);  //调用自定义函数处理字符串
address := '山东泰安';
address := AddSpace(address,16);
Writeln(fvar,name,address); //写入一行

name := '李四儿';
name := AddSpace(name,8);
address := '贵州省安顺黄果树';
address := AddSpace(address,16);
Writeln(fvar,name,address);  //再写一行

name := '王二麻子';
name := AddSpace(name,8);
address := '北京市海淀区';
address := AddSpace(address,16);
Writeln(fvar,name,address);  //再写入一行

CloseFile(fvar);
{写入的结果是:
张三    山东泰安
李四儿  贵州省安顺黄果树
王二麻子北京市海淀区
}
end;

procedure TForm1.Button9Click(Sender: TObject);
var
name: string[8];
address: string[16];
fvar:TextFile;  //声明文本文件变量
f: string;
begin
f:='f:\test\Test.txt';
AssignFile(fvar, f);
Reset(fvar);

Memo1.Clear;
while not Eof(fvar) do
begin
Readln(fvar, name);
Memo1.Lines.Add(name);
end;

CloseFile(fvar);
Reset(fvar);

while not Eof(fvar) do
begin
Readln(fvar, name, address);
Memo1.Lines.Add(address);
end;

CloseFile(Fvar);
{读取结果:
张三
李四儿
王二麻子
山东泰安
贵州省安顺黄果树
北京市海淀区
}
end;

procedure TForm1.Button10Click(Sender: TObject);
var
name: string[6];
age: Word;
birthday: TDate;
fvar:TextFile;  //声明文本文件变量
f: string;
begin
f:='f:\test\Test.txt';
AssignFile(fvar, f);
Rewrite(fvar);

name := '菜花  ';  //加两个空格凑够6个字符
age := 18;
birthday := StrToDate(DateToStr(Now-18*365));  //假如她今天过生日
Writeln(fvar,name,age,birthday);

CloseFile(fvar);
end;

procedure TForm1.Button11Click(Sender: TObject);
var
name: string[6];
age: Word;
birthday: TDate;
fvar:TextFile;  //声明文本文件变量
f: string;
begin
f:='f:\test\Test.txt';
AssignFile(fvar, f);
Reset(fvar);

Readln(fvar,name,age,birthday);
Memo1.Clear;
Memo1.Lines.Add(name);
Memo1.Lines.Add(IntToStr(age));
Memo1.Lines.Add(DateToStr(birthday));

CloseFile(fvar);

{读取结果:
菜花
18
1989-12-23
}
//其实这样的东西应该用类型文件操作更合适, 但如果有这样的文本文件让你读取呢?
end;

procedure TForm1.N20Click(Sender: TObject); //一键打开
var
f:string;
begin
f:='f:\test\Test.txt';
Memo1.Lines.LoadFromFile(f);
end;

procedure TForm1.N26Click(Sender: TObject); //一键保存
var
f:string;
begin
f:='f:\test\Test.txt';
Memo1.Lines.SaveToFile(f);
end;

end.
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: