Как удалить файлы из корзины

program del;

uses

ShellApi;

//function SHFileOperation(const lpFileOp: TSHFileOpStruct): Integer; stdcall;

var

T: TSHFileOpStruct;

P: string;

begin

P := 'C:\Windows\System\EL_CONTROL.CPL';

with T do

begin

Wnd := 0;

wFunc := FO_DELETE;

pFrom := Pchar(P);

fFlags := FOF_ALLOWUNDO

end;

SHFileOperation(T);

end.

Восстановление

Есть некоторые причуды, и Вы должны помнить о следующем:

Дайте полный путь для каждого файла. Не доверяйте текущей директории, даже если Вы ее изменили непосредственно перед вызовом функции. Функция WinAPI SHFileOperation не достаточно «умная» для использования текущей директории при отсутствии информации о предыдущей директории (для осуществления функции восстановления). Так, даже если используете флаг FOF_ALLOWUNDO, это не восстановит удаленные файлы из корзины, поскольку функция ничего не знает о предыдущем месторасположении файлов, и, таким образом, не сможет их восстановить файлы из корзины в их оригинальное месторасположение. Она просто удалит файлы из текущей директории.

Microsoft скорректировала документацию о члене pFrom. Новая редакция сообщает о подробностях работы в пакетном режиме: необходимо разделить имя каждого файла символом NULL (#0) и добавить к концу списка двойной символ NULL. Терминатор из двух символов NULL необходим в любом случае: работаете вы с одним файлом, или же используете пакетный режим. Иногда это работает и без терминатора, но чаще нет. Это связано с тем, что функции при работе с памятью считывает данные из памяти, располагающейся до терминатора, а поскольку длина строки может не совпадать с распределенной памятью, то данные, находящиеся после терминатора, просто не обрабатываются.

Пример правильного кодирования:

var

FileList: string;

FOS: TShFileOpStruct;

begin

FileList := 'c:\delete.me'#0'c:\windows\temp.$$$'#0#0;

{ если Вы используете имена файлов в строковых переменных: }

FileList := Filename1 #0 Filename2 #0#0;

FOS.pFrom := PChar(FileList);

end;

Управление метками томов дисков

Данный совет содержит исходный код модуля, который может помочь Вам получить, установить и удалить метку тома гибкого или жесткого диска. Код получения метки тома содержит функцию Delphi FindFirst, код для установки и удаления метки тома использует вызов DOS-прерывания 21h и функции 16h и 13h соответственно. Поскольку функция 16h не поддерживается Windows, она должна вызываться через DPMI-прерывание 31h, функцию 300h.

{ *** НАЧАЛО КОДА МОДУЛЯ VOLLABEL *** }

unit VolLabel;

interface

uses Classes, SysUtils, WinProcs;

type

EInterruptError = class(Exception);

EDPMIError = class(EInterruptError);

Str11 = string[11];

procedure SetVolumeLabel(NewLabel: Str11; Drive: Char);

function GetVolumeLabel(Drive: Char): Str11;

procedure DeleteVolumeLabel(Drv: Char);

implementation

type

PRealModeRegs = ^TRealModeRegs;

TRealModeRegs = record

case Integer of

0: (

EDI, ESI, EBP, EXX, EBX, EDX, ECX, EAX: Longint;

Flags, ES, DS, FS, GS, IP, CS, SP, SS: Word);

1: (

DI, DIH, SI, SIH, BP, BPH, XX, XXH: Word;

case Integer of

0: (

BX, BXH, DX, DXH, CX, CXH, AX, AXH: Word);

1: (

BL, BH, BLH, BHH, DL, DH, DLH, DHH,

CL, CH, CLH, CHH, AL, AH, ALH, AHH: Byte));

end;

PExtendedFCB = ^TExtendedFCB;

TExtendedFCB = record

ExtendedFCBflag: Byte;

Reserved1: array[1..5] of Byte;

Attr: Byte;

DriveID: Byte;

FileName: array[1..8] of Char;

FileExt: array[1..3] of Char;

CurrentBlockNum: Word;

RecordSize: Word;

FileSize: LongInt;

PackedDate: Word;

PackedTime: Word;

Reserved2: array[1..8] of Byte;

CurrentRecNum: Byte;

RandomRecNum: LongInt;

end;

procedure RealModeInt(Int: Byte; var Regs: TRealModeRegs);

{ процедура работает с прерыванием 31h, функцией 0300h для иммитации }

{ прерывания режима реального времени для защищенного режима. }

var

ErrorFlag: Boolean;

begin

asm

mov ErrorFlag, 0 { успешное завершение }

mov ax, 0300h { функция 300h }

mov bl, Int { прерывание режима реального времени, которое необходимо выполнить }

mov bh, 0 { требуется }

mov cx, 0 { помещаем слово в стек для копирования, принимаем ноль }

les di, Regs { es:di = Regs }

int 31h { DPMI-прерывание 31h }

jnc @@End { адрес перехода установлен в error }

@@Error:

mov ErrorFlag, 1 { возвращаем false в error }

@@End:

end;

if ErrorFlag then

raise EDPMIError.Create('Неудача при выполнении DPMI-прерывания');

end;

function DriveLetterToNumber(DriveLet: Char): Byte;

{ функция преобразования символа буквы диска в цифровой эквивалент. }

begin

if DriveLet in ['a'..'z'] then

DriveLet := Chr(Ord(DriveLet) - 32);

if not (DriveLet in ['A'..'Z']) then

raise

EConvertError.CreateFmt('Не могу преобразовать %s в числовой эквивалент диска',

[DriveLet]);

Result := Ord(DriveLet) - 64;

end;

procedure PadVolumeLabel(var Name: Str11);

{ процедура заполнения метки тома диска строкой с пробелами }

var

i: integer;

begin

for i := Length(Name) 1 to 11 do

Name := Name ' ';

end;

function GetVolumeLabel(Drive: Char): Str11;

{ функция возвращает метку тома диска }

var

SR: TSearchRec;

DriveLetter: Char;

SearchString: string[7];

P: Byte;

begin

SearchString := Drive ':\*.*';

{ ищем метку тома }

if FindFirst(SearchString, faVolumeID, SR) = 0 then

begin

P := Pos('.', SR.Name);

if P > 0 then

begin { если у него есть точка... }

Result := ' '; { пространство между именами }

Move(SR.Name[1], Result[1], P - 1); { и расширениями }

Move(SR.Name[P 1], Result[9], 3);

end

else

begin

Result := SR.Name; { в противном случае обходимся без пробелов }

PadVolumeLabel(Result);

end;

end

else

Result := '';

end;

procedure DeleteVolumeLabel(Drv: Char);

{ процедура удаления метки тома с данного диска }

var

CurName: Str11;

FCB: TExtendedFCB;

ErrorFlag: WordBool;

begin

ErrorFlag := False;

CurName := GetVolumeLabel(Drv); { получение текущей метки тома }

FillChar(FCB, SizeOf(FCB), 0); { инициализируем FCB нулями }

with FCB do

begin

ExtendedFCBflag := $FF; { всегда }

Attr := faVolumeID; { Аттрибут Volume ID }

DriveID := DriveLetterToNumber(Drv); { Номер диска }

Move(CurName[1], FileName, 8); { необходимо ввести метку тома }

Move(CurName[9], FileExt, 3);

end;

asm

push ds { сохраняем ds }

mov ax, ss { помещаем сегмент FCB (ss) в ds }

mov ds, ax

lea dx, FCB { помещаем смещение FCB в dx }

mov ax, 1300h { функция 13h }

Call DOS3Call { вызываем int 21h }

pop ds { восстанавливаем ds }

cmp al, 00h { проверка на успешность выполнения }

je @@End

@@Error: { устанавливаем флаг ошибки }

mov ErrorFlag, 1

@@End:

end;

if ErrorFlag then

raise EInterruptError.Create('Не могу удалить имя тома');

end;

procedure SetVolumeLabel(NewLabel: Str11; Drive: Char);

{ процедура присваивания метки тома диска. Имейте в виду, что }

{ данная процедура удаляет текущую метку перед установкой новой. }

{ Это необходимое требование для функции установки метки. }

var

Regs: TRealModeRegs;

FCB: PExtendedFCB;

Buf: Longint;

begin

PadVolumeLabel(NewLabel);

if GetVolumeLabel(Drive) '' then { если имеем метку... }

DeleteVolumeLabel(Drive); { удаляем метку }

Buf := GlobalDOSAlloc(SizeOf(PExtendedFCB)); { распределяем реальный буфер }

FCB := Ptr(LoWord(Buf), 0);

FillChar(FCB^, SizeOf(FCB), 0); { инициализируем FCB нулями }

with FCB^ do

begin

ExtendedFCBflag := $FF; { требуется }

Attr := faVolumeID; { Аттрибут Volume ID }

DriveID := DriveLetterToNumber(Drive); { Номер диска }

Move(NewLabel[1], FileName, 8); { устанавливаем новую метку }

Move(NewLabel[9], FileExt, 3);

end;

FillChar(Regs, SizeOf(Regs), 0);

with Regs do

begin { Сегмент FCB }

ds := HiWord(Buf); { отступ = ноль }

dx := 0;

ax := $1600; { Функция 16h }

end;

RealModeInt($21, Regs); { создаем файл }

if (Regs.al 0) then { проверка на успешность выполнения }

raise EInterruptError.Create('Не могу создать метку тома');

end;

end.

{ *** КОНЕЦ КОДА МОДУЛЯ VOLLABEL *** }

Серийный номер тома HDD

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

Автор: Алексей Коган

И ты, root?

procedure TForm1.Button1Click(Sender: TObject);

var

SerialNum : dword;

a, b : dword;

Buffer : array [0..255] of char;

begin

if GetVolumeInformation(‘c:\’, Buffer, SizeOf(Buffer),

@SerialNum, a, b, nil, 0) then

Label1.Caption := IntToStr(SerialNum);

end;

Алексей Коган

FIDOnet 2:5064/7.69

Russia, Stavropol

Должен заметить, что GetVolumeInformation возвращает серийный номер ТОМА, а не винчестера, то есть, если заменить C:\ на D:\, то номерок-то и поменяется…

{/codecitation}

Простейший сканер диска

Вот пример, который ищет мп3 файлы на жестком диске…

unit Audit1;

interface

uses windos;

var

dest: string;

procedure dorecurse(dir: string);

implementation

{$R *.DFM}

procedure Process(dir: string; Searchrec: tsearchrec);

begin

showmessage(Searchrec.name);

case Searchrec.attr of

$10:

if (searchrec.name '.') and (searchrec.name '..') then

begin

dorecurse(dir '\' searchrec.name);

writeln(dir);

end;

end;

end;

procedure Dorecurse(dir: string);

var

Searchrec: Tsearchrec;

pc: array[0..79] of Char;

begin

StrPCopy(pc, dir '\*.mp3');

FindFirst(pc, FaAnyfile, SearchRec);

Process(dir, SearchRec);

while FindNext(SearchRec) -18 do

begin

Process(dir, SearchRec);

end;

end;

procedure startsearch;

begin

dorecurse(paramstr(1));

end;

begin

startsearch;

end.

Получить серийный номер диска

function GetHardDiskSerial(const DriveLetter: Char): string;

var

NotUsed: DWORD;

VolumeFlags: DWORD;

VolumeInfo: array[0..MAX_PATH] of Char;

VolumeSerialNumber: DWORD;

begin

GetVolumeInformation(PChar(DriveLetter ':\'),

nil, SizeOf(VolumeInfo), @VolumeSerialNumber, NotUsed,

VolumeFlags, nil, 0);

Result := Format('Label = %s VolSer = %8.8X',

[VolumeInfo, VolumeSerialNumber])

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(GetHardDiskSerial('c'));

end;

Получить объем диска и его свободного места

{

* Place a Button1 and DriveComboBox1 on your form.

* The function "SetCurrentDir" well be true if the disk in drive

* The procedure "GetDiskFreeSpaceEx" returns the free and total disk size

}


uses

SysUtils;

implementation

function GetDiskSize(drive: Char; var free_size, total_size: Int64): Boolean;

var

RootPath: array[0..4] of Char;

RootPtr: PChar;

current_dir: string;

begin

RootPath[0] := Drive;

RootPath[1] := ':';

RootPath[2] := '\';

RootPath[3] := #0;

RootPtr := RootPath;

current_dir := GetCurrentDir;

if SetCurrentDir(drive ':\') then

begin

GetDiskFreeSpaceEx(RootPtr, Free_size, Total_size, nil);

// this to turn back to original dir

SetCurrentDir(current_dir);

Result := True;

end

else

begin

Result := False;

Free_size := -1;

Total_size := -1;

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

free_size, total_size: Int64;

begin

if GetDiskSize(DriveComboBox1.Drive, free_size, total_size) then

ShowMessage('free space ='

IntToStr(free_size) #13 'total size='

IntToStr(total_size))

else

ShowMessage('No disk in drive!');

end;

Получение информации о диске

function GetVolumeInfoFVS(const Dir:string;

var FileSystemName,VolumeName:string;var Serial:longint):boolean;

{Получение информации о диске

Dir - каталог или буква требуемого диска

FileSystemName - название файловой системы

VolumeName - метка диска

Serial - серийный номер диска

В случае ошибки функция возвращает false}


var

root:pchar;

res:longbool;

VolumeNameBuffer,FileSystemNameBuffer:pchar;

VolumeNameSize,FileSystemNameSize:DWord;

VolumeSerialNumber,MaximumComponentLength,FileSystemFlags:DWORD;

s:string;

n:integer;

begin

n:=pos(':',Dir);

if n> 0 then s:=copy(Dir,1,n 1) else s:=s ':';

if s[length(s)]=':' then s:=s '\';

root:=pchar(s);

getMem(VolumeNameBuffer,256);

getMem(FileSystemNameBuffer,256);

VolumeNameSize:=255;

FileSystemNameSize:=255;

res:=GetVolumeInformation(Root,VolumeNameBuffer,VolumeNameSize

,@VolumeSerialNumber,

MaximumComponentLength, FileSystemFlags

,FileSystemNameBuffer,FileSystemNameSize);

Result:=res;

VolumeName:=VolumeNameBuffer;

FileSystemName:=FileSystemNameBuffer;

Serial:=VolumeSerialNumber;

freeMem(VolumeNameBuffer,256);

freeMem(FileSystemNameBuffer,256);

end;

Получение идентификатора диска

Как получить идентификатор находящегося в CD-ROM’е аудио-компакта?

const

MCI_INFO_PRODUCT = $00000100;

MCI_INFO_FILE = $00000200;

MCI_INFO_MEDIA_UPC = $00000400;

MCI_INFO_MEDIA_IDENTITY = $00000800;

MCI_INFO_NAME = $00001000;

MCI_INFO_COPYRIGHT = $00002000;

{ блок параметров для командного сообщения MCI_INFO }

type

PMCI_Info_ParmsA = ^TMCI_Info_ParmsA;

PMCI_Info_ParmsW = ^TMCI_Info_ParmsW;

PMCI_Info_Parms = PMCI_Info_ParmsA;

TMCI_Info_ParmsA = record

dwCallback: DWORD;

lpstrReturn: PAnsiChar;

dwRetSize: DWORD;

end;

TMCI_Info_ParmsW = record

dwCallback: DWORD;

lpstrReturn: PWideChar;

dwRetSize: DWORD;

end;

TMCI_Info_Parms = TMCI_Info_ParmsA;

Идентификатор возвращается функцией MCI_INFO_MEDIA_IDENTITY в виде строки с десятичным числом. Для получения дополнительной информации обратитесь к электронной справке (Win32 и компонент TMediaPlayer).

Исправления

// метка диска

procedure GetDriveInfo(VolumeName: string;

var VolumeLabel, SerialNumber, FileSystem: string);

var

VolLabel, FileSysName: array[0..255] of char;

SerNum: pdword;

MaxCompLen, FileSysFlags: dword;

begin

New(SerNum);

GetVolumeInformation(PChar(VolumeName), VolLabel,

255, SerNum, MaxCompLen, FileSysFlags, FileSysName, 255);

VolumeLabel := VolLabel;

SerialNumber := Format('%x', [SerNum^]);

FileSystem := FileSysName;

Dispose(SerNum);

end;

// далее

var

VolLabel, SN, FileSystem, S: string;

begin

s := 'g:\'; // имя CD дисковода

GetDriveInfo(S, VolLabel, SN, FileSystem);

получаем:

VolLabel - 'ARMSTRONG' // метка диска

SN - B5FF77AD // номер серийный

FileSystem - CDFS // тип файловой системы

Работает не только для CD для всех типов дисков ... Далее:

// метка диска

procedure GetAllDrive(Sender: TObject);

var

i, mask: integer;

s: string;

begin

mask := GetLogicalDrives;

i := 0;

while mask 0 do

begin

s := chr(ord('a') i) ':\';

if (mask and 1) 0 then

case GetDriveType(PChar(s)) of

0: ListBox1.Items.Add(s ' unknown.');

1: ListBox1.Items.Add(s ' not exist.');

DRIVE_REMOVABLE: ListBox1.Items.Add(s ' removable.'); // floppy,zip

DRIVE_FIXED: ListBox1.Items.Add(s ' fixed.');

DRIVE_REMOTE: ListBox1.Items.Add(s ' network.');

DRIVE_CDROM: ListBox1.Items.Add(s ' CD-ROM.');

DRIVE_RAMDISK: ListBox1.Items.Add(s ' RAM.');

end;

inc(i);

mask := mask shr 1;

end;

end;

В ListBox1 получаем все диски на данном компьютере.

Поличение серийного номера IDE диска

Функция получает серийный номер первого физического диска IDE (не серийный номер тома!).

Используется S.M.A.R.T. API, а под Windows NT/2K/XP запрос производится не напрямую к диску,

а через miniport драйвер контроллера, что позволяет читать серийный номер не имея прав администратора.

Функция может не работать, если первый контролер в системе не ATA или если первое устройство

не является винчестером, который поддерживает SMART (современные винчестеры поддерживают).

Если Вы хотите получить другие параметры диска/других дисков, то смотрите пример IdeInfo2 с моего сайта.

На Windows 9x требует наличия драйвера smartvsd.vxd (должен быть в стандартной поставке),

просто скопируйте его в \windows\system\iosubsys и перезагрузите компьютер.

Зависимости: Windows, SysUtils

function GetIdeDiskSerialNumber: string;

type

TSrbIoControl = packed record

HeaderLength: ULONG;

Signature: array[0..7] of Char;

Timeout: ULONG;

ControlCode: ULONG;

ReturnCode: ULONG;

Length: ULONG;

end;

SRB_IO_CONTROL = TSrbIoControl;

PSrbIoControl = ^TSrbIoControl;

TIDERegs = packed record

bFeaturesReg: Byte; // Used for specifying SMART "commands".

bSectorCountReg: Byte; // IDE sector count register

bSectorNumberReg: Byte; // IDE sector number register

bCylLowReg: Byte; // IDE low order cylinder value

bCylHighReg: Byte; // IDE high order cylinder value

bDriveHeadReg: Byte; // IDE drive/head register

bCommandReg: Byte; // Actual IDE command.

bReserved: Byte; // reserved for future use. Must be zero.

end;

IDEREGS = TIDERegs;

PIDERegs = ^TIDERegs;

TSendCmdInParams = packed record

cBufferSize: DWORD; // Buffer size in bytes

irDriveRegs: TIDERegs; // Structure with drive register values.

bDriveNumber: Byte; // Physical drive number to send command to (0,1,2,3).

bReserved: array[0..2] of Byte; // Reserved for future expansion.

dwReserved: array[0..3] of DWORD; // For future use.

bBuffer: array[0..0] of Byte; // Input buffer.

end;

SENDCMDINPARAMS = TSendCmdInParams;

PSendCmdInParams = ^TSendCmdInParams;

TIdSector = packed record

wGenConfig: Word;

wNumCyls: Word;

wReserved: Word;

wNumHeads: Word;

wBytesPerTrack: Word;

wBytesPerSector: Word;

wSectorsPerTrack: Word;

wVendorUnique: array[0..2] of Word;

sSerialNumber: array[0..19] of Char;

wBufferType: Word;

wBufferSize: Word;

wECCSize: Word;

sFirmwareRev: array[0..7] of Char;

sModelNumber: array[0..39] of Char;

wMoreVendorUnique: Word;

wDoubleWordIO: Word;

wCapabilities: Word;

wReserved1: Word;

wPIOTiming: Word;

wDMATiming: Word;

wBS: Word;

wNumCurrentCyls: Word;

wNumCurrentHeads: Word;

wNumCurrentSectorsPerTrack: Word;

ulCurrentSectorCapacity: ULONG;

wMultSectorStuff: Word;

ulTotalAddressableSectors: ULONG;

wSingleWordDMA: Word;

wMultiWordDMA: Word;

bReserved: array[0..127] of Byte;

end;

PIdSector = ^TIdSector;

const

IDE_ID_FUNCTION = $EC;

IDENTIFY_BUFFER_SIZE = 512;

DFP_RECEIVE_DRIVE_DATA = $0007C088;

IOCTL_SCSI_MINIPORT = $0004D008;

IOCTL_SCSI_MINIPORT_IDENTIFY = $001B0501;

DataSize = sizeof(TSendCmdInParams) - 1 IDENTIFY_BUFFER_SIZE;

BufferSize = SizeOf(SRB_IO_CONTROL) DataSize;

W9xBufferSize = IDENTIFY_BUFFER_SIZE 16;

var

hDevice: THandle;

cbBytesReturned: DWORD;

pInData: PSendCmdInParams;

pOutData: Pointer; // PSendCmdInParams;

Buffer: array[0..BufferSize - 1] of Byte;

srbControl: TSrbIoControl absolute Buffer;

procedure ChangeByteOrder(var Data; Size: Integer);

var

ptr: PChar;

i: Integer;

c: Char;

begin

ptr := @Data;

for i := 0 to (Size shr 1) - 1 do

begin

c := ptr^;

ptr^ := (ptr 1)^;

(ptr 1)^ := c;

Inc(ptr, 2);

end;

end;

begin

Result := '';

FillChar(Buffer, BufferSize, #0);

if Win32Platform = VER_PLATFORM_WIN32_NT then

begin // Windows NT, Windows 2000

// Get SCSI port handle

hDevice := CreateFile('\\.\Scsi0:', GENERIC_READ or GENERIC_WRITE,

FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);

if hDevice = INVALID_HANDLE_VALUE then

Exit;

try

srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);

System.Move('SCSIDISK', srbControl.Signature, 8);

srbControl.Timeout := 2;

srbControl.Length := DataSize;

srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;

pInData := PSendCmdInParams(PChar(@Buffer) SizeOf(SRB_IO_CONTROL));

pOutData := pInData;

with pInData^ do

begin

cBufferSize := IDENTIFY_BUFFER_SIZE;

bDriveNumber := 0;

with irDriveRegs do

begin

bFeaturesReg := 0;

bSectorCountReg := 1;

bSectorNumberReg := 1;

bCylLowReg := 0;

bCylHighReg := 0;

bDriveHeadReg := $A0;

bCommandReg := IDE_ID_FUNCTION;

end;

end;

if not DeviceIoControl(hDevice, IOCTL_SCSI_MINIPORT, @Buffer,

BufferSize, @Buffer, BufferSize, cbBytesReturned, nil) then

Exit;

finally

CloseHandle(hDevice);

end;

end

else

begin // Windows 95 OSR2, Windows 98

hDevice := CreateFile('\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0);

if hDevice = INVALID_HANDLE_VALUE then

Exit;

try

pInData := PSendCmdInParams(@Buffer);

pOutData := PChar(@pInData^.bBuffer);

with pInData^ do

begin

cBufferSize := IDENTIFY_BUFFER_SIZE;

bDriveNumber := 0;

with irDriveRegs do

begin

bFeaturesReg := 0;

bSectorCountReg := 1;

bSectorNumberReg := 1;

bCylLowReg := 0;

bCylHighReg := 0;

bDriveHeadReg := $A0;

bCommandReg := IDE_ID_FUNCTION;

end;

end;

if not DeviceIoControl(hDevice, DFP_RECEIVE_DRIVE_DATA, pInData,

SizeOf(TSendCmdInParams) - 1, pOutData, W9xBufferSize,

cbBytesReturned, nil) then

Exit;

finally

CloseHandle(hDevice);

end;

end;

with PIdSector(PChar(pOutData) 16)^ do

begin

ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));

SetString(Result, sSerialNumber, SizeOf(sSerialNumber));

end;

end;

Пример использования:

var

s: string;

rc: DWORD;

begin

s := GetIdeDiskSerialNumber;

if s = '' then

begin

rc := GetLastError;

if rc = 0 then

WriteLn('IDE drive is not support SMART feature')

else

WriteLn(SysErrorMessage(rc));

end

else

WriteLn('Disk serial number: ''', s, '''');

end.

Перечислить диски

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

Оформил: DeeCo

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

{

Adds all fixed drives into Combobox1.

To enumerate another type of drive,

i.e all CD-ROMs just change the DRIVE_FIXED constant to DRIVE_CDROM.

Fugt all fixen Laufwerke in Combobox1 ein.

Um z.B alle CD-Rom Laufwerke zu ermitteln,

einfach DRIVE_CDROM anstatt die Konstante DRIVE_FIXED nehmen.

}

procedure List_Drives;

const

DRIVE_UNKNOWN = 0;

DRIVE_NO_ROOT_DIR = 1;

DRIVE_REMOVABLE = 2;

DRIVE_FIXED = 3;

DRIVE_REMOTE = 4;

DRIVE_CDROM = 5;

DRIVE_RAMDISK = 6;

var

r: LongWord;

Drives: array[0..128] of char;

pDrive: PChar;

begin

r := GetLogicalDriveStrings(SizeOf(Drives), Drives);

if r = 0 then Exit;

if r > SizeOf(Drives) then

raise Exception.Create(SysErrorMessage(ERROR_OUTOFMEMORY));

pDrive := Drives;

while pDrive^ #0 do

begin

if GetDriveType(pDrive) = DRIVE_FIXED then

Form1.ComboBox1.Items.Add(pDrive);

Inc(pDrive, 4);

end;

end;

{/codecitation}