Code:

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;

Code:

{ ... }

if DefineDosDevice(DDD_RAW_TARGET_PATH, 'P:', 'F:\Backup\Music\Modules') then

ShowMessage('Drive was created successfully')

else

ShowMessage('Error creating drive');

   { ... }

Code:

type

TDriveState(DS_NO_DISK, DS_UNFORMATTED_DISK, DS_EMPTY_DISK,

   DS_DISK_WITH_FILES);

function DriveState(driveletter: Char): TDriveState;

var

mask: string[6];

sRec: TSearchRec;

oldMode: Cardinal;

retcode: Integer;

begin

oldMode: = SetErrorMode(SEM_FAILCRITICALERRORS);

mask := '?:\*.*';

mask[1] := driveletter;

{$I-} { не возбуждаем исключение при неудаче }

retcode := FindFirst(mask, faAnyfile, SRec);

FindClose(SRec);

{$I+}

case retcode of

   0: Result := DS_DISK_WITH_FILES; { обнаружен по крайней мере один файл }

   -18: Result := DS_EMPTY_DISK; { никаких файлов не обнаружено, но ok }

   -21: Result := DS_NO_DISK; { DOS ERROR_NOT_READY }

else

   Result := DS_UNFORMATTED_DISK; { в моей системе значение равно -1785!}

end;

SetErrorMode(oldMode);

end; { DriveState }

Code:

const

{©Drkb v.3}

FILE_DEVICE_FILE_SYSTEM: Integer = $00000009;

METHOD_BUFFERED: Integer = $00000000;

FILE_ANY_ACCESS: Integer = $00000000;

function CTL_CODE(DeviceType, FunctionNo, Method, Access: Integer): Integer;

begin

Result := (DeviceType shl 16) or (Access shl 14) or (FunctionNo shl 2) or (Method);

end;

procedure TForm1.Button1Click(Sender: TObject);

var

LHandle: THandle;

BytesReturned: Cardinal;

MsgBuf: PChar;

FSCTL_LOCK_VOLUME: Integer;

begin

FSCTL_LOCK_VOLUME := CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 6,

                                                 METHOD_BUFFERED, FILE_ANY_ACCESS);

LHandle := CreateFile('\\.\A:', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ

                     or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or

                     FILE_FLAG_DELETE_ON_CLOSE, 0);

if LHandle <> 0 then

begin

  if DeviceIOControl(LHandle, FSCTL_LOCK_VOLUME, nil, 0, nil, 0, BytesReturned, nil) then

    ShowMessage('Дисковод заблокирован. Нажмите ОК для разблокирования.')

  else

  begin

    if FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or

         FORMAT_MESSAGE_FROM_SYSTEM, nil, GetLastError(), 0, @MsgBuf, 0, nil) > 0 then

    begin

      ShowMessage('Ошибка DeviceIOControl: ' + MsgBuf);

      LocalFree(Cardinal(MsgBuf));

    end

    else

      ShowMessage('Ошибка при вызове DeviceIOControl!');

  end;

  CloseHandle(LHandle);

end

else

  ShowMessage('Ошибка при вызове CreateFile!');

end;

Code:

unit Unit1;

{©Drkb v.3}

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls;

type

TUndocSHFormat = class(TForm)

   Label1: TLabel;

   Combo1: TComboBox;

   cmdSHFormat: TButton;

   cmdEnd: TButton;

   lbMessage: TLabel;

   procedure FormCreate(Sender: TObject);

   procedure cmdSHFormatClick(Sender: TObject);

   procedure cmdEndClick(Sender: TObject);

private

   procedure LoadAvailableDrives;

public

end;

var

UndocSHFormat: TUndocSHFormat;

implementation

{$R *.DFM}

type POSVERSIONINFO = ^TOSVERSIONINFO;

TOSVERSIONINFO = record

   dwOSVersionInfoSize: Longint;

   dwMajorVersion: Longint;

   dwMinorVersion: Longint;

   dwBuildNumber: Longint;

   dwPlatformId: Longint;

   szCSDVersion: PChar;

end;

function GetVersionEx(lpVersionInformation: POSVERSIONINFO): Longint; stdcall; external 'kernel32.dll' name 'GetVersionExA';

const VER_PLATFORM_WIN32s = 0;

const VER_PLATFORM_WIN32_WINDOWS = 1;

const VER_PLATFORM_WIN32_NT = 2;

function SHFormatDrive(hwndOwner: longint; iDrive: Longint; iCapacity: LongInt;

iFormatType: LongInt): Longint;

