Drives - mapeando um drive virtual (subst)

// funcões que chamam o subst

procedure UnmapVirtualDrive(const Drive: Char);

begin

  if (GetDriveType(PChar(Drive + ':\')) <> DRIVE_FIXED) Then

    raise Exception.Create('[' + Drive + ':\] não é um drive virtual');

  WinExec(PChar('subst /d ' + Drive + ': '), SW_HIDE);

  Sleep(250); //give some time for the execution

  if (GetDriveType(PChar(Drive + ':\')) > 1) then

    raise Exception.Create('Erro ao mapear o drive virtual ['+Drive+':\]')

end;

function MapVirtualDrive(Const Drive:Char; Const Path:String):Boolean;

var

  DType: Integer;

begin

  DType:=GetDriveType(PChar(Drive + ':\'));

  if (DType = DRIVE_FIXED) then

  begin

    if (MessageDlg('Drive [' + Drive + ':\] já existe, quer substitui-lo?', mtWarning, [mbYes, mbNo, mbCancel], 0) = mrYes) Then

      UnmapVirtualDrive(Drive)

  end

  else if (DType > 1) then

    raise Exception.Create('Drive ' + Drive + ':\  cannot be maped (drive not overwritable)');

  WinExec(PChar('subst ' + Drive + ': ' + Path), SW_HIDE);

  Sleep(250); //give some time for the execution

  Application.ProcessMessages;

  Result:= GetDriveType(PChar(Drive + ':\')) = DRIVE_FIXED

end;

// exemplo

procedure TForm1.Button1Click(Sender: TObject);

begin

  if (MapVirtualDrive(Edit1.Text[1], Edit2.Text)) then

    ShowMessage('Virtual Drive [' + Edit1.Text + '] criado')

  else

    ShowMessage('Não foi possivel mapear o drive virtual [' + Edit1.Text + ']')

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

  UnmapVirtualDrive(Edit1.Text[1]);

  ShowMessage(Edit1.Text+' desmapeamento com sucesso')

end;

// lista os drives e seus tipos

procedure ListDrives(DrivesStrs: TStrings);

var

  Drive      : Char;

  DriveLetter: string[4];

  sDriveType : string;

begin

  DrivesStrs.Clear;

  for Drive := 'A' to 'Z' do

  begin

    DriveLetter := Drive + ':\';

    sDriveType  := '';

    Case GetDriveType(PChar(Drive + ':\')) Of

      DRIVE_REMOVABLE:  sDriveType := 'Floppy';

      DRIVE_FIXED:      sDriveType := 'Fixed';

      DRIVE_REMOTE:     sDriveType := 'Network';

      DRIVE_CDROM:      sDriveType := 'CD-ROM';

      DRIVE_RAMDISK:    sDriveType := 'RAM Disk';

    End;

    if sDriveType <> '' then

    begin

      sDriveType := sDriveType + ' Drive ';

      DrivesStrs.Add(Format('Drive %s:', [Drive])+' - '+sDriveType);

    end;

  end;

end;

// exemplos

procedure TForm1.Button3Click(Sender: TObject);

begin

  ListDrives(Memo1.Lines);

end;