Работа с железом

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:

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:

type

              TForm1 = class(TForm)

                Button1: TButton;

              private

                { Private declarations }

                procedure WMDeviceChange(var Message: TMessage);

                  message WM_DEVICECHANGE;

              public

                { Public declarations }

              end;

            var

              Form1: TForm1;

            implementation

            {$R *.DFM}

            const DBT_DEVICEARRIVAL = $8000;

            const DBT_DEVICEQUERYREMOVE = $8001;

            const DBT_DEVICEQUERYREMOVEFAILED = $8002;

            const DBT_DEVICEREMOVEPENDING = $8003;

            const DBT_DEVICEREMOVECOMPLETE = $8004;

            const DBT_DEVICETYPESPECIFIC = $8005;

            const DBT_CONFIGCHANGED = $0018;

            procedure TForm1.WMDeviceChange(var Message: TMessage);

            var

              s : string;

            begin

            {Do Something here}

              case Message.wParam of

                DBT_DEVICEARRIVAL :

                  s := 'A device has been inserted and is now available';

                DBT_DEVICEQUERYREMOVE: begin

                  s := 'Permission to remove a device is requested';

                  ShowMessage(s);

                 {True grants premission}

                  Message.Result := integer(true);

                  exit;

                end;

                DBT_DEVICEQUERYREMOVEFAILED :

                  s := 'Request to remove a device has been canceled';

                DBT_DEVICEREMOVEPENDING :

                  s := 'Device is about to be removed';

                DBT_DEVICEREMOVECOMPLETE :

                  s := 'Device has been removed';

                DBT_DEVICETYPESPECIFIC :

                  s := 'Device-specific event';

                DBT_CONFIGCHANGED :

                  s:= 'Current configuration has changed'

                else s := 'Unknown Device Message';

              end;

              ShowMessage(s);

              inherited;

            end;

Code:

unit Unit1;

{©Drkb v.3}

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

   Memo1: TMemo;

   Button1: TButton;

   procedure Button1Click(Sender: TObject);

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

const

NameSize = 4;

VolumeCount = 26;

TotalSize = NameSize * VolumeCount;

Report = 'Volume: %s %s';

var

Buff, Volume: String;

lpQuery: array [0..MAXCHAR - 1] of Char;

I, Count: Integer;

begin

SetLength(Buff, TotalSize);

Count := GetLogicalDriveStrings(TotalSize, @Buff[1]) div NameSize;

if Count = 0 then

   Memo1.Lines.Add(SysErrorMessage(GetLastError))

else

   for I := 0 to Count - 1 do

   begin

     Volume := PChar(@Buff[(I * NameSize) + 1]);

     case GetDriveType(PChar(Volume)) of

       DRIVE_UNKNOWN: Memo1.Lines.Add(Format(Report, [Volume,

         'The drive type cannot be determined.']));

       DRIVE_NO_ROOT_DIR: Memo1.Lines.Add(Format(Report, [Volume,

         'The root path is invalid. For example, no volume is mounted at the path.']));

       DRIVE_REMOVABLE:

       begin

         Volume[3] := #0;

         QueryDosDevice(PChar(Volume), @lpQuery[0], MAXCHAR);

         Volume[3] := '\';

         if String(lpQuery) = '\Device\Floppy0' then

           Memo1.Lines.Add(Format(Report, [Volume, 'The drive is a Floppy disk A:.']))

         else

           if String(lpQuery) = '\Device\Floppy1' then

             Memo1.Lines.Add(Format(Report, [Volume, 'The drive is a Floppy disk B:.']))

           else

             Memo1.Lines.Add(Format(Report, [Volume, 'The drive is a Flash Drive.']));

       end;

       DRIVE_FIXED:

       begin

         Volume[3] := #0;

         QueryDosDevice(PChar(Volume), @lpQuery[0], MAXCHAR);

         Volume[3] := '\';

         if Copy(String(lpQuery), 1, 22)  = '\Device\HarddiskVolume' then

           Memo1.Lines.Add(Format(Report, [Volume,

             'The disk cannot be removed from the drive.']))

         else

           Memo1.Lines.Add(Format(Report, [Volume,

             'The drive is a SUBST disk on path: "' +

               Copy(String(lpQuery), 5, Length(String(lpQuery))) + '"']));

       end;

       DRIVE_REMOTE: Memo1.Lines.Add(Format(Report, [Volume,

         'The drive is a remote (network) drive.']));

       DRIVE_CDROM: Memo1.Lines.Add(Format(Report, [Volume,

         'The drive is a CD-ROM drive.']));

       DRIVE_RAMDISK: Memo1.Lines.Add(Format(Report, [Volume,

         'The drive is a RAM disk.']));

     else

       Memo1.Lines.Add(Format(Report, [Volume, 'Xpen znaet chto :)']));

     end;

   end;

end;

end.

Code:

type

TSector = array[0..511] of Byte;

var

Boot: TSector;

begin

ReadBoot(Drive, Boot);