vcdfunction.pas

使用DELPHI制作地虚拟光驱

unit VCDFunction;

interface
uses
  Types, SysUtils, Dialogs, Windows, VCDDefine;

procedure LinkDevice(Driver:Char; DeviceNum:Byte);
procedure UnLinkDevice(Driver:Char);
procedure InsertCD(const Driver:Char; const ISOFileName:String);
procedure RemoveCD(const Driver:Char);
Function GetDeviceInfo(const Driver:Char):VCD_DEVICE_INFORMATION;
Function IsVCD(const Driver:Char):Boolean;
Function GetVCDDriver(DeviceIndex:Integer):Char;

implementation

procedure LinkDevice(Driver:Char; DeviceNum:Byte);
var
  VolumeName, DeviceName  : String;
  hDevice     : THandle;
begin
  VolumeName := Format('\\.\%s:',[Driver]);
  hDevice := CreateFile(
        PChar(VolumeName),
        GENERIC_READ or GENERIC_WRITE,
        FILE_SHARE_READ or FILE_SHARE_WRITE,
        nil,
        OPEN_EXISTING,
        FILE_FLAG_NO_BUFFERING,
        0
        );
  //如果盘符已经存在      
  if hDevice <> INVALID_HANDLE_VALUE then
  begin
    Exit;
  end;
  DeviceName := Format(DEVICE_FULL_NAME+'%d',[DeviceNum]);
  if (not DefineDosDevice(
        DDD_RAW_TARGET_PATH,
        @VolumeName[5],
        PChar(DeviceName)
        )) then
  begin
    Exit;
  end;

  hDevice := CreateFile(
        PChar(VolumeName),
        GENERIC_READ or GENERIC_WRITE,
        FILE_SHARE_READ or FILE_SHARE_WRITE,
        Nil,
        OPEN_EXISTING,
        FILE_FLAG_NO_BUFFERING,
        0
        );
  if (hDevice = INVALID_HANDLE_VALUE) then
  begin
    ShowMessage(VolumeName+'创建失败');
    Exit;
  end;
  FileClose(hDevice);
end;

procedure UnLinkDevice(Driver:Char);
var
  VolumeName : String;
begin
  VolumeName := Driver+':';
  DefineDosDevice(
          DDD_REMOVE_DEFINITION,
          PChar(VolumeName),
          Nil
          );
end;

procedure InsertCD(const Driver:Char; const ISOFileName:String);
var
  VolumeName              : String;
  hDevice                 : THandle;
  FileInfo                : array[0..max_path -1] of char;
  BytesReturned           : DWORD;
begin

  ZeroMemory(@FileInfo, max_path);
  CopyMemory(@FileInfo, PChar(ISOFileName), Length(ISOFileName));

  VolumeName := Format('\\.\%s:',[Driver]);
  hDevice := CreateFile(
        PChar(VolumeName),
        GENERIC_READ or GENERIC_WRITE,
        FILE_SHARE_READ or FILE_SHARE_WRITE,
        Nil,
        OPEN_EXISTING,
        FILE_FLAG_NO_BUFFERING,
        0
        );

   if hDevice = INVALID_HANDLE_VALUE then
   begin
     Exit;
   end;
   DeviceIoControl(
        hDevice,
        IOCTL_VCD_OPEN_FILE,
        @FileInfo,
        MAX_PATH,
        Nil,
        0,
        BytesReturned,
        Nil
        );
   FileClose(hDevice);
end;

procedure RemoveCD(const Driver:Char);
var
  VolumeName     : String;
  hDevice        : THandle;
  BytesReturned  : DWORD;
begin
  VolumeName := Format('\\.\%s:',[Driver]);
  hDevice := CreateFile(
          PChar(VolumeName),
          GENERIC_READ or GENERIC_WRITE,
          FILE_SHARE_READ or FILE_SHARE_WRITE,
          Nil,
          OPEN_EXISTING,
          FILE_FLAG_NO_BUFFERING,
          0
          );
  if hDevice = INVALID_HANDLE_VALUE then
     Exit;
  DeviceIoControl(
        hDevice,
        FSCTL_LOCK_VOLUME,
        Nil,
        0,
        Nil,
        0,
        BytesReturned,
        Nil
        );
  DeviceIoControl(
        hDevice,
        IOCTL_VCD_CLOSE_FILE,
        Nil,
        0,
        Nil,
        0,
        BytesReturned,
        Nil
        );
  DeviceIoControl(
        hDevice,
        FSCTL_DISMOUNT_VOLUME,
        Nil,
        0,
        Nil,
        0,
        BytesReturned,
        Nil
        );
  DeviceIoControl(
        hDevice,
        FSCTL_UNLOCK_VOLUME,
        Nil,
        0,
        Nil,
        0,
        BytesReturned,
        Nil
        );

  FileClose(hDevice);
end;

Function GetDeviceInfo(const Driver:Char):VCD_DEVICE_INFORMATION;
var
  VolumeName              : String;
  hDevice                 : THandle;
  BytesReturned           : DWORD;
begin
  ZeroMemory(@Result, sizeof(VCD_DEVICE_INFORMATION));
  VolumeName := Format('\\.\%s:',[Driver]);
  hDevice := CreateFile(
        PChar(VolumeName),
        GENERIC_READ or GENERIC_WRITE,
        FILE_SHARE_READ or FILE_SHARE_WRITE,
        Nil,
        OPEN_EXISTING,
        FILE_FLAG_NO_BUFFERING,
        0
        );
  if hDevice = INVALID_HANDLE_VALUE then
     Exit;
  if not DeviceIoControl(
        hDevice,
        IOCTL_VCD_QUERY_DEVICE,
        Nil,
        0,
        @Result,
        SizeOf(VCD_DEVICE_INFORMATION),
        BytesReturned,
        Nil
        ) then
  begin
    CloseHandle(hDevice);
    Exit;
  end;      

  CloseHandle(hDevice);
end;

Function IsVCD(const Driver:Char):Boolean;
begin
  Result := GetDeviceInfo(Driver).Magic = DEVICE_MAGIC;
end;

Function GetVCDDriver(DeviceIndex:Integer):Char;
  Function GetBit(Data:DWORD; ABit:Byte):Byte;
  var
    I:DWORD;
  begin
    I:=1 shl ABit;
    Result := (Data and I) shr ABit;
  end;
var
  D                : Char;
  Driver           : String;
  ADrivers,cDriver : DWORD;
  DeviceInfo       : VCD_DEVICE_INFORMATION;
begin
  Result := #0;
  ADrivers := GetLogicalDrives();
  for D := 'A' to 'Z' do
  begin
    Driver := D +':';
    cDriver := ord(D) - ord('A');
    if (GetBit(ADrivers, cDriver) = 1)
       and(GetDriveType(Pchar(Driver))=DRIVE_CDROM) then
    begin
      DeviceInfo := GetDeviceInfo(D);
      if (DeviceInfo.Magic = DEVICE_MAGIC)and
         (DeviceIndex = DeviceInfo.Index) then
      begin
        Result := D;
        Exit;
      end;
    end;
  end;
end;

end.