longqcc

学习永远止境,更要学会总结。本博客大多数的内容都是从网上收集而来,加上自已的一点整理。在这里特别感谢“万一”老师的分享,谢谢!

博客园 首页 新随笔 联系 管理

uses
  HTTPApp, Masks;

procedure TForm1.Button1Click(Sender: TObject);
var
  ss,s: string;
begin
 
//先提取一个文件名的字符串
  ss := Application.ExeName;
  ShowMessage(ss);
//C:\Documents and Settings\wy\My Documents\RAD Studio\Projects\Project1.exe

 
//路径
  s := ExtractFilePath(ss);
  ShowMessage(s);
//C:\Documents and Settings\wy\My Documents\RAD Studio\Projects\

 
//所在文件夹
  s := ExtractFileDir(ss);
  ShowMessage(s);
//C:\Documents and Settings\wy\My Documents\RAD Studio\Projects

 
//所在逻辑盘
  s := ExtractFileDrive(ss);
  ShowMessage(s);
//C:

 
//文件名
  s := ExtractFileName(ss);
  ShowMessage(s);
//Project1.exe

 
//文件扩展名
  s := ExtractFileExt(ss);
  ShowMessage(s);
//.exe

 
//相对路径
  s := ExtractRelativePath('C:\Documents and Settings\wy\My Documents\',ss);
  ShowMessage(s);
//RAD Studio\Projects\Project1.exe

 
//dos下的短文件名
  s := ExtractShortPathName(ss);
  ShowMessage(s);
//C:\DOCUME~1\wy\MYDOCU~1\RADSTU~1\Projects\Project1.exe

 
//转换到Unix路径格式, 需要 uses HTTPApp
  s := DosPathToUnixPath(ss);
  ShowMessage(s);
//C:/Documents and Settings/wy/My Documents/RAD Studio/Projects/Project1.exe

 
//转Unix路径格式为Window格式, 是 DosPathToUnixPath 的逆操作
  s := ExpandUNCFileName(DosPathToUnixPath(ss));
  ShowMessage(s);
//C:\Documents and Settings\wy\My Documents\RAD Studio\Projects\Project1.exe

 
//去掉结尾的路径分隔符
  s := ExcludeTrailingPathDelimiter(ExtractFilePath(ss));
  ShowMessage(s);
//C:\Documents and Settings\wy\My Documents\RAD Studio\Projects

 
//去掉结尾的路径分隔符, 只是调用:ExcludeTrailingPathDelimiter
  s := ExcludeTrailingBackslash(ExtractFilePath(ss));
  ShowMessage(s);
//C:\Documents and Settings\wy\My Documents\RAD Studio\Projects

 
//更换扩展名, 并不修改文件, 只是替换字符串:
  s := ChangeFileExt(ss,'.bak');
  ShowMessage(s);
//C:\Documents and Settings\wy\My Documents\RAD Studio\Projects\Project1.bak

 
//更换文件路径:
  s := ChangeFilePath(ss,'c:\temp');
  ShowMessage(s);
//c:\temp\Project1.exe

 
//判断第几个字符是否是路径分隔符:
  IsPathDelimiter(ss,3);
//返回 True

 
//判断后缀名是不是 exe; 需要 uses Masks
  MatchesMask(ss,'*.exe');
//返回 True
end;




//分解 ProcessPath (需要 uses FileCtrl)
var
  s,p,f: string;
  d: Char;
begin
  s := ParamStr(0);
  ShowMessage(s);
//C:\Documents and Settings\wy\My Documents\RAD Studio\Projects\Project1.exe
  ProcessPath(s,d,p,f);
  ShowMessage(d);
//C
  ShowMessage(p);
//\Documents and Settings\wy\My Documents\RAD Studio\Projects
  ShowMessage(f);
//Project1.exe
end;



//压缩显示 MinimizeName (需要 uses FileCtrl)
var
  s: string;
begin
  s := ParamStr(0);
  s := MinimizeName(s,Self.Canvas,100);
  ShowMessage(s);
//C:\...\Project1.exe
end;

//判断文件是否存在 FileExists
var
  f: string;
begin
  f := 'c:\temp\test.txt';
  if not FileExists(f) then
  begin
   
//如果文件不存在
  end;
end;



//判断文件夹是否存在 DirectoryExists
var
  dir: string;
begin
  dir := 'c:\temp';
  if not DirectoryExists(dir) then
  begin
   
//如果文件夹不存在
  end;
end;



//删除文件 DeleteFile; Windows.DeleteFile
var
  f: string;
begin
  f := 'c:\temp\test.txt';
 
//DeleteFile(f);  //返回 Boolean

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



//删除文件夹 RemoveDir; RemoveDirectory
var
  dir: string;
begin
  dir := 'c:\temp';
  RemoveDir(dir); 
//返回 Boolean

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



//获取当前文件夹 GetCurrentDir
var
  dir: string;
begin
  dir := GetCurrentDir;
  ShowMessage(dir);
//C:\Documents and Settings\wy\My Documents\RAD Studio\Projects
end;



//设置当前文件夹 SetCurrentDir; ChDir; SetCurrentDirectory
var
  dir: string;
begin
  dir := 'c:\temp';
  if SetCurrentDir(dir) then
    ShowMessage(GetCurrentDir); 
//c:\temp

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

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



//获取指定驱动器的当前路径名 GetDir
var
  dir: string;
  b: Byte;
begin
  b := 0;
  GetDir(b,dir);
  ShowMessage(dir); 
//

 
//第一个参数: 1、2、3、4...分别对应: A、B、C、D...
 
//0 是缺省驱动器
end;



//文件改名 RenameFile
var
  OldName,NewName: string;
begin
  OldName := 'c:\temp\Old.txt';
  NewName := 'c:\temp\New.txt';

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

 
//也可以:
  SetCurrentDir('c:\temp');
  OldName := 'Old.txt';
  NewName := 'New.txt';

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



//建立文件夹 CreateDir; CreateDirectory; ForceDirectories
var
  dir: string;
begin
  dir := 'c:\temp\delphi';
  if not DirectoryExists(dir) then
    CreateDir(dir); 
//返回 Boolean

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

 
//如果缺少上层目录将自动补齐:
  dir := 'c:\temp\CodeGear\Delphi\2007\万一';
  ForceDirectories(dir); 
//返回 Boolean
end;



//删除空文件夹 RemoveDir; RemoveDirectory
var
  dir: string;
begin
  dir := 'c:\temp\delphi';
  RemoveDir(dir); 
//返回 Boolean

 
//也可以直接用API:
  RemoveDirectory(PChar(dir)); 
//返回 Boolean
end;



//建立新文件 FileCreate
var
  FileName: string;
  i: Integer;
begin
  FileName := 'c:\temp\test.dat';
  i := FileCreate(FileName);

  if i>0 then
    ShowMessage('新文件的句柄是: ' + IntToStr(i))
  else
    ShowMessage('创建失败!');
end;



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



//获取磁盘空间 DiskSize; DiskFree
var
  r: Real;
  s: string;
begin
  r := DiskSize(3); 
//获取C:总空间, 单位是字节
  r := r/1024/1024/1024;
  Str(r:0:2,s); 
//格式为保留两位小数的字符串
  s := 'C盘总空间是: ' + s + ' GB';
  ShowMessage(s); 
//xx.xx GB

  r := DiskFree(3); 
//获取C:可用空间
  r := r/1024/1024/1024;
  Str(r:0:2,s);
  s := 'C盘可用空间是: ' + s + ' GB';
  ShowMessage(s); 
//xx.xx GB
end;

 
//查找一个文件 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;



//搜索文件 FindFirst; FindNext; FindClose
var
  sr: TSearchRec;    
//定义 TSearchRec 结构变量
  Attr: Integer;     
//文件属性
  s: string;         
//要搜索的内容
  List: TStringList; 
//存放搜索结果
begin
  s := 'c:\windows\*.txt';
  Attr := faAnyFile;             
//文件属性值faAnyFile表示是所有文件
  List := TStringList.Create;    
//List建立

  if FindFirst(s,Attr,sr)=0 then 
//开始搜索,并给 sr 赋予信息, 返回0表示找到第一个
  begin
    repeat                       
//如果有第一个就继续找
      List.Add(sr.Name);         
//用List记下结果
    until(FindNext(sr)<>0);      
//因为sr已经有了搜索信息, FindNext只要这一个参数, 返回0表示找到
  end;
  FindClose(sr);                 
//需要结束搜索, 搜索是内含句柄的

  ShowMessage(List.Text);        
//显示搜索结果
  List.Free;                     
//释放List

 
//更多注释:
 
//TSearchRec 结构是内涵文件大小、名称、属性与时间等信息
 
//TSearchRec 中的属性是一个整数值, 可能的值有:
 
//faReadOnly  1   只读文件
 
//faHidden    2   隐藏文件
 
//faSysFile   4   系统文件
 
//faVolumeID  8   卷标文件
 
//faDirectory 16  目录文件
 
//faArchive   32  归档文件
 
//faSymLink   64  链接文件
 
//faAnyFile   63  任意文件

 
//s 的值也可以使用?通配符,好像只支持7个?, 如果没有条件就是*, 譬如: C:\*
 
//实际使用中还应该在 repeat 中提些条件, 譬如判断如果是文件夹就递归搜索等等
end;



//读取与设置文件属性 FileGetAttr; FileSetAttr
var
  FileName: string;
  Attr: Integer; 
//属性值是一个整数
begin
  FileName := 'c:\temp\Test.txt';
  Attr := FileGetAttr(FileName);
  ShowMessage(IntToStr(Attr)); 
//32, 存档文件

 
//设置为隐藏和只读文件:
  Attr := FILE_ATTRIBUTE_READONLY or FILE_ATTRIBUTE_HIDDEN;
  if FileSetAttr(FileName,Attr)=0 then 
//返回0表示成功
    ShowMessage('设置成功!');

 
//属性可选值(有些用不着):
 
//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;



//获取文件的创建时间 FileAge; FileDateToDateTime
var
  FileName: string;
  ti: Integer;
  dt: TDateTime;
begin
  FileName := 'c:\temp\Test.txt';
  ti := FileAge(FileName);
  ShowMessage(IntToStr(ti)); 
//返回: 931951472, 需要转换

  dt := FileDateToDateTime(ti); 
//转换
  ShowMessage(DateTimeToStr(dt)); 
//2007-12-12 14:27:32
end;

//批量删除同类文件的函数
procedure DelFiles(f: string);
var
  SearchRec: TSearchRec;
begin
  ChDir(ExtractFilePath(f));  //进入文件路径
  FindFirst(f, faAnyFile, SearchRec);
  repeat
    if FileExists(SearchRec.Name) then
    begin
      //FileSetAttr(SearchRec.Name,0); //修改文件属性为普通属性值
      DeleteFile(SearchRec.Name); //删除文件
    end;
  until(FindNext(SearchRec)<>0);
  FindClose(SearchRec);
end;

 菊子曰:我在用着的博客编辑软件
posted on 2013-05-18 02:16  longqcc  阅读(409)  评论(0编辑  收藏  举报