segunda-feira, 13 de julho de 2015

Alterar letra de disco/unidade no Windows - Código fonte em Free Pascal para Lazarus ou Delphi

Segue o código fonte de um pequeno aplicativo para alterar a letra de unidade de um disco rígido, pendrive ou drive de CD/DVD, para Windows. Pode ser compilado no Lazarus ou no Delphi.
Será necessário adicionar os componentes conforme a declaração Type. Não alterei os nomes dos componentes, pois o aplicativo deveria servir apenas para testes.
O código pode ser melhorado, mas já é funcional.
Para rodar depois de compilado, deverá ser executado como administrador(botão direito no executável=>executar como administrador).

unit Unit1;

{$mode objfpc}{$H+}
{$R *.lfm}
interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, JwaWinBase;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);

  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation


var
  Drive: Char;
  DriveLetter: string;
  VolumeName : String;
{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  if (combobox1.ItemIndex = -1) or (ComboBox2.ItemIndex = -1)
  then Showmessage('Selecione todas as opções!') else
    begin
    GetVolumeNameForVolumeMountPoint(Pchar(copy(ComboBox1.Items[ComboBox1.ItemIndex], 1, 3)), Pchar(VolumeName), 50);
    DeleteVolumeMountPoint(Pchar(copy(ComboBox1.Items[ComboBox1.ItemIndex], 1, 3)));
    SetVolumeMountPoint(Pchar(ComboBox2.Items[ComboBox2.ItemIndex]+':\'), Pchar(VolumeName));
    ShowMessage((ComboBox1.Items[ComboBox1.ItemIndex]) + ' alterado para ' + (ComboBox2.Items[ComboBox2.ItemIndex]) + ':\');
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  for Drive := 'A' to 'Z' do
  begin
    DriveLetter := Drive + ':\';
    if GetDriveType(PChar(DriveLetter)) = DRIVE_UNKNOWN then
       ComboBox1.Items.Add(DriveLetter + ' Dispositivo Desconhecido')
    else if GetDriveType(PChar(DriveLetter)) = DRIVE_REMOVABLE then
       ComboBox1.Items.Add(DriveLetter + ' Pendrive')
    else if GetDriveType(PChar(DriveLetter)) = DRIVE_FIXED then
       ComboBox1.Items.Add(DriveLetter + ' Disco Local')
    else if GetDriveType(PChar(DriveLetter)) = DRIVE_REMOTE then
       ComboBox1.Items.Add(DriveLetter + ' Unidade de rede')
    else if GetDriveType(PChar(DriveLetter)) = DRIVE_CDROM then
       ComboBox1.Items.Add(DriveLetter + ' Drive de CD/DVD')
    else if GetDriveType(PChar(DriveLetter)) = DRIVE_RAMDISK then
       ComboBox1.Items.Add(DriveLetter + ' RAM Disk')
    else
       ComboBox2.Items.Add(Drive);
    end;
  end;
  end.