常用文件目录操作
【打印文章】
1-得到短文件名
function GetShortFileName(const FileName : string) : string;
var
aTmp: array[0..255] of char;
begin
if GetShortPathName(PChar(FileName),aTmp,Sizeof(aTmp)-1)=0 then
Result:= FileName
else
Result:=StrPas(aTmp);
end;
2-长文件名
function GetLongFileName(const FileName : string) : string;
var
aInfo: TSHFileInfo;
begin
if SHGetFileInfo(PChar(FileName),0,aInfo,Sizeof(aInfo),SHGFI_DISPLAYNAME)<>0 then
Result:= string(aInfo.szDisplayName)
else
Result:= FileName;
end;
删除到回收站
uses ShellAPI;
procedure SendToRecycleBin(FileName: string);
var
SHF: TSHFileOpStruct;
begin
with SHF do begin
Wnd := Application.Handle;
wFunc := FO_DELETE;
pFrom := PChar(FileName);
fFlags := FOF_SILENT or FOF_ALLOWUNDO;
end;
SHFileOperation(SHF);
end;
得到文件最后改动时间
procedure TForm1.Button1Click(Sender: TObject);
var
FileHandle : THandle;
LocalFileTime : TFileTime;
DosFileTime : DWORD;
LastAccessedTime : TDateTime;
FindData : TWin32FindData;
begin
FileHandle := FindFirstFile('AnyFile.FIL', FindData);
if FileHandle <> INVALID_HANDLE_VALUE then
begin
Windows.FindClose(Handle);
if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
begin
FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
FileTimeToDosDateTime(LocalFileTime,
LongRec(DosFileTime).Hi,LongRec(DosFileTime).Lo);
LastAccessedTime := FileDateToDateTime(DosFileTime);
Label1.Caption := DateTimeToStr(LastAccessedTime);
end;
end;
end;
得到目录大小
function TFileBrowser.DirSize(Dir:string):integer;
var
SearchRec : TSearchRec;
Separator : string;
begin
if Copy(Dir,Length(Dir),1)='\' then
Separator := ''
else
Separator := '\';
if FindFirst(Dir+Separator+'*.*',faAnyFile,SearchRec) = 0 then
begin
if FileExists(Dir+Separator+SearchRec.name) then
begin
DirBytes := DirBytes + SearchRec.Size;
{Memo1.Lines.Add(Dir+Separator+SearchRec.Name);}
end
else
if DirectoryExists(Dir+Separator+SearchRec.name) then
begin
if (SearchRec.name<>'.') and (SearchRec.name<>'..') then
DirSize(Dir+Separator+SearchRec.name);
end;
end;
while FindNext(SearchRec) = 0 do
begin
if FileExists(Dir+Separator+SearchRec.name) then
begin
DirBytes := DirBytes + SearchRec.Size;
{Memo1.Lines.Add(Dir+Separator+SearchRec.Name);}
end
else
if DirectoryExists(Dir+Separator+SearchRec.name) then
begin
if (SearchRec.name<>'.') and (SearchRec.name<>'..') then
DirSize(Dir+Separator+SearchRec.name);
end;
end;
end;
end;
FindClose(SearchRec);
end;
扫描驱动器
private
{ Private declarations }
FScanAborted: Boolean;
public
{ Public declarations }
function ScanDrive( root, filemask: string; hitlist: TStrings ): Boolean;
function TForm1.ScanDrive( root, filemask: string; hitlist: TStrings ):
Boolean;
function ScanDirectory( var path: string ): Boolean;
var
SRec: TSearchRec;
pathlen: Integer;
res: Integer;
begin
label1.caption := path;
pathlen:= Length(path);
{ first pass, files }
res := FindFirst( path+filemask, faAnyfile, SRec );
if res = 0 then
try
while res = 0 do begin
hitlist.Add( path + SRec.name );
res := FindNext(SRec);
end;
finally
FindClose(SRec)
end;
Application.ProcessMessages;
Result := not (FScanAborted or Application.Terminated);
if not Result then Exit;
{second pass, directories}
res := FindFirst( path+'*.*', faDirectory, SRec );
if res = 0 then
try
while (res = 0) and Result do begin
if ((Srec.Attr and faDirectory) = faDirectory) and
(Srec.name[1] <> '.')
then begin
path := path + SRec.name + '\';
Result := ScanDirectory( path );
SetLength( path, pathlen );
end;
res := FindNext(SRec);
end;
finally
FindClose(SRec)
end;
end;
begin
FScanAborted := False;
Screen.Cursor := crHourglass;
try
Result := ScanDirectory(root);
finally
Screen.Cursor := crDefault
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
ch: Char;
root: string;
begin
root := 'C:\';
for ch := 'A' to 'Z' do begin
root[1] := ch;
case GetDriveType( Pchar( root )) of
DRIVE_FIXED, DRIVE_REMOTE:
if not ScanDrive( root, edit1.text, listbox1.items ) then
Break;
end;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin // aborts scan
fScanAborted := True;
end;
改目录名
var
OldName,NewName : string;
.
.
OldName := 'C:\UTILITIES';
NewName := 'C:\UTILS';
if MoveFile(PChar(OldName), PChar(NewName)) then
ShowMessage('Directory renamed!')
else ShowMessage('Failure
renaming directory!');
.
.
end.
临时文件
function DGetTempFileName (const Folder, Prefix : string; const Unique: UINT) : string;
var
FileName : array[0..MAX_PATH] of Char;
begin
if GetTempFileName (PChar (Folder), PChar (Prefix), Unique, FileName) = 0 then
raise Exception.Create ('GetTempFileName error');
Result := FileName;
end;
function GetShortFileName(const FileName : string) : string;
var
aTmp: array[0..255] of char;
begin
if GetShortPathName(PChar(FileName),aTmp,Sizeof(aTmp)-1)=0 then
Result:= FileName
else
Result:=StrPas(aTmp);
end;
2-长文件名
function GetLongFileName(const FileName : string) : string;
var
aInfo: TSHFileInfo;
begin
if SHGetFileInfo(PChar(FileName),0,aInfo,Sizeof(aInfo),SHGFI_DISPLAYNAME)<>0 then
Result:= string(aInfo.szDisplayName)
else
Result:= FileName;
end;
删除到回收站
uses ShellAPI;
procedure SendToRecycleBin(FileName: string);
var
SHF: TSHFileOpStruct;
begin
with SHF do begin
Wnd := Application.Handle;
wFunc := FO_DELETE;
pFrom := PChar(FileName);
fFlags := FOF_SILENT or FOF_ALLOWUNDO;
end;
SHFileOperation(SHF);
end;
得到文件最后改动时间
procedure TForm1.Button1Click(Sender: TObject);
var
FileHandle : THandle;
LocalFileTime : TFileTime;
DosFileTime : DWORD;
LastAccessedTime : TDateTime;
FindData : TWin32FindData;
begin
FileHandle := FindFirstFile('AnyFile.FIL', FindData);
if FileHandle <> INVALID_HANDLE_VALUE then
begin
Windows.FindClose(Handle);
if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
begin
FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
FileTimeToDosDateTime(LocalFileTime,
LongRec(DosFileTime).Hi,LongRec(DosFileTime).Lo);
LastAccessedTime := FileDateToDateTime(DosFileTime);
Label1.Caption := DateTimeToStr(LastAccessedTime);
end;
end;
end;
得到目录大小
function TFileBrowser.DirSize(Dir:string):integer;
var
SearchRec : TSearchRec;
Separator : string;
begin
if Copy(Dir,Length(Dir),1)='\' then
Separator := ''
else
Separator := '\';
if FindFirst(Dir+Separator+'*.*',faAnyFile,SearchRec) = 0 then
begin
if FileExists(Dir+Separator+SearchRec.name) then
begin
DirBytes := DirBytes + SearchRec.Size;
{Memo1.Lines.Add(Dir+Separator+SearchRec.Name);}
end
else
if DirectoryExists(Dir+Separator+SearchRec.name) then
begin
if (SearchRec.name<>'.') and (SearchRec.name<>'..') then
DirSize(Dir+Separator+SearchRec.name);
end;
end;
while FindNext(SearchRec) = 0 do
begin
if FileExists(Dir+Separator+SearchRec.name) then
begin
DirBytes := DirBytes + SearchRec.Size;
{Memo1.Lines.Add(Dir+Separator+SearchRec.Name);}
end
else
if DirectoryExists(Dir+Separator+SearchRec.name) then
begin
if (SearchRec.name<>'.') and (SearchRec.name<>'..') then
DirSize(Dir+Separator+SearchRec.name);
end;
end;
end;
end;
FindClose(SearchRec);
end;
扫描驱动器
private
{ Private declarations }
FScanAborted: Boolean;
public
{ Public declarations }
function ScanDrive( root, filemask: string; hitlist: TStrings ): Boolean;
function TForm1.ScanDrive( root, filemask: string; hitlist: TStrings ):
Boolean;
function ScanDirectory( var path: string ): Boolean;
var
SRec: TSearchRec;
pathlen: Integer;
res: Integer;
begin
label1.caption := path;
pathlen:= Length(path);
{ first pass, files }
res := FindFirst( path+filemask, faAnyfile, SRec );
if res = 0 then
try
while res = 0 do begin
hitlist.Add( path + SRec.name );
res := FindNext(SRec);
end;
finally
FindClose(SRec)
end;
Application.ProcessMessages;
Result := not (FScanAborted or Application.Terminated);
if not Result then Exit;
{second pass, directories}
res := FindFirst( path+'*.*', faDirectory, SRec );
if res = 0 then
try
while (res = 0) and Result do begin
if ((Srec.Attr and faDirectory) = faDirectory) and
(Srec.name[1] <> '.')
then begin
path := path + SRec.name + '\';
Result := ScanDirectory( path );
SetLength( path, pathlen );
end;
res := FindNext(SRec);
end;
finally
FindClose(SRec)
end;
end;
begin
FScanAborted := False;
Screen.Cursor := crHourglass;
try
Result := ScanDirectory(root);
finally
Screen.Cursor := crDefault
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
ch: Char;
root: string;
begin
root := 'C:\';
for ch := 'A' to 'Z' do begin
root[1] := ch;
case GetDriveType( Pchar( root )) of
DRIVE_FIXED, DRIVE_REMOTE:
if not ScanDrive( root, edit1.text, listbox1.items ) then
Break;
end;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin // aborts scan
fScanAborted := True;
end;
改目录名
var
OldName,NewName : string;
.
.
OldName := 'C:\UTILITIES';
NewName := 'C:\UTILS';
if MoveFile(PChar(OldName), PChar(NewName)) then
ShowMessage('Directory renamed!')
else ShowMessage('Failure
renaming directory!');
.
.
end.
临时文件
function DGetTempFileName (const Folder, Prefix : string; const Unique: UINT) : string;
var
FileName : array[0..MAX_PATH] of Char;
begin
if GetTempFileName (PChar (Folder), PChar (Prefix), Unique, FileName) = 0 then
raise Exception.Create ('GetTempFileName error');
Result := FileName;
end;
本栏文章均来自于互联网,版权归原作者和各发布网站所有,本站收集这些文章仅供学习参考之用。任何人都不能将这些文章用于商业或者其他目的。( Pfan.cn )
【编程爱好者论坛】