Reply-To: "Abner Doon" <__abnrdoon@newsguy.com>
From: "Abner Doon" <__abnrdoon@newsguy.com>
Newsgroups: borland.public.delphi.winapi
References: <3b371960_1@dnews>
Subject: Re: Locking CD Drive
Date: Mon, 25 Jun 2001 18:24:29 +0200
Lines: 355
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Outlook Express 5.50.4522.1200
X-MimeOLE: Produced By Microsoft MimeOLE V5.50.4522.1200
NNTP-Posting-Host: 195.115.71.151
Message-ID: <3b3765c0$1_1@dnews>
X-Trace: dnews 993486272 195.115.71.151 (25 Jun 2001 09:24:32 -0700)
Path: dnews
Xref: dnews borland.public.delphi.winapi:139194


"Werner Cloete" <WACloete@OldMutual.com> a écrit dans le message news:

Take a look at this unit !

//////////////////////////
//                      //
// Abner Doon - 05-2000 //
//                      //
// IOCTL - Version 1.0  //
//                      //
//////////////////////////

unit IOCTL;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Network: TImage;
    CDRom: TImage;
    ComboBox1: TComboBox;
    CheckBox1: TCheckBox;
    Floppy: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

const
VWIN32_DIOC_DOS_IOCTL   = 1; // specified MS-DOS device I/O ctl - Interrupt 21h Function 4400h - 4411h */
VWIN32_DIOC_DOS_INT25   = 2; // Absolute Disk Read command - Interrupt 25h */
VWIN32_DIOC_DOS_INT26   = 3; // Absolute Disk Write command - Interrupt 25h */
VWIN32_DIOC_DOS_INT13   = 4; // Interrupt 13h commands */
VWIN32_DIOC_SIMCTRLC    = 5; // Simulate Ctrl-C */
VWIN32_DIOC_DOS_DRIVINF = 6; // Interrupt 21h Function 730X commands */

CARRY_FLAG              = 1;

type
// registers
PDIOC_REGISTERS = ^DIOC_REGISTERS;
DIOC_REGISTERS = packed record
   reg_EBX : DWord; // Drive number & Block level
   reg_EDX : DWord; // lock-unlock param
   reg_ECX : DWord; // functions
   reg_EAX : DWord; // IOCTL
   reg_EDI : DWord;
   reg_ESI : DWord;
   reg_Flg : DWord; // carry flag
   end;

// lock-unlock param
PPARAMBLOCK = ^PARAMBLOCK;
PARAMBLOCK = packed record
   bOperation : Byte;
   bNumLocks  : Byte;
   end;

var
  Form1     : TForm1;
  Reg       : DIOC_REGISTERS;
  Prm       : PARAMBLOCK;
  LockTable : array[1..26] of boolean;

implementation


{$R *.DFM}

////////////////////////////////////////////////////////////////////////
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
////////////////////////////////////////////////////////////////////////
var
BitMap   : TBitMap;
BMPWidth : SmallInt;
OldColor : TColor;
begin

   with (Control as TComboBox), Canvas do
   begin
   FillRect(Rect);
   BMPWidth := 16;
   BitMap := TBitMap(Items.Objects[Index]);

      if Bitmap <> nil then
      begin
      BMPWidth := BitMap.Width;
      OldColor := Brush.Color;
      Brush.Color := clBackground;
      BrushCopy(Bounds(Rect.Left + 2,
         (Rect.Top + Rect.Bottom - BitMap.Height) div 2,
         BitMap.Width, BitMap.Height),
         BitMap, Bounds(0, 0, BitMap.Width, BitMap.Height),
         BitMap.Canvas.Pixels[0, BitMap.Height - 1]);
      end;

   Brush.Color := OldColor;
   Rect.Left := Rect.Left + BMPWidth + 10;
   DrawText(Canvas.Handle, PChar(Items[Index]), -1, Rect,
      DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);

   // ridiculous effect
   Dec(Rect.Left, 6);
   InflateRect(Rect, -2, -2);

      if (odFocused in State) and (odSelected in State) then
      Canvas.DrawFocusRect (Rect);

    end;
