Автор: newfork

Серийный номер тома 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}

Определить тип дискового накопителя

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

Объявление в Интернете: Куплю винчестер. Жёсткие диски не предлагать!

Нужно воспользоваться API функцией GetDriveType():

procedure TForm1.Button1Click(Sender: TObject);

begin

case GetDriveType(‘C:\’) of

0: ShowMessage(‘The drive type cannot be determined’);

1: ShowMessage(‘The root directory does not exist’);

DRIVE_REMOVABLE: ShowMessage(‘The disk can be removed’);

DRIVE_FIXED: ShowMessage(‘The disk cannot be removed’);

DRIVE_REMOTE: ShowMessage(‘The drive is remote (network) drive’);

DRIVE_CDROM: ShowMessage(‘The drive is a CD-ROM drive’);

DRIVE_RAMDISK: ShowMessage(‘The drive is a RAM disk’);

end;

end;

{/codecitation}

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

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

Магазин по пpодаже компьютеpов. Пpодавец подбиpает богатой, но не понимающей в комьютеpах даме:

— Hу вот, я вам подобpал жесткий диск получше?…

— Получше — это пожестче?

Сначала до слова implementation напишем такой код:

function GetDiskFreeSpaceEx(lpDirectoryName: PAnsiChar;

var lpFreeBytesAvailableToCaller : Integer;

var lpTotalNumberOfBytes: Integer;

var lpTotalNumberOfFreeBytes: Integer) : bool;

stdcall;

external kernel32

name ‘GetDiskFreeSpaceExA’;

Затем после слова implementation:

procedure GetDiskSizeAvail(TheDrive : PChar;

var TotalBytes : double; var TotalFree : double);

var

AvailToCall : integer;

TheSize : integer;

FreeAvail : integer;

begin

GetDiskFreeSpaceEx(TheDrive, AvailToCall, TheSize, FreeAvail);

{$IFOPT Q }

{$DEFINE TURNOVERFLOWON}

{$Q-}

{$ENDIF}

if TheSize >= 0 then

TotalBytes := TheSize

else

if TheSize = -1 then

begin

TotalBytes := $7FFFFFFF;

TotalBytes := TotalBytes * 2;

TotalBytes := TotalBytes 1;

end

else

begin

TotalBytes := $7FFFFFFF;

TotalBytes := TotalBytes abs($7FFFFFFF — TheSize);

end;

if AvailToCall >= 0 then

TotalFree := AvailToCall

else

if AvailToCall = -1 then

begin

TotalFree := $7FFFFFFF;

TotalFree := TotalFree * 2;

TotalFree := TotalFree 1;

end

else

begin

TotalFree := $7FFFFFFF;

TotalFree := TotalFree abs($7FFFFFFF — AvailToCall);

end;

end;

И, наконец, обработаем нажатие кнопки следующим образом:

procedure TForm1.Button1Click(Sender: TObject);

var

TotalBytes: double;

TotalFree: double;

begin

GetDiskSizeAvail(‘C:\’, TotalBytes, TotalFree);

ShowMessage(FloatToStr(TotalBytes));

ShowMessage(FloatToStr(TotalFree));

end;

{/codecitation}