Getallusers-Pfade: Notlösung

[Go2EITS]

@Luckie
Hab gegugt und den schnell geschrieben (vor 3 Monaten noch undenkbar) und getestet und es läuft unter XP/Windows2000.

Delphi-Quellcode:

Function GetProfilesDir:String;
var
  Reg: TRegistry;
  Dir,Systemdrive:String;
  begin
  result:='';Dir:='';
  Reg := TRegistry.Create;
  try
  with Reg do
  begin
  RootKey := HKEY_LOCAL_MACHINE;
  OpenKey('SOFTWARE\Microsoft\Windows NT\CurrentVersion\Profilelist', False);
  Dir:=ReadString('ProfilesDirectory');
  // Systemdrive
  Systemdrive:=Expandenvironment('%Systemdrive%');
  // Ergebnis von '%Systemdrive%' "befreien"
  delete(dir,1,13);
  // Systemdrive + Dir =
  Result:=Systemdrive+dir;;
  CloseKey;
  Free;
  end;
  except on E:Exception do
     begin
     ShowMessage('Registry: Lesen von SOFTWARE\Microsoft\Windows NT\CurrentVersion\Profilelist fehlgeschlagen');
     end;
end;
end;

Danke Luckie! Man soll doch den Tag nicht vor dem Abend loben!
Beste Grüße
Go2EITS

[Luckie]

Deine Exception wird nie ausgelöst werden. API Funktionen lösen keine Exception aus. Dafür geben sie aber Rückgabewerte zurück, die man auswerten kann, wie zum Beispiel bei OpenRegistry.

[Go2EITS]

@Luckie:
Danke für den Hinweis. Nachstehend das Ergebnis, das mir Eurer Hilfe entstanden ist!

Da hier ein Missverstänis vorliegt:
Ich will alle Benutzer unter "Dokumente und Einstellungen".
Also nicht nur C:\Dokumente und Einstellungen\All Users sondern alle Einträge.
Admin, All Users, Default User, und andere Benutzer, die in unter "Dokumente und Einstellungen"
stehen. Das ist mit dem Thread und der "Notlösung" die nun eine gute, variable Lösung geworden ist. DP sei Dank!

Wir brauchen zuerst:
function ExpandEnvironment(const strValue: string): string;
function GetProfilesDir:String;
und dann die Hauptprocedure:
procedure GetAllUser;

Delphi-Quellcode:

function ExpandEnvironment(const strValue: string): string;
var
  chrResult: array[0..1023] of Char;
  wrdReturn: DWORD;
begin
  wrdReturn := ExpandEnvironmentStrings(PChar(strValue), chrResult, 1024);
  if wrdReturn = 0 then
    Result := strValue
  else
  begin
    Result := Trim(chrResult);
  end;
end;

function GetProfilesDir:String;
var
  Reg: TRegistry;
  Dir,Systemdrive:String;
  begin
  result:='';Dir:='';
  Reg := TRegistry.Create;
  with Reg do
      begin
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKey('SOFTWARE\Microsoft\Windows NT\CurrentVersion\Profilelist', False) then
         begin
         Dir:=ReadString('ProfilesDirectory');
         // Systemdrive
         Systemdrive:=Expandenvironment('%Systemdrive%');
         // Ergebnis von '%Systemdrive%' "befreien"
         Delete(Dir,1,13);
         // Systemdrive + Dir = ? Ergebnis
         Result:=Systemdrive+Dir;;
         CloseKey;
         end;
      Free;
     end;
end;

Procedure GetAllUser;
var
  srSearch: TSearchRec;
  sSearchPath: string;
  i: Integer;
  sRootDir:string;
begin
   // z. b. C:\Dokumente und Einstellungen
   sRootDir:=GetProfilesDir;
  // Sicherheitsabfrage
   If DirectoryExists(srootdir) then
      begin
      u := TStringList.Create;
      u.BeginUpdate;
      try
      sSearchPath :=IncludeTrailingPathDelimiter(sRootDir);
      if FindFirst(sSearchPath + '*', faDirectory or faHidden, srSearch) = 0 then
         repeat
         if ((srSearch.Attr and faDirectory) = faDirectory) and
            (srSearch.Name <> '.') and
            (srSearch.Name <> '..')then
            u.Add(sSearchPath + srSearch.Name);
         until (FindNext(srSearch) <> 0);
      FindClose(srSearch);
      finally
      u.EndUpdate;
      end;//TRY...
      end;// IF...
end;

So. Nun noch:

Delphi-Quellcode:

// Im VAR-Teil der Unit/Form eine TStringlist Namens "u" anlegen: 
var u:TStringList; // Da stehen die Userpfade dann drin

Bitte unter Form.close ein
FreeAndNil(u); einfügen, damit die Stringlist "u" sauber gelöscht wird.

Und so rufe ich mal die Procedure (über Button auf der Form) auf:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject); 
  var i:Integer; 
begin 
      GetAllUser; 
      // Nur zum Testen notwendig: 
      showmessage('Anzahl User: '+(inttostr(u.count))); 
      for i:=0 to U.count-1 do ShowMessage('UserPfade: '+u[i]); 
end;

PS: Code aus Compiler übernommen und nicht "aus dem Kopf" geschrieben! Müsste "fehlerfrei" sein.
Viel Vergnügen!
Go2EITS

[shmia]

Hier nochmal der richtige Code zum Auslesen des Profilverzeichnisses:

Delphi-Quellcode:

interface

function GetProfilesDirectoryA(lpProfilesDir: LPSTR; var lpcchSize: DWORD): BOOL; stdcall;
{$EXTERNALSYM GetProfilesDirectoryA}
function GetProfilesDirectoryW(lpProfilesDir: LPWSTR; var lpcchSize: DWORD): BOOL; stdcall;
{$EXTERNALSYM GetProfilesDirectoryW}
function GetProfilesDirectory(lpProfilesDir: LPTSTR; var lpcchSize: DWORD): BOOL; stdcall;
{$EXTERNALSYM GetProfilesDirectory}

implementation

const
   userenvlib = 'userenv.dll';

function GetProfilesDirectoryA; external userenvlib name 'GetProfilesDirectoryA';
function GetProfilesDirectoryW; external userenvlib name 'GetProfilesDirectoryW';
function GetProfilesDirectory; external userenvlib name 'GetProfilesDirectoryA';

function LeseBenutzerProfilVerzeichnis:string;
var
   len : DWORD;
   begin
   len := 264;
   SetLength(result, len);
   if not GetProfilesDirectoryA(PChar(Result), len) then
      RaiseLastWin32Error;
   SetLength(Result, len);
end;

Über die JEDI API Library ( http://jedi-apilib.sourceforge.net/ ) erhält man Zugriff auf alle
Funktionen der DLL userenv.dll.
Reinschauen lohnt sich.

[himitsu]

Eine Frage:
Wieso eigentlich 264?

Zitat:

len := 264;

PS:
MAX_PATH = 260
Und in Windows kann ein Pfad in der Ansi-Version nicht länger als 259 Zeichen ( + #0 ) sein.
Also maximal 256 Zeichen im Dateisystemtreiber + 3 für's Laufwerk (z.B. "A:\")