:: 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.');
DropFiles := GlobalLock(hGlobal);
DropFiles^.pFiles := SizeOf(TDropFiles);
Move(FileList[1], (PChar(DropFiles) + SizeOf(TDropFiles))^, iLen);
GlobalUnlock(hGlobal);
Clipboard.SetAsHandle(CF_HDROP, hGlobal);
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;
|
При использовании материала - ссылка на сайт обязательна
|
|