ejectedisque.pas

Delphi编程技巧11

unit EjecteDisque;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, FileCtrl;

type
  TForm1 = class(TForm)
    Button1: TButton;
    DriveComboBox1: TDriveComboBox;
    procedure Button1Click(Sender: TObject);
    procedure DriveComboBox1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
  VWIN32_DIOC_DOS_IOCTL = 1;  // Fonctions DOS 4400h-4411h
  IOCTL_STORAGE_EJECT_MEDIA = 2967560;  // Fonction NT correspondante

type
  Dioc_Registers = record
    EBX : Dword;
    EDX : Dword;
    ECX : Dword;
    EAX : Dword;
    EDI : Dword;
    ESI : Dword;
    Flags : Dword;
  end;

var
  Lecteur : Char;

procedure TForm1.Button1Click(Sender: TObject);
var
  hDevice : THandle;
  Nb : DWORD;
  Reg : Dioc_Registers;
  VersionInfo : TOSVersionInfo;
begin
  VersionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(VersionInfo);
  if VersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
    hDevice := CreateFile(PChar('\\.\' + Lecteur + ':'), GENERIC_READ,
                          FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0)
  else
    hDevice := CreateFile('\\.\VWIN32', 0, 0, nil, 0,
                          FILE_FLAG_DELETE_ON_CLOSE, 0);
  if hDevice = INVALID_HANDLE_VALUE then
    RaiseLastWin32Error;
  if VersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then begin
    if not DeviceIoControl(hDevice, IOCTL_STORAGE_EJECT_MEDIA,
                    nil, 0, nil, 0, Nb, nil) then
      RaiseLastWin32Error;
  end else begin
    with Reg do begin
      EAX := $440D;       {fc 44h de l'interr. 21h, sous-fonction 0Dh}
      EBX := Byte(Lecteur) - $40;           {A=1, B=2, C=3, D=4...}
      ECX := $0849;       {commande: Eject Removable Media}
    end;
    DeviceIoControl(hDevice, VWIN32_DIOC_DOS_IOCTL,
                    @Reg, SizeOf(Reg), @Reg, SizeOf(Reg), Nb, nil);
    if Reg.Flags and 1 = 1 then case Reg.EAX of
      $01 : ShowMessage('The function is not supported.');
      $B1 : ShowMessage('The volume is locked in the drive.');
      $B2 : ShowMessage('The volume is not removable.');
      $B5 : ShowMessage('The valid eject request has failed.');
    end;
  end;
  CloseHandle(hDevice);
end;

procedure TForm1.DriveComboBox1Change(Sender: TObject);
begin
  Lecteur := UpCase(DriveComboBox1.Drive);
end;

end.