Как определить, является ли диск NTFS

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: http://www.swissdelphicenter.ch

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(‘X:\Temp\File.doc’) then

ShowMessage(‘File is on NTFS File System’)

else

ShowMessage(‘File is not on NTFS File System’)

end;

{/codecitation}

Как определить, какие диски находятся на компьютере

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

— Чем отличается джентльмен от джентльмена программиста?

— Джентльмен всегда носит с собой презерватив, на всякий случай, а джентльмен программист — системную дискету.

function DriveExists(Drive:Byte):Boolean;

var

Drives: set of 0..25;

begin

integer(Drives):=GetLogicalDrives;

Result:=Drive in Drives

end;

function CheckDriveType(Drive: Byte): string;

var

DriveLetter: Char;

DriveType: UInt;

begin

DriveLetter:=Chr(Drive $41);

DriveType:=GetDriveType(PChar(DriveLetter ‘:\’));

case DriveType of

0: Result:=’?’;

1: Result:=’Path does not exists’;

DRIVE_REMOVABLE: Result:=’Removable’;

DRIVE_FIXED: Result:=’Fixed’;

DRIVE_REMOTE: Result:=’Remote’;

DRIVE_CDROM: Result:=’CD_ROM’;

DRIVE_RAMDISK: Result:=’RAMDISK’

else

Result:=’Unknown’

end

end;

{/codecitation}

Как определить размер свободного места на диске

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Для получения размера свободного места на дисках, ёмкость которых больше 2Гб, необходимо использовать функцию GetDiskFreeSpaceEx. Ниже приведён небольшой пример использования данной функции:

var

FreeBytesAvailableToCaller: TLargeInteger;

FreeSize: TLargeInteger;

TotalSize: TLargeInteger;

begin

GetDiskFreeSpaceEx(‘c:’,

FreeBytesAvailableToCaller,

Totalsize,

@FreeSize);

end;

Результатом будет значение в байтах.

{/codecitation}

Как вывести сведения о диске (метка тома, серийный номер, файловая система и т.д.)

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Звонок в службу технической поддержки:

— У меня компьютер не работает!

— После чего это произошло?

— Я его включил — загрузился Нортон. Смотрю — у меня слева диск С: и справа диск С:. Я подумал — нафиг мне два диска С:? И стер правый к чертовой матери.

procedure TForm1.Button2Click(Sender: TObject);

var

VolumeName,

FileSystemName : array [0..MAX_PATH-1] of Char;

VolumeSerialNo : DWord;

MaxComponentLength,FileSystemFlags: Cardinal;

begin

GetVolumeInformation(‘C:\’,VolumeName,MAX_PATH,@VolumeSerialNo,

MaxComponentLength,FileSystemFlags, FileSystemName,MAX_PATH);

Memo1.Lines.Add(‘VolumeName = ‘ VolumeName);

Memo1.Lines.Add(‘SerialNo = $’ IntToHex(VolumeSerialNo,8));

Memo1.Lines.Add(‘CompLen = ‘ IntToStr(MaxComponentLength));

Memo1.Lines.Add(‘Flags = $’ IntToHex(FileSystemFlags,4));

Memo1.Lines.Add(‘FSName = ‘ FileSystemName);

end;

{/codecitation}

Cуществует ли диск в системе

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Serious

WEB-сайт: http://forum.vingrad.ru

function DriveExists(Drive: Byte): boolean;

begin

Result := Boolean(GetLogicalDrives and (1 shl Drive));

end;

procedure TForm1.Button1Click(Sender: TObject);

var

Drive: byte;

begin

for Drive := 0 to 25 do

if DriveExists(Drive) then

ListBox1.Items.Add(Chr(Drive $41));

end;

{/codecitation}

Узнаём стандартные папки Windows

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Если не можете выйти из виндов, есть запасной выход:» Выдерни шнур, выдави стекло…».

uses Registry;

procedure TForm1.Button1Click(Sender: TObject);

var

reg : TRegistry;

ts : TStrings;

i : integer;

begin

reg := TRegistry.Create;

reg.RootKey := HKEY_CURRENT_USER;

reg.LazyWrite := false;

reg.OpenKey(

‘Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders’,

false);

ts := TStringList.Create;

reg.GetValueNames(ts);

for i := 0 to ts.Count -1 do begin

Memo1.Lines.Add(ts.Strings[i]

‘ = ‘

reg.ReadString(ts.Strings[i]));

