// kopiert aus Unit filectrl und etwas vereinfacht
function VolumeID(DriveChar: Char):
string;
var
OldErrorMode: Integer;
NotUsed, VolFlags: DWORD;
Buf:
array [0..MAX_PATH]
of Char;
begin
OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
Buf[0] := #$00;
if GetVolumeInformation(PChar(DriveChar + '
:\'), Buf, DWORD(sizeof(Buf)),
nil, NotUsed, VolFlags,
nil, 0)
then
SetString(Result, Buf, StrLen(Buf))
else Result := '
';
Result := Format('
[%s]',[Result]);
finally
SetErrorMode(OldErrorMode);
end;
end;
function NetworkVolume(DriveChar: Char):
string;
var
Buf:
Array [0..MAX_PATH]
of Char;
DriveStr:
array [0..3]
of Char;
BufferSize: DWORD;
begin
BufferSize := sizeof(Buf);
DriveStr[0] := UpCase(DriveChar);
DriveStr[1] := '
:';
DriveStr[2] := #0;
if WNetGetConnection(DriveStr, Buf, BufferSize) = WN_SUCCESS
then
begin
//Stringlänge angepasst
SetString(Result, Buf, StrLen(Buf));
end
else
Result := VolumeID(DriveChar);
end;
procedure TForm1.FormCreate(Sender: TObject);
var DriveChar: AnsiChar;
DriveName: AnsiString;
begin
ListBox1.Items.BeginUpdate;
try
ListBox1.Items.Clear;
for DriveChar := '
A'
to '
Z'
do
begin
DriveName := NetworkVolume(DriveChar);
if DriveName <> '
[]'
then
ListBox1.Items.Add(Format('
%s: (%s)',[DriveChar,DriveName]));
end;
finally
ListBox1.Items.EndUpdate;
end;
end;