delphi文件管理类函数

最新推荐文章于 2024-04-17 17:00:44 发布

百炼成钢百忍成佛

最新推荐文章于 2024-04-17 17:00:44 发布

阅读量2.1k

点赞数

文章标签： delphi function string integer windows linux

//判断文件是否存在 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;

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

function FileExists(const FileName: string): Boolean;
{$IFDEF MSWINDOWS}
begin
Result := FileAge(FileName) <> -1;
end;
{$ENDIF}
{$IFDEF LINUX}
begin
Result := euidaccess(PChar(FileName), F_OK) = 0;
end;
{$ENDIF}

//判断文件夹是否存在 DirectoryExists
var
dir: string;
begin
dir := 'c:\temp';
if not DirectoryExists(dir) then
begin
         //如果文件夹不存在
end;
end;
==================
function DirectoryExists(const Directory: string): Boolean;
{$IFDEF LINUX}
var
st: TStatBuf;
begin
if stat(PChar(Directory), st) = 0 then
         Result := S_ISDIR(st.st_mode)
else
         Result := False;
end;
{$ENDIF}
{$IFDEF MSWINDOWS}
var
Code: Integer;
begin
Code := GetFileAttributes(PChar(Directory));
Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;
{$ENDIF}
 
 
 

 
 
     
     
      
      //删除文件 DeleteFile; Windows.DeleteFile var f: string; begin f := 'c:\temp\test.txt'; //DeleteFile(f); //返回 Boolean
      
      //或者用系统API: Windows.DeleteFile(PChar(f)); //返回 Boolean end;
      
      ======================
      
      function DeleteFile(const FileName: string): Boolean; begin {$IFDEF MSWINDOWS} Result := Windows.DeleteFile(PChar(FileName)); {$ENDIF} {$IFDEF LINUX} Result := unlink(PChar(FileName)) <> -1; {$ENDIF} end;

//删除文件夹 RemoveDir; RemoveDirectory
var
dir: string;
begin
dir := 'c:\temp';
RemoveDir(dir); //返回 Boolean
//或者用系统 API:
RemoveDirectory(PChar(dir)); //返回 Boolean
end;
========================
function RemoveDir(const Dir: string): Boolean;
begin
{$IFDEF MSWINDOWS}
Result := RemoveDirectory(PChar(Dir));
{$ENDIF}
{$IFDEF LINUX}
Result := __rmdir(PChar(Dir)) = 0;
{$ENDIF}
end;

//获取当前文件夹 GetCurrentDir
var
dir: string;
begin
dir := GetCurrentDir;
ShowMessage(dir); //C:\Documents and Settings\wy\My Documents\RAD Studio\Projects
end;
=============
function GetCurrentDir: string;
begin
GetDir(0, Result);
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;

=====================

function SetCurrentDir(const Dir: string): Boolean;
begin
{$IFDEF MSWINDOWS}
Result := SetCurrentDirectory(PChar(Dir));
{$ENDIF}
{$IFDEF LINUX}
Result := __chdir(PChar(Dir)) = 0;
{$ENDIF}
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;
==================
function CreateDir(const Dir: string): Boolean;
begin
{$IFDEF MSWINDOWS}
Result := CreateDirectory(PChar(Dir), nil);
{$ENDIF}
{$IFDEF LINUX}
Result := __mkdir(PChar(Dir), mode_t(-1)) = 0;
{$ENDIF}
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;
  
  =================
  
  function FileCreate(const FileName: string): Integer;
{$IFDEF MSWINDOWS}
begin
Result := Integer(CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
        0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));
end;
{$ENDIF}
{$IFDEF LINUX}
begin
Result := FileCreate(FileName, FileAccessRights);
end;
{$ENDIF}

 //文件改名 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;
=====================
function RenameFile(const OldName, NewName: string): Boolean;
begin
{$IFDEF MSWINDOWS}
Result := MoveFile(PChar(OldName), PChar(NewName));
{$ENDIF}
{$IFDEF LINUX}
Result := __rename(PChar(OldName), PChar(NewName)) = 0;
{$ENDIF}
end;

//获取文件的创建时间FileAge
 
  
 
 
 
 
     
     
      
      function FileAge(const FileName: string): Integer; {$IFDEF MSWINDOWS}
 var Handle: THandle; FindData: TWin32FindData; LocalFileTime: TFileTime; begin Handle := FindFirstFile(PChar(FileName), FindData); if Handle <> INVALID_HANDLE_VALUE then begin     Windows.FindClose(Handle);     if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)
 = 0 then     begin       FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);       if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi,         LongRec(Result).Lo) then Exit;     end; end; Result := -1; end; {$ENDIF} {$IFDEF LINUX} var
 st: TStatBuf; begin if stat(PChar(FileName), st) = 0 then     Result := st.st_mtime else     Result := -1; end; {$ENDIF}