end;

ts.Free;

reg.CloseKey;

reg.free;

end;

{/codecitation}

Удалить каталог со всем содержимым 4

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

procedure TForm1.deletedirectory(dir: string);

var

sh: SHFILEOPSTRUCT;

st: string;

sr: tsearchrec;

pst: pchar;

begin

if findfirst(dir, faDirectory, sr) = 0 then

begin

//added by me

dir := longtoshortfilename(dir);

//original code

sh.Wnd := Form1.handle;

sh.wFunc := FO_DELETE;

Pst := StrAlloc(Length(dir {sr.Name}) 1);

StrPLCopy(Pst, dir {sr.Name}, Length(dir {sr.Name}) 1);

sh.pFrom := pst;

sh.pTo := nil;

sh.fFlags := FOF_NOCONFIRMATION or FOF_SILENT;

sh.hNameMappings := nil;

sh.lpszProgressTitle := nil;

SHFileOperation(sh);

StrDispose(Pst);

end;

findclose(sr);

end;

{/codecitation}

Удалить каталог со всем содержимым 3

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Для удаления каталогов существует функция RemoveDirectory. Она удаляет каталог, если он пуст. Поэтому перед удалением каталога его нужно очистить. Для этого здесь используется рекурентная функция RemoveAll.

uses

FileCtrl;

procedure RemoveAll(path: string);

var

sr: TSearchRec;

begin

if FindFirst(path ‘\*.*’, faAnyFile, sr) = 0 then

begin

repeat

if sr.Attr and faDirectory = 0 then

begin

DeleteFile(path ‘\’ sr.name);

end

else

begin

if pos(‘.’, sr.name) <= 0 then

RemoveAll(path ‘\’ sr.name);

end;

until

FindNext(sr) 0;

end;

FindClose(sr);

RemoveDirectory(PChar(path));

end;

procedure TForm1.Button1Click(Sender: TObject);

var

dir: string;

begin

if SelectDirectory(‘Удаление каталога’, », dir) then

RemoveAll(dir);

end;

{/codecitation}

Удалить каталог со всем содержимым 2

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

function MyRemoveDir(sDir : string) : Boolean;

var

iIndex: Integer;

SearchRec: TSearchRec;

sFileName: string;

begin

Result := False;

sDir := sDir ‘\*.*’;

iIndex := FindFirst(sDir, faAnyFile, SearchRec);

while iIndex = 0 do

begin

sFileName := ExtractFileDir(sDir) ‘\’ SearchRec.name;

if SearchRec.Attr = faDirectory then

begin

if (SearchRec.name » ) and (SearchRec.name ‘.’) and

(SearchRec.name ‘..’) then

MyRemoveDir(sFileName);

end

else

begin

if SearchRec.Attr faArchive then

FileSetAttr(sFileName, faArchive);

if not DeleteFile(sFileName) then

ShowMessage(‘Could NOT delete ‘ sFileName);

end;

iIndex := FindNext(SearchRec);

end;

FindClose(SearchRec);

RemoveDir(ExtractFileDir(sDir));

Result := True;

end;

// ***************************** //

// Пример: //

// ***************************** //

if not MyRemoveDir(‘D:\myDir’) then

ShowMessage(‘Can NOT delete dir’);

// Кстати, системные, скрытые и

// read-only файлы тоже будут удалены.

{/codecitation}

Удалить каталог со всем содержимым

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

function DeleteDir(Dir: string): boolean;

var

Found: integer;

SearchRec: TSearchRec;

begin

result := false;

if IOResult 0 then

ChDir(Dir);

if IOResult 0 then

begin

ShowMessage(‘Не могу войти в каталог: ‘ Dir);

exit;

end;

Found := FindFirst(‘*.*’, faAnyFile, SearchRec);

while Found = 0 do

begin

if (SearchRec.name ‘.’) and (SearchRec.name ‘..’) then

if (SearchRec.Attr and faDirectory) 0 then

begin

if not DeleteDir(SearchRec.name) then

exit;

end

else

if not DeleteFile(SearchRec.name) then

begin

ShowMessage(‘Не могу удалить файл: ‘ SearchRec.name);

exit;

end;

Found := FindNext(SearchRec);

end;

FindClose(SearchRec);

ChDir(‘..’);

RmDir(Dir);

result := IOResult = 0;

end;

{/codecitation}