unitsetup.pas

使用DELPHI制作地虚拟光驱

unit UnitSetUp;

interface

uses
  VCDDefine, VCDFunction,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons;

type
  TFormSetUp = class(TForm)
    cbDevice: TComboBox;
    cbDriver: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    edtFileName: TEdit;
    btnSelectFile: TSpeedButton;
    btnUse: TBitBtn;
    btnClose: TBitBtn;
    ODlg: TOpenDialog;
    procedure btnUseClick(Sender: TObject);
    procedure btnSelectFileClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure cbDeviceChange(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
  private
  protected
    procedure GetDevice(Index:Integer);

  public
    { Public declarations }
  end;

var
  FormSetUp: TFormSetUp;

implementation

{$R *.dfm}

procedure TFormSetUp.btnCloseClick(Sender: TObject);
begin
  Self.Close();
end;

procedure TFormSetUp.btnSelectFileClick(Sender: TObject);
begin
  if ODlg.Execute() then
    edtFileName.Text := ODlg.FileName;
end;

procedure TFormSetUp.btnUseClick(Sender: TObject);
var
  DeviceInfo : VCD_DEVICE_INFORMATION;
  DeivceFileName:String;
  OldD       : Char; 
begin


  DeviceInfo := GetDeviceInfo(cbDriver.Text[1]);
  DeivceFileName := Pchar(@DeviceInfo.FileName);
  OldD := GetVCDDriver(cbDevice.ItemIndex);

  if cbDriver.ItemIndex = 0 then
  begin
    if DeviceInfo.MediaIn then
      RemoveCD(OldD);
    UnLinkDevice(OldD);
  end
  else
  begin
    if cbDriver.Text[1]<> OldD then
    begin
      UnLinkDevice(OldD);
      LinkDevice(cbDriver.Text[1],cbDevice.ItemIndex);
    end;

    if LowerCase(DeivceFileName) <> LowerCase(edtFileName.Text) then
    begin
      if edtFileName.Text ='' then
        RemoveCD(cbDriver.Text[1])
      else
      begin
        if DeviceInfo.MediaIn then
          RemoveCD(cbDriver.Text[1]);
        InsertCD(cbDriver.Text[1], edtFileName.Text);
      end;
    end;
  end;
  cbDevice.OnChange(cbDevice); 
end;

procedure TFormSetUp.cbDeviceChange(Sender: TObject);
begin
  GetDevice(cbDevice.ItemIndex);
end;


procedure TFormSetUp.FormShow(Sender: TObject);
begin
  //SetWindowPos(Self.Handle,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE);
  GetDevice(cbDevice.ItemIndex);
end;

procedure TFormSetUp.GetDevice(Index: Integer);
  Function GetBit(Data:DWORD; ABit:Byte):Byte;
  var
    I:DWORD;
  begin
    I:=1 shl ABit;
    Result := (Data and I) shr ABit;
  end;
var
  I            : Char;
  Driver       : String;
  ADrivers,cDriver : DWORD;
  DeviceInfo   : VCD_DEVICE_INFORMATION;
  FileName     : String;
begin
  edtFileName.Text := '';
  cbDriver.Items.Clear;
  cbDriver.Items.Add('空');
  cbDriver.ItemIndex :=0;
  for I := 'A' to 'Z' do
  begin
    Driver := I + ':';
    ADrivers := GetLogicalDrives();
    cDriver := ord(I) - ord('A');
    if GetBit(ADrivers, cDriver) = 0 then
    begin
      cbDriver.Items.Add(Driver);
    end
    else
    begin
      case GetDriveType(Pchar(Driver)) of
        DRIVE_CDROM:
         begin
            DeviceInfo := GetDeviceInfo(I);
            if DeviceInfo.Magic = DEVICE_MAGIC then
            begin
              if DeviceInfo.Index = Index then
              begin
                cbDriver.ItemIndex := cbDriver.Items.Add(Driver);
                edtFileName.Text := DeviceInfo.FileName;
              end;
            end;
         end;
      end;
    end;
  end;

end;

end.