GetDrive

Kratosx

Новичок
I want to remove the directory from combobox leaving only see drives





Код:
#define GameName "My Program"
#define GamePublisher "Inno Setup"
;#define GameExe "myprog.exe"


[Setup]
AppName={#GameName}
AppVerName={#GameName}
DefaultDirName={pf}\{#GamePublisher}\{#GameName}
DefaultGroupName={#GameName}
Compression=none

[Code ]
type
TDrive = record
Letter,VolumeName,FileSystemName: string;
FreeSpace,PSize: Cardinal;
end;
var
ResetBtn,ExitBtn:TButton;
StartMenuFolderTreeView: TStartMenuFolderTreeView;
Group: TEdit;
BrowseForm1,GroupForm: TSetupForm;
DirTreeView1: TFolderTreeView;
Edit1: TNewEdit;
FreeMB, TotalMB: Cardinal;
DrivesComboBox:TNewComboBox;
DrivesCheckBox:TNewCheckBox;
Drive: String;
Arrayc: integer;
FixedDrivesInfo: array of TDrive;

const
MAX_PATH         =255;
DRIVE_FIXED       = 3;
//DRIVE_UNKNOWN     = 0; //unknown
//DRIVE_NO_ROOT_DIR = 1; //Root path invalid
//DRIVE_REMOVABLE   = 2; //Removable
//DRIVE_REMOTE      = 4; //Network
//DRIVE_CDROM       = 5; //DVD-ROM and CD-ROM
//DRIVE_RAMDISK     = 6; //Ram disk


function GetDriveType(lpDisk: String): Integer; external 'GetDriveTypeW@kernel32.dll stdcall setuponly';
function GetVolumeInformation (
lpRootPathName,lpVolumeNameBuffer: PAnsiChar;
nVolumeNameSize: longint;
lpVolumeSerialNumber,lpMaximumComponentLength: Cardinal;
lpFileSystemFlags: Cardinal;
lpFileSystemNameBuffer: PAnsiChar;
nFileSystemNameSize: dword): longword;
external 'GetVolumeInformationW@kernel32.dll stdcall setuponly';

Function GetFixedDrivesInfo(): Array of Tdrive;
Var
l:string;
s,c,n: integer;
Vl: array of String;
t: pansichar;
Begin
l:='ABCDEFGHIJKLMNOPQRSTUWXYZ';
for c:=1 to length(l) do begin
if GetDriveType(l[c]+':')=DRIVE_FIXED then
begin
n:=GetArrayLength(Result);
s:=GetArrayLength(Vl);
SetArrayLength(Result,n+1);
SetArrayLength(Vl,s+1);
Vl[s]:=StringOfChar(' ',256);
GetVolumeInformation (l[c]+':',Vl[s],MAX_PATH,0,0,0,PAnsiChar(t),MAX_PATH);
GetSpaceOnDisk(l[c]+':', True, FreeMB, TotalMB)
Result[n].Letter:=l[c]+':';
Result[n].VolumeName:=Trim(Vl[s]);
Result[n].FreeSpace:=FreeMB;
Result[n].PSize:=TotalMB;
end;
end;
End;

procedure DrivesItemOnClick(Sender: TObject);
Var AppFolder: string;
begin
AppFolder:=Copy(WizardForm.DirEdit.Text, 3, length(WizardForm.DirEdit.Text));
WizardForm.DirEdit.Text:=FixedDrivesInfo[TNewComboBox(sender).ItemIndex].Letter + AppFolder;
end;

procedure CloseBtnClick(Sender:TObject);
begin
WizardForm.Close;
end;

procedure Drives();
begin
DrivesComboBox := TNewComboBox.Create(WizardForm);
DrivesComboBox.Parent:=WizardForm;
DrivesComboBox.SetBounds(30,35,332,10);
DrivesComboBox.Style:=csDropDown;
DrivesComboBox.Font.Size:=8;
DrivesComboBox.Font.Name:='Arial';
DrivesComboBox.OnClick:=@DrivesItemOnClick;
FixedDrivesInfo:=GetFixedDrivesInfo();
for Arrayc:=0 to GetArraylength(FixedDrivesInfo) -1 do begin
DrivesComboBox.Items.add(FixedDrivesInfo[Arrayc].Letter+chr(32));
end;
DrivesComboBox.ItemIndex:=0;
end;

procedure DirFolderChange1(Sender: TObject);
begin
if DirTreeView1.Directory <> WizardForm.DirEdit.Text then
Edit1.Text := AddBackslash(DirTreeView1.Directory) + ExpandConstant('{#GamePublisher}\{#GameName}')
else
Edit1.Text := DirTreeView1.Directory;
end;

procedure BackClick(Sender: TObject);
begin
Edit1.Text:=AddBackslash(ExpandConstant('{pf}\')+'{#GameName}');
DirTreeView1.ChangeDirectory(AddBackslash(ExpandConstant('{pf}\{#GamePublisher}')), True);
end;

procedure NewClick(Sender: TObject);
begin
DirTreeView1.CreateNewDirectory('{#GameName}~'+ SetupMessage(msgNewFolderName));
Edit1.Text:=AddBackslash(DirTreeView1.Directory) + '{#GamePublisher}';
end;

procedure BrowseForm_Buttons_OnClick(Sender: TObject);
begin
if Edit1.Text <> WizardForm.DirEdit.Text then WizardForm.DirEdit.Text := Edit1.Text;
DrivesComboBox.Text:=WizardForm.DirEdit.Text;
end;

procedure BrowseClick(Sender: TObject);
begin
BrowseForm1 := CreateCustomForm();
with BrowseForm1 do
begin
ClientWidth:=451;
ClientHeight:=320;
Caption := SetupMessage(msgBrowseDialogTitle);
CenterInsideControl(WizardForm, False);

with TLabel.Create(nil) do
begin
SetBounds(5,5,300,15);
Caption := SetupMessage(msgBrowseDialogLabel);
Parent := BrowseForm1;
end;

DirTreeView1 := TFolderTreeView.Create(nil)
with DirTreeView1 do
begin
SetBounds(5,51,355,260);
OnChange := @DirFolderChange1;
Parent := BrowseForm1;
end;

Edit1 := TNewEdit.Create(nil);
with Edit1 do
begin
SetBounds(5,25,440,15);
Text := DirTreeView1.Directory;
Parent := BrowseForm1;
end;

with TButton.Create(nil) do
begin
SetBounds(365, 138, 80, 25);
Parent := BrowseForm1;
Caption := SetupMessage(msgButtonCancel);
ModalResult := mrCancel;
end;

with TButton.Create(nil) do
begin
SetBounds(365, 76, 80, 25);
Parent := BrowseForm1;
Caption := SetupMessage(msgButtonOK);
OnClick := @BrowseForm_Buttons_OnClick;
ModalResult := mrOk;
end;

with TButton.Create(nil) do
begin
SetBounds(365, 200, 80, 25);
Parent := BrowseForm1;
Caption := 'Default';
OnClick := @BackClick;
end;

with TButton.Create(nil) do
begin
SetBounds(365, 262, 80, 25);
Parent := BrowseForm1;
Caption := 'New Folder';
OnClick := @NewClick;
end;

DirTreeView1.ChangeDirectory(AddBackslash(WizardForm.DirEdit.Text), True);
ShowModal;
Free;
end;
end;

procedure StartMenuFolderTreeViewChange(Sender: TObject);
begin
if TStartMenuFolderTreeView(Sender).Directory <> WizardGroupValue
then Group.Text := AddBackslash(StartMenuFolderTreeView.Directory)+'{#SetupSetting("DefaultGroupName")}'
else Group.Text := TStartMenuFolderTreeView(Sender).Directory;
end;

procedure Group_Buttons_OnClick(Sender: TObject);
begin
case TButton(Sender).Caption of
'Default':
begin
Group.Text := RemoveBackslash(ExpandConstant('{#SetupSetting("DefaultGroupName")}'));
end;
SetupMessage(msgButtonNewFolder):
begin
StartMenuFolderTreeView.CreateNewDirectory('{#GameName}');
Group.Text := AddBackslash(StartMenuFolderTreeView.Directory) + '{#SetupSetting("DefaultGroupName")}';
end;
SetupMessage(msgButtonOK):
if Group.Text <> WizardForm.GroupEdit.Text then WizardForm.GroupEdit.Text := Group.Text;
end;
end;

procedure GroupClick(Sender: TObject);
begin
GroupForm := CreateCustomForm();
with GroupForm do begin
ClientWidth := 452;
ClientHeight := 260;
Position := poScreenCenter;
Caption := #32 + SetupMessage(msgBrowseDialogTitle);

with TLabel.Create(nil) do
begin
SetBounds(7, 4, 207, 17);
Caption := SetupMessage(msgBrowseDialogLabel);
Parent := GroupForm;
end;

StartMenuFolderTreeView := TStartMenuFolderTreeView.Create(nil)
with StartMenuFolderTreeView do
begin
SetBounds(4, 54, 443, 200);
OnChange := @StartMenuFolderTreeViewChange;
Parent := GroupForm;
end;

ActiveControl := StartMenuFolderTreeView;
Group := TEdit.Create(nil);
with Group do
begin
SetBounds(4, 26, 190, 21);
Text := AddBackslash(StartMenuFolderTreeView.Directory)+'{#SetupSetting("DefaultGroupName")}';
Parent := GroupForm;
end;

with TButton.Create(nil) do
begin
SetBounds(283, 24, 80, 25);
Parent := GroupForm;
Caption := SetupMessage(msgButtonOK);
OnClick := @Group_Buttons_OnClick;
ModalResult := mrOk;
end;

ResetBtn := TButton.Create(nil)
with ResetBtn do
begin
SetBounds(199, 24, 80, 25);
Parent := GroupForm;
Caption := 'Default';
OnClick := @Group_Buttons_OnClick;
end;

with TButton.Create(nil) do
begin
SetBounds(367, 24, 80, 25);
Parent := GroupForm;
Caption := SetupMessage(msgButtonCancel);
ModalResult := mrCancel;
end;

StartMenuFolderTreeView.SetPaths(ExpandConstant('{userprograms}'),
ExpandConstant('{commonprograms}'),
ExpandConstant('{userstartup}'),
ExpandConstant('{commonstartup}'));
StartMenuFolderTreeView.ChangeDirectory(AddBackslash(WizardForm.GroupEdit.Text), True);
ShowModal;
Free;
end;
end;

procedure InitializeWizard;
begin
with WizardForm do begin
Drives();
Position:=poScreenCenter;
InnerNotebook.Hide;
OuterNotebook.Hide;
ClientWidth:=482;
ClientHeight:=150;
Bevel.Hide;
CancelButton.Left:=-left;
NextButton.Caption:=SetupMessage(msgButtonInstall);
BackButton.Left:=9999;
NextButton.SetBounds(0,0,0,0);

DirEdit.Parent:=WizardForm;
DirEdit.SetBounds(30,10,332,21);

DirBrowseButton.Parent:=WizardForm;
DirBrowseButton.SetBounds(371,8,80,23);

GroupBrowseButton.Parent:=WizardForm;
GroupBrowseButton.SetBounds(371,88,80,23);

GroupEdit.Parent:=WizardForm;
GroupEdit.SetBounds(30,90,335,21);
end;

WizardForm.DirBrowseButton.OnClick:=@BrowseClick;
WizardForm.GroupBrowseButton.OnClick:=@GroupClick;
end;

function ShouldSkipPage(PageID: Integer): Boolean;
begin
if (PageID=wpSelectDir)
or (PageID=wpSelectProgramGroup)
or (PageID=wpSelectDir)
or (PageID=wpSelectComponents)
or (PageID=wpReady)
then Result:=true;
end;

procedure CancelButtonClick(CurPageID: Integer; var Cancel, Confirm: Boolean);
begin
Confirm:=False;
end;
 
Последнее редактирование:

Ramiro Cruzo

Новичок
:p Am not gonna write the whole code, just use the following code to get Drives List in a TStringList and then use it into your ComboBox:
Код:
function GetDriveType(lpRootPathName: string): UINT;
  external 'GetDriveType{#AW}@kernel32.dll stdcall';
function GetLogicalDriveStrings(nBufferLength: DWORD; lpBuffer: string): DWORD;
  external 'GetLogicalDriveStrings{#AW}@kernel32.dll stdcall';

#ifndef UNICODE
function IntToDriveType(Value: UINT): TDriveType;
begin
  Result := dtUnknown;
  case Value of
    1: Result := dtNoRootDir;
    2: Result := dtRemovable;
    3: Result := dtFixed;
    4: Result := dtRemote;
    5: Result := dtCDROM;
    6: Result := dtRAMDisk;
  end;
end;
#endif

function GetLogicalDrives(Filter: TDriveTypes; Drives: TStrings): Integer;
var
  S: string;
  I: Integer;
  DriveRoot: string;
begin
  Result := 0;

  I := GetLogicalDriveStrings(0, #0);
  if I > 0 then
  begin
    SetLength(S, I);
    if GetLogicalDriveStrings(Length(S), S) > 0 then
    begin
      S := TrimRight(S) + #0;
      I := Pos(#0, S);
      while I > 0 do
      begin
        DriveRoot := Copy(S, 1, I - 1);
        #ifdef UNICODE
        if (Filter = []) or
          (TDriveType(GetDriveType(DriveRoot)) in Filter) then
        #else
        if (Filter = []) or
          (IntToDriveType(GetDriveType(DriveRoot)) in Filter) then
        #endif
        begin
          Drives.Add(DriveRoot);
        end;
        Delete(S, 1, I);
        I := Pos(#0, S);
      end;
      Result := Drives.Count;
    end;
  end;
end;
This returns drive names as C:\, D:\, etc
 
Сверху