procedure NetUse(ts: TStrings); 
const 
  cbBuffer: DWORD = 16384; 
var 
  hEnum: THandle; 
  i, cEntries, dwResult: DWORD; 
  p, lpnrDrv: PNetResourceA; 
begin 
  ts.clear; 
  dwResult := WNetOpenEnum(RESOURCE_CONNECTED, RESOURCETYPE_DISK, 
    0, nil, hEnum); 
  if dwResult <> NO_ERROR then begin 
    ts.add('Netz-Laufwerke nicht ermittelbar.'); 
    exit; 
  end; 
  cEntries := $FFFFFFFF; 
  lpnrDrv := PNetResourceA(GlobalAlloc(GPTR, cbBuffer)); 
  repeat 
    dwResult := WNetEnumResource(hEnum, cEntries, lpnrDrv, cbBuffer); 
    if (dwResult = NO_ERROR) then begin 
      p := lpnrDrv; 
      for i := 0 to cEntries - 1 do 
      begin 
        if p^.lpLocalName <> nil then 
          ts.add(StrPas(p^.lpLocalName) + #32#32 + StrPas(p^.lpRemoteName)); 
        inc(p); 
      end; 
    end; 
  until (dwResult = ERROR_NO_MORE_ITEMS); 
  GlobalFree(HGLOBAL(lpnrDrv)); 
  WNetCloseEnum(hEnum); 
  if ts.count = 0 then ts.add('Keine Netz-Laufwerke gefunden.'); 
end; 
 
// Beispielaufruf 
procedure TForm1.Button1Click(Sender: TObject); 
var sl: TStringlist; 
begin 
  sl := TStringlist.create; 
  sl.sorted := true; 
  netuse(sl); 
  Memo1.lines := sl; 
  sl.free; 
end;