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

procedure TForm1.Button1Click(Sender: TObject);

var

VolumeName,

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

VolumeSerialNo: DWord;

MaxComponentLength,

FileSystemFlags: Integer;

begin

GetVolumeInformation('C:\', VolumeName, MAX_PATH, @VolumeSerialNo,

MaxComponentLength, FileSystemFlags,

FileSystemName, MAX_PATH);

Memo1.Lines.Add('VName = ' 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;

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

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»}

Автор: KosilkA

WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****

>> Узнать текущую раскладку клавиатуры в любом активном окне

возвращает числовое значение соответственно установленной раскладке

Зависимости: windows

Автор: KosilkA, gloom@imail.ru, Koenigsberg

Copyright: delphi help и немного усердия 🙂

Дата: 4 декабря 2003 г.

***************************************************** }

if GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, nil)) = 67699721 then

//раскладка английская

else

//раскладка НЕанглийская, например 68748313 соответствует русской

{/codecitation}

Список установленных раскладок клавиатуры

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

Оформил: DeeCo

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

procedure GetKLList(List: TStrings);

var

AList : array [0..9] of Hkl;

AklName: array [0..255] of Char;

i: Longint;

begin

List.Clear;

for i := 0 to GetKeyboardLayoutList(SizeOf(AList), AList) — 1 do

begin

GetLocaleInfo(LoWord(AList[i]), LOCALE_SLANGUAGE, AklName, SizeOf(AklName));

List.AddObject(AklName, Pointer(AList[i]));

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

GetKLList(ListBox1.Items);

end;

procedure TForm1.ListBox1Click(Sender: TObject);

begin

with Sender as TListBox do

ActivateKeyboardLayout(Hkl(Items.Objects[ItemIndex]), 0);

end;

{/codecitation}

Сменить язык

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

FIDO’шник решил блеснуть знанием английского языка. Заходит в пивную.

— Пива энд воблы. Ничего, что я по-англицки?

Эта программа при нажатии на Button1 меняет язык на следующий, при нажатии на Button2 – на русский, а на Button3 – на английский. Каждую секунду программа выводит в заголовок окна число, определяющее текущий язык.

procedure TForm1.Button1Click(Sender: TObject);

begin

ActivateKeyboardLayout(HKL_NEXT, 0);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

ActivateKeyboardLayout(LoadKeyboardLayout(‘00000419’, 0), 0);

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

ActivateKeyboardLayout(LoadKeyboardLayout(‘00000409’, 0), 0);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

var

s: array [0..63] of char;

begin

GetKeyboardLayoutName(s);

Form1.Caption := s;

end;

{/codecitation}

Регионарные стандарты

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

Автор: Vit

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

В Дельфи есть предопределенные переменные языковых установок и форматов:

// SysUtils

var CurrencyString: string;

var CurrencyFormat: Byte;

var NegCurrFormat: Byte;

var ThousandSeparator: Char;

var DecimalSeparator: Char;

var CurrencyDecimals: Byte;

var DateSeparator: Char;

var ShortDateFormat: string;

var LongDateFormat: string;

var TimeSeparator: Char;

var TimeAMString: string;

var TimePMString: string;

var ShortTimeFormat: string;

var LongTimeFormat: string;

var ShortMonthNames: array[1..12] of string;

var LongMonthNames: array[1..12] of string;

var ShortDayNames: array[1..7] of string;

var LongDayNames: array[1..7] of string;

var SysLocale: TSysLocale;

var EraNames: array[1..7] of string;

var EraYearOffsets: array[1..7] of Integer;

var TwoDigitYearCenturyWindow: Word = 50;

var TListSeparator: Char;

{/codecitation}