end;
/////////////////////////////////////////////
procedure TForm1.FormCreate(Sender: TObject);
/////////////////////////////////////////////
var
Drive : Char;
begin
ZeroMemory(@LockTable, sizeof(LockTable));

   // check for removable drive
   for Drive := 'a' to 'z' do
   begin

      case GetDriveType(PChar(Drive + ':\')) of
      DRIVE_REMOVABLE:
         ComboBox1.Items.AddObject(UpCase(Drive), Floppy.Picture.Graphic);
      DRIVE_CDROM:
         ComboBox1.Items.AddObject(UpCase(Drive), CDRom.Picture.Graphic);
      DRIVE_REMOTE:
         ComboBox1.Items.AddObject(UpCase(Drive), Network.Picture.Graphic);
      end;

   end;

   // first removable media
   if ComboBox1.Items.Count > 1 then ComboBox1.ItemIndex := 1
   else begin
   MessageDlg('This Computer does not'+#13
      +'have any removable media...',mtError, [mbOk], 0);
   Application.Terminate;
   end;

end;
////////////////////////////////////////////////////
function GetHandle(var hDevice : THandle) : Boolean;
////////////////////////////////////////////////////
begin
ZeroMemory(@prm, sizeof(prm));
ZeroMemory(@reg, sizeof(reg));

hDevice := CreateFile(PChar('\\.\vwin32'), 0, 0, nil,
   0, FILE_FLAG_DELETE_ON_CLOSE, 0);

   if hDevice = INVALID_HANDLE_VALUE then Result := False
   else Result := True;

end;
////////////////////////////////////////////////////////////////
function LockLogicalVolume(hVWin32 : THandle;
   bDriveNum, bLockLevel : Byte; wPermissions : Word) : Boolean;
////////////////////////////////////////////////////////////////
var
cb          : DWord;
bDeviceCat  : Byte;
Pass        : SmallInt;
begin
// device type
bDeviceCat := $48;

   for Pass := 1 to 2 do
   begin
   reg.reg_EAX := $440D;
   reg.reg_EBX := MAKEWORD(bDriveNum, bLockLevel);
   reg.reg_ECX := MAKEWORD($4A, bDeviceCat);
   reg.reg_EDX := wPermissions;

   Result := DeviceIoControl(hVWin32, VWIN32_DIOC_DOS_IOCTL,
      @reg, sizeof(reg), @reg, sizeof(reg), cb, nil);

      if Result then Break
      // other device
      else bDeviceCat := $08;

   end;

end;
///////////////////////////////////////////////
function UnLockLogicalVolume(hVWin32 : THandle;
   bDriveNum : Byte) : Boolean;
///////////////////////////////////////////////
var
cb          : DWord;
bDeviceCat  : Byte;
Pass        : SmallInt;
begin
// device type
bDeviceCat := $48;

   for Pass := 1 to 2 do
   begin
   reg.reg_EAX := $440D;
   reg.reg_EBX := bDriveNum;
   reg.reg_ECX := MAKEWORD($6A, bDeviceCat);

   Result := DeviceIoControl(hVWin32, VWIN32_DIOC_DOS_IOCTL,
      @reg, sizeof(reg), @reg, sizeof(reg), cb, nil);

      if Result then Break
      // other device
      else bDeviceCat := $08;

   end;

end;
//////////////////////////////////
procedure Eject(nDrive : Integer);
//////////////////////////////////
var
hDevice     : THandle;
fResult     : Boolean;
cb          : DWord;
begin

   if GetHandle(hDevice) then
   begin
   reg.reg_EAX := $440D;
   reg.reg_EBX := nDrive;
   reg.reg_ECX := MAKEWORD($49, $08);

   fResult := DeviceIoControl(hDevice, VWIN32_DIOC_DOS_IOCTL,
      @reg, sizeof(reg), @reg, sizeof(reg), cb, nil);

      if fResult then Form1.Caption := 'Eject : '
         + chr(nDrive + 64) + '...';

   end;

CloseHandle(hDevice);
end;
/////////////////////////////////
procedure Lock(nDrive : Integer);
/////////////////////////////////
var
hDevice        : THandle;
fResult        : Boolean;
fDriveLocked   : Boolean;
cb             : DWord;
begin

   if GetHandle(hDevice) then
   begin
   prm.bOperation := 0;
   reg.reg_EAX := $440D;
   reg.reg_EBX := nDrive;
   reg.reg_ECX := MAKEWORD($48, $08);
   reg.reg_EDX := DWORD(@prm);

   fResult := DeviceIoControl(hDevice, VWIN32_DIOC_DOS_IOCTL,
      @reg, sizeof(reg), @reg, sizeof(reg), cb, nil);

      if fResult then
      begin
      LockTable[nDrive] := True;
      Form1.Caption := 'Lock : ' + chr(nDrive + 64) + '...';
      // verify locking
      // fDriveLocked := LockLogicalVolume (hDevice, nDrive, 0, 0);
      end;

   end;

CloseHandle(hDevice);
end;
///////////////////////////////////
procedure UnLock(nDrive : Integer);
///////////////////////////////////
var
hDevice        : THandle;
fResult        : Boolean;
fDriveLocked   : Boolean;
cb             : DWord;
begin

   if GetHandle(hDevice) then
   begin
   prm.bOperation := 1;
   reg.reg_EAX := $440D;
   reg.reg_EBX := nDrive;
   reg.reg_ECX := MAKEWORD($48, $08);
   reg.reg_EDX := DWORD(@prm);

   fResult := DeviceIoControl(hDevice, VWIN32_DIOC_DOS_IOCTL,
      @reg, sizeof(reg), @reg, sizeof(reg), cb, nil);

      if fResult then
      begin
      LockTable[nDrive] := False;
      Form1.Caption := 'UnLock : ' + chr(nDrive + 64) + '...';
      // verify unlocking
      // fDriveLocked := UnLockLogicalVolume (hDevice, nDrive);
      end;

   end;

CloseHandle(hDevice);
end;
///////////////////////////////////////////////
procedure TForm1.Button1Click(Sender: TObject);
///////////////////////////////////////////////
var
ejc   : SmallInt;
begin
ejc := Ord(ComboBox1.Text[1])-64;

   if LockTable[ejc] and CheckBox1.Checked then
   Form1.Caption := 'Drive is locked...'
   else Eject(ejc);

end;
///////////////////////////////////////////////
procedure TForm1.Button2Click(Sender: TObject);
///////////////////////////////////////////////
begin
Lock(Ord(ComboBox1.Text[1])-64);
end;
///////////////////////////////////////////////
procedure TForm1.Button3Click(Sender: TObject);
///////////////////////////////////////////////
begin
UnLock(Ord(ComboBox1.Text[1])-64);
end;
//////////////////////////////////////////////////////////////////////
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
//////////////////////////////////////////////////////////////////////
begin
Release;
end;