نحوه به دست آوردن Label و فضای خالی هر درایو

[amir15000]

آیا میشه لیست درایوهای سیستم به همراه label آنها و فضای خالی آنها را به دست آورد

[BORHAN TEC]

راههای زیادی داره!!!

برای بدست آوردن Label مربوط به درایو:
اگر از JCL استفاده می کنید یونیت JclSysInfo را به فهرست uses اضافه کرده و سپس از تابع GetVolumeName به شکل زیر استفاده کنید:
Edit1.Text := GetVolumeName('C');


جهت بدست آوردن فضای خالی:
http://www.swissdelphicenter.ch/torry/showcode.php?id=238

به منظور بدست آوردن لیست همه درایوها:
اگر از دلفی 2010 و نسخه های بعد از آن استفاده می کنید یونیتهای IOUtils و Types را به فهرست uses اضافه کرده و از کد زیر استفاده کنید:
procedure TForm1.Button1Click(Sender: TObject);
var
S: TStringDynArray;
I: Integer;
begin
S := TDirectory.GetLogicalDrives;

for I := low(S) to high(S) do
ShowMessage(S[I]);

end;

اگر از نسخه های قدیمی هم استفاده می کنید برای این کار از کدی مثل این استفاده کنید که مربوط به کتاب Inside Delphi 2006 است:
procedure EnumerateDrives2(AList: TStrings);
var
c: Char;
begin
AList.Clear;

for c in ['A'..'Z'] do
if GetDriveType(PChar(c + ':\')) <> DRIVE_NO_ROOT_DIR then
AList.Add(c + ':\');
end;
موفق باشید...

[BORHAN TEC]

برای بدست آوردن لیبل مربوط به درایوها بدون استفاده از JCL:
قبلاً یک تابع ساده برای این کار نوشته بودم:

function VolumeName(DriveName: Char): string;
var
max, Flags: DWORD;
Buf: array [0 .. MAX_PATH] of Char;
begin
GetVolumeInformation(PChar(DriveName + ':\'), Buf, sizeof(Buf), nil, max,
Flags, nil, 0);
Result := StrPas(Buf);

if Result = '' then
begin
case GetDriveType(PWideChar(DriveName + ':\')) of
DRIVE_UNKNOWN:
Result := 'Unknown Drive';
DRIVE_NO_ROOT_DIR:
Result := 'No Root Dir';
DRIVE_REMOVABLE:
Result := 'Removable Drive';
DRIVE_FIXED:
Result := 'Fixed Drive';
DRIVE_REMOTE:
Result := 'Remote Drive';
DRIVE_CDROM:
Result := 'CDROM Drive';
DRIVE_RAMDISK:
Result := 'Ram Disk';
end;
end;

end;

توضیحات اضافی:
این تابع در صورتی که درایو Label نداشته باشد به جای رشته خالی نوع درایو را بر می گرداند که در صورت نیاز می توانید آنرا تغییر دهید.

[amir15000]

در خصوص فضای خالی هم آیا راهی هست

[lord_viper]

گرفتن لیبل یک درایو
function GetLabel(Drive: string): string;
var
VolumeName: array[0..255] of Char;
FileSystemType: array[0..255] of Char;
SerialNum: DWORD;
MaxFilenameLength: DWORD;
Flags: DWORD;
begin
if (GetVolumeInformation(
PChar(Drive),
VolumeName,
256,
@SerialNum,
MaxFilenameLength,
Flags,
FileSystemType,
256)) then
Result:=VolumeName
else
Result:='No CD Present';
end;
گرفتن فضای خالی یک درایو
function GetDiskFree(Drive: string): int64;
var
lpFreeBytesAvailableToCaller,
lpTotalNumberOfBytes,
lpTotalNumberOfFreeBytes : TLargeInteger;
begin
if GetDiskFreeSpaceEx(PChar(Drive), lpFreeBytesAvailableToCaller,lpTotalNumberOfBytes, @lpTotalNumberOfFreeBytes) then
Result := lpTotalNumberOfFreeBytes
else
Result := -1;
end;
گرفتن لیست درایوها
procedure GetDriveLetters(AList: TStrings);
var
ch:Char;
drive:string;
begin
for ch := 'c' to 'z' do
begin
drive:=ch+':\';
if GetDriveType(PChar(drive))=DRIVE_FIXED then
begin
AList.Add(drive+'DRIVE_FIXED '+GetLabel(drive)+' free space '+inttostr(GetDiskFree(drive))+' bytes');
end;
if GetDriveType(PChar(drive))=DRIVE_CDROM then
begin
AList.Add(drive+'CD-ROM Drive '+GetLabel(drive));
end;
end;
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
GetDriveLetters(lst1.Items);
end;

[Mask]

http://www.delphibasics.co.uk/RTL.asp?Name=DiskFree&ExpandCode1=Yes