Buchstabenpfade nicht doppelt auflisten

[DeddyH]

Meinst Du nun so etwas?

Delphi-Quellcode:

// 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;