stdcall; external 'shell32.dll';

const SHFD_CAPACITY_DEFAULT = 0;

const SHFD_CAPACITY_360 = 3;

const SHFD_CAPACITY_720 = 5;

//Win95

//Const SHFD_FORMAT_QUICK = 0;

//Const SHFD_FORMAT_FULL = 1;

//Const SHFD_FORMAT_SYSONLY = 2;

//WinNT

//Public Const SHFD_FORMAT_FULL = 0

//Public Const SHFD_FORMAT_QUICK = 1

const SHFD_FORMAT_QUICK: LongInt = 0;

const SHFD_FORMAT_FULL: LongInt = 1;

const SHFD_FORMAT_SYSONLY: LongInt = 2;

function GetLogicalDriveStrings(nBufferLength: LongInt; lpBuffer: PChar): LongInt;

stdcall; external 'kernel32.dll' name 'GetLogicalDriveStringsA';

function GetDriveType(nDrive: PChar): LongInt;

stdcall; external 'kernel32.dll' name 'GetDriveTypeA';

const DRIVE_REMOVABLE = 2;

const DRIVE_FIXED = 3;

const DRIVE_REMOTE = 4;

const DRIVE_CDROM = 5;

const DRIVE_RAMDISK = 6;

function IsWinNT: Boolean;

var osvi: TOSVERSIONINFO;

begin

osvi.dwOSVersionInfoSize := SizeOf(osvi);

GetVersionEx(@osvi);

IsWinNT := (osvi.dwPlatformId = VER_PLATFORM_WIN32_NT);

end;

function GetDriveDisplayString(currDrive: PChar): pchar;

begin

GetDriveDisplayString := nil;

case GetDriveType(currDrive) of

   0, 1: GetDriveDisplayString := ' - Undetermined Drive Type -';

   DRIVE_REMOVABLE:

     case currDrive[1] of

       'A', 'B': GetDriveDisplayString := 'Floppy drive';

     else

       GetDriveDisplayString := 'Removable drive';

     end;

   DRIVE_FIXED: GetDriveDisplayString := 'Fixed (Hard) drive';

   DRIVE_REMOTE: GetDriveDisplayString := 'Remote drive';

   DRIVE_CDROM: GetDriveDisplayString := 'CD ROM';

   DRIVE_RAMDISK: GetDriveDisplayString := 'Ram disk';

end;

end;

procedure TUndocSHFormat.LoadAvailableDrives;

var

a, r: LongInt;

lpBuffer: array[0..256] of char;

currDrive: array[0..256] of char;

lpDrives: pchar;

begin

getmem(lpDrives, 256);