//读取与设置文件属性 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;

===================

function FileGetAttr(const FileName: string): Integer;
begin
Result := GetFileAttributes(PChar(FileName));
end;

function FileSetAttr(const FileName: string; Attr: Integer): Integer;
begin
Result := 0;
if not SetFileAttributes(PChar(FileName), Attr) then
Result := GetLastError;
end;
{$ENDIF}

 //获取磁盘空间 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 GBr := DiskFree(3); //获取C:可用空间
r := r/1024/1024/1024;
Str(r:0:2,s);
s := 'C盘可用空间是: ' + s + ' GB';
ShowMessage(s); //xx.xx GB
end;
=====================
function DiskSize(Drive: Byte): Int64;
var
FreeSpace: Int64;
begin
if not InternalGetDiskSpace(Drive, Result, FreeSpace) then
      Result := -1;
end;
{$ENDIF}
function DiskFree(Drive: Byte): Int64;
var
TotalSpace: Int64;
begin
if not InternalGetDiskSpace(Drive, TotalSpace, Result) then
      Result := -1;
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;

=================
function FileSearch(const Name, DirList: string): string;
var
I, P, L: Integer;
C: Char;
begin
Result := Name;
P := 1;
L := Length(DirList);
while True do
begin
      if FileExists(Result) then Exit;
      while (P <= L) and (DirList[P] = PathSep) do Inc(P);
      if P > L then Break;
      I := P;
      while (P <= L) and (DirList[P] <> PathSep) do
      begin
        if DirList[P] in LeadBytes then
          P := NextCharIndex(DirList, P)
        else
          Inc(P);
      end;
      Result := Copy(DirList, I, P - I);
      C := AnsiLastChar(Result)^;
      if (C <> DriveDelim) and (C <> PathDelim) then
        Result := Result + PathDelim;
      Result := Result + Name;
end;
Result := '';
end;

 //获取当前文件的版本号 GetFileVersion
var
s: string;
i: Integer;
begin
s := 'C:\WINDOWS\notepad.exe';
i := GetFileVersion(s); //如果没有版本号返回 -1
ShowMessage(IntToStr(i)); //327681 这是当前记事本的版本号(还应该再转换一下)
end;===============
function GetFileVersion(const AFileName: string): Cardinal;
var
FileName: string;
InfoSize, Wnd: DWORD;
VerBuf: Pointer;
FI: PVSFixedFileInfo;
VerSize: DWORD;
begin
Result := Cardinal(-1);
// GetFileVersionInfo modifies the filename parameter data while parsing.
// Copy the string const into a local variable to create a writeable copy.
FileName := AFileName;
UniqueString(FileName);
InfoSize := GetFileVersionInfoSize(PChar(FileName), Wnd);
if InfoSize <> 0 then
begin
      GetMem(VerBuf, InfoSize);
      try
        if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then
          if VerQueryValue(VerBuf, '\', Pointer(FI), VerSize) then
            Result:= FI.dwFileVersionMS;
      finally
        FreeMem(VerBuf);
      end;
end;
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;

//ChangeFileExt 更改文件的后缀扩展名

函数说明更改指定文件的扩展名,函数原型如下:
delphi中源码
function ChangeFileExt(const FileName, Extension: string): string;
//第一个参数为要修改的文件名，可以带路径
//第二个参数为修改后的后缀名
//该函数返回修改后的文件名
var
I: Integer;
begin
I := LastDelimiter('.' + PathDelim + DriveDelim,Filename);
if (I = 0) or (FileName[I] <> '.') then I := MaxInt;
Result := Copy(FileName, 1, I - 1) + Extension;
end;

比如:
s:=changefileext('f:\123.txt','.ini');
showmessage(s);//f:\123.ini

=============

function ChangeFileExt(const FileName, Extension: string): string;
var
I: Integer;
begin
I := LastDelimiter('.' + PathDelim + DriveDelim,Filename);
if (I = 0) or (FileName[I] <> '.') then I := MaxInt;
Result := Copy(FileName, 1, I - 1) + Extension;
end;

百炼成钢百忍成佛

关注

0
点赞
踩
2

收藏

觉得还不错? 一键收藏
0
评论
delphi文件管理类函数

//判断文件是否存在 FileExistsvarf: string;beginf := 'c:\temp\test.txt';if not FileExists(f) thenbegin //如果文件不存在end;end;//判断文件夹是否存在 DirectoryExistsvardir: string;begind
复制链接

扫一扫