:: MVP ::
|
|
:: RSS ::
|
|
|
Как получить список файлов в каталоге?
// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
var
isFound: Boolean;
sRec: TSearchRec;
begin
isFound := FindFirst('c:\*.*', faAnyFile, sRec) = 0;
while isFound do
begin
if (sRec.Name <> '.') and
(sRec.Name <> '..') and
((sRec.Attr and faDirectory) <> faDirectory) then
ShowMessage(sRec.Name);
isFound := FindNext(sRec) = 0;
end;
end;
// Способ второй
uses
System.IOUtils;
procedure TForm1.Button1Click(Sender: TObject);
var
FileName: string;
begin
for FileName in TDirectory.GetFiles('c:\') do
ShowMessage(ExtractFileName(FileName));
end;
|
Как прочитать владельца файла (NTFS)?
function GetFileOwner( FileName: string; var Domain, Username: string ): boolean;
var
SecDescr: PSecurityDescriptor;
SizeNeeded, SizeNeeded2: DWORD;
OwnerSID: PSID;
OwnerDefault: BOOL;
OwnerName, DomainName: PChar;
OwnerType: SID_NAME_USE;
begin
Result := false;
GetMem( SecDescr, 1024 );
GetMem( OwnerSID, SizeOf( PSID ) );
GetMem( OwnerName, 1024 );
GetMem( DomainName, 1024 );
try
if not GetFileSecurity( PChar( FileName ),
OWNER_SECURITY_INFORMATION,
SecDescr, 1024, SizeNeeded ) then
Exit;
if not GetSecurityDescriptorOwner( SecDescr, OwnerSID, OwnerDefault) then
Exit;
SizeNeeded := 1024;
SizeNeeded2 := 1024;
if not LookupAccountSID( nil, OwnerSID, OwnerName,
SizeNeeded, DomainName, SizeNeeded2, OwnerType ) then
Exit;
Domain := DomainName;
Username := OwnerName;
finally
FreeMem( SecDescr );
FreeMem( OwnerName );
FreeMem( DomainName );
end;
Result := true;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Domain, Username: string;
begin
GetFileOwner( 'C:\имя.файла', Domain, Username );
ShowMessage( Username + '@' + Domain );
end;
|
Как определить, является ли диск NTFS?
uses
{...,} ComObj;
function IsNTFS( AFileName: string ): boolean;
var
fso, drv: OleVariant;
begin
IsNTFS := False;
fso := CreateOleObject( 'Scripting.FileSystemObject' );
drv := fso.GetDrive( fso.GetDriveName( AFileName ) );
IsNTFS := drv.FileSystem = 'NTFS'
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if IsNTFS( 'C:\' ) then
ShowMessage( 'Диск с файловой системой NTFS' )
else
ShowMessage( 'Диск не с файловой системой NTFS' );
end;
|
Как узнать количество иконок в файле (*.exe, *.dll)?
procedure TForm1.FormCreate(Sender: TObject);
const
//path = 'calc.exe';
//path = 'notepad.exe';
//path = 'mspaint.exe';
path = 'shell32.dll';
var
hi: HICON;
i: integer;
begin
i := 0;
hi := ExtractIcon( HInstance, path, 0 );
while ( hi > 0 ) do
begin
Inc( i );
hi := ExtractIcon( HInstance, path, i );
end;
Caption := IntToStr( i );
end;
|
Как проверить, пуста директория, или нет?
function DirectoryIsEmpty( Directory: string ): boolean;
var
sr: TSearchRec;
i: Integer;
begin
Result := false;
FindFirst( IncludeTrailingPathDelimiter( Directory ) + '*', faAnyFile, sr );
for i := 1 to 2 do
if ( sr.Name = '.' ) or ( sr.Name = '..' ) then
Result := FindNext( sr ) <> 0;
FindClose( sr );
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if DirectoryIsEmpty( 'C:\test' ) then
Caption := 'Пустая директория'
else
Caption := 'В директории есть файлы';
end;
|
Как определить тип файла (как в диалоге "Свойства файла")?
uses
{...,} ShellAPI;
function MrsGetFileType( const strFilename: string ): string;
var
FileInfo: TSHFileInfo;
begin
FillChar( FileInfo, SizeOf( FileInfo), #0 );
SHGetFileInfo( PChar( strFilename), 0, FileInfo, SizeOf( FileInfo ), SHGFI_TYPENAME );
Result := FileInfo.szTypeName;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := MrsGetFileType( 'c:\autoexec.bat' );
end;
|
Как заменить текст в текстовом файле?
procedure FileReplaceString( const FileName, SearchString, ReplaceString: string );
var
fs: TFileStream;
s: string;
begin
fs := TFileStream.Create( FileName, fmOpenread or fmShareDenyNone );
try
SetLength( s, fs.Size );
fs.ReadBuffer( s[1], fs.Size );
finally
fs.Free;
end;
s := StringReplace( s, SearchString, replaceString, [rfReplaceAll, rfIgnoreCase] );
fs := TFileStream.Create( FileName, fmCreate );
try
fs.WriteBuffer( s[1], Length( S ) );
finally
fs.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FileReplaceString( 'c:\test.txt', 'OldText', 'NewText' );
end;
|
Как удалить символ '\' из конца пути?
var
Form1: TForm1;
Path: string = 'C:\Winnt\';
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage( ExcludeTrailingBackslash( Path ) );
end;
|
Как скопировать файлы в буфер обмена?
uses
{...,} ShlObj, ClipBrd;
procedure CopyFilesToClipboard( FileList: string );
var
DropFiles: PDropFiles;
hGlobal: THandle;
iLen: Integer;
begin
iLen := Length( FileList ) + 2;
FileList := FileList + #0#0;
hGlobal := GlobalAlloc( GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT, SizeOf( TDropFiles ) + iLen );
if ( hGlobal = 0 ) then raise Exception.Create( 'Could not allocate memory.' );
begin
DropFiles := GlobalLock( hGlobal );
DropFiles^.pFiles := SizeOf( TDropFiles );
Move( FileList[1], ( PChar( DropFiles ) + SizeOf( TDropFiles ) )^, iLen );
GlobalUnlock( hGlobal);
Clipboard.SetAsHandle( CF_HDROP, hGlobal );
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CopyFilesToClipboard( 'C:\boot.ini'#0'C:\autoexec.bat' );
end;
// Файлы должны разделяться про помощи #0
|
Как определить время последнего изменения файла?
// Способ первый
function GetFileModifyDate( FileName: string ): TDateTime;
var
h: THandle;
Struct: TOFSTRUCT;
LastWrite: Integer;
begin
// h := OpenFile( PChar( FileName ), Struct, OF_SHARE_DENY_NONE );
h := CreateFile( PChar( FileName ), GENERIC_READ, FILE_SHARE_READ, nil,
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0 );
try
if h <> HFILE_ERROR then
begin
LastWrite := FileGetDate( h );
Result := FileDateToDateTime( lastwrite );
end;
finally
CloseHandle( h );
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := FormatDateTime( 'dddd, d. mmmm yyyy hh:mm:ss',
GetFileModifyDate( 'c:\Dir1\1.txt' ) );
end;
// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(DateToStr(FileDateToDateTime(FileAge('c:\pagefile.sys'))));
end;
|
При использовании материала - ссылка на сайт обязательна
|
|