fillchar(lpBuffer, 64, #32);

r := GetLogicalDriveStrings(255, lpBuffer);

if r <> 0 then

   begin

     strlcopy(lpBuffer, lpBuffer, r);

     for a := 0 to r do

       lpDrives[a] := lpBuffer[a];

     lpBuffer[r + 1] := #0;

     repeat

       strlcopy(currDrive, lpDrives, 3);

       lpDrives := @lpDrives[4];

       Combo1.Items.Add(strpas(currDrive) + ' ' + GetDriveDisplayString(currDrive));

     until lpDrives[0] = #0;

   end;

end;

procedure TUndocSHFormat.FormCreate(Sender: TObject);

begin

lbMessage.caption := '';

LoadAvailableDrives;

Combo1.ItemIndex := 0;

if IsWinNT then

   begin

     SHFD_FORMAT_FULL := 0;

     SHFD_FORMAT_QUICK := 1;

   end

else //it's Win95

   begin

     SHFD_FORMAT_QUICK := 0;

     SHFD_FORMAT_FULL := 1;

     SHFD_FORMAT_SYSONLY := 2;

   end;

end;

procedure TUndocSHFormat.cmdSHFormatClick(Sender: TObject);

var

resp: Integer;

drvToFormat: Integer;

prompt: string;

begin

drvToFormat := Combo1.ItemIndex;

prompt := 'Are you sure you want to run the Format dialog against ' + Combo1.Text;

if drvToFormat > 0 then

   resp := MessageDLG(prompt, mtConfirmation, [mbYes, mbNo], 0)

else

   resp := mrYes;

if resp = mrYes then

   begin

     lbMessage.Caption := 'Checking drive for disk...';

     Application.ProcessMessages;

     SHFormatDrive(handle, drvToFormat, SHFD_CAPACITY_DEFAULT, SHFD_FORMAT_QUICK);

     lbMessage.caption := '';

   end;

end;

procedure TUndocSHFormat.cmdEndClick(Sender: TObject);

begin

close;

end;

end.

Code:

program ScsiSN;

// PURPOSE: Simple console application that display SCSI harddisk serial number

{$APPTYPE CONSOLE}

uses

Windows, SysUtils;

//-------------------------------------------------------------

function GetDeviceHandle(sDeviceName: string): THandle;

begin

Result := CreateFile(PChar('\\.\' + sDeviceName),

   GENERIC_READ or GENERIC_WRITE,

   FILE_SHARE_READ or FILE_SHARE_WRITE,

   nil, OPEN_EXISTING, 0, 0)

end;

//-------------------------------------------------------------

function ScsiHddSerialNumber(DeviceHandle: THandle): string;

{$ALIGN ON}

type

TScsiPassThrough = record

   Length: Word;

   ScsiStatus: Byte;

   PathId: Byte;

   TargetId: Byte;

   Lun: Byte;

   CdbLength: Byte;

   SenseInfoLength: Byte;

   DataIn: Byte;

   DataTransferLength: ULONG;

   TimeOutValue: ULONG;

   DataBufferOffset: DWORD;

   SenseInfoOffset: ULONG;

   Cdb: array[0..15] of Byte;

end;

TScsiPassThroughWithBuffers = record

   spt: TScsiPassThrough;

   bSenseBuf: array[0..31] of Byte;

   bDataBuf: array[0..191] of Byte;

end;

{ALIGN OFF}

var

dwReturned: DWORD;

len: DWORD;

Buffer: array[0..SizeOf(TScsiPassThroughWithBuffers) +

SizeOf(TScsiPassThrough) - 1] of Byte;

sptwb: TScsiPassThroughWithBuffers absolute Buffer;

begin

Result := '';

FillChar(Buffer, SizeOf(Buffer), #0);

with sptwb.spt do

begin

   Length := SizeOf(TScsiPassThrough);

   CdbLength := 6; // CDB6GENERIC_LENGTH

   SenseInfoLength := 24;

   DataIn := 1; // SCSI_IOCTL_DATA_IN

   DataTransferLength := 192;

   TimeOutValue := 2;

   DataBufferOffset := PChar(@sptwb.bDataBuf) - PChar(@sptwb);

   SenseInfoOffset := PChar(@sptwb.bSenseBuf) - PChar(@sptwb);

   Cdb[0] := $12; // OperationCode := SCSIOP_INQUIRY;

   Cdb[1] := $01; // Flags := CDB_INQUIRY_EVPD;  Vital product data

   Cdb[2] := $80; // PageCode            Unit serial number

   Cdb[4] := 192; // AllocationLength

end;

len := sptwb.spt.DataBufferOffset + sptwb.spt.DataTransferLength;

if DeviceIoControl(DeviceHandle, $0004D004, @sptwb, SizeOf(TScsiPassThrough),

   @sptwb, len, dwReturned, nil)

   and ((PChar(@sptwb.bDataBuf) + 1)^ = #$80) then

   SetString(Result, PChar(@sptwb.bDataBuf) + 4,

     Ord((PChar(@sptwb.bDataBuf) + 3)^));

end;

/=============================================================

var

hDevice: THandle = 0;

sSerNum, sDeviceName: string;

begin

sDeviceName := ParamStr(1);

if sDeviceName = '' then

begin

   WriteLn;

   WriteLn('Display SCSI-2 device serial number.');

   WriteLn;

   WriteLn('Using:');

   WriteLn;

   if Win32Platform = VER_PLATFORM_WIN32_NT then // Windows NT/2000

     WriteLn('  ScsiSN PhysicalDrive0')

   else

     WriteLn('  ScsiSN C:');

   WriteLn('  ScsiSN Cdrom0');

   WriteLn('  ScsiSN Tape0');

   WriteLn;

   Exit;

end;

hDevice := GetDeviceHandle(sDeviceName);

if hDevice = INVALID_HANDLE_VALUE then

   WriteLn('Error on GetDeviceHandle: ', SysErrorMessage(GetLastError))

else

try

   sSerNum := ScsiHddSerialNumber(hDevice);

   if sSerNum = '' then

     WriteLn('Error on DeviceIoControl: ',

       SysErrorMessageGetLastError))

else

WriteLn('Device ' + sDeviceName

   + ' serial number = "', sSerNum, '"');

finally

CloseHandle(hDevice);

end;

end.