Ich schreibe gerade ein Testprogramm (für Administratoren) um alle Benutzer zu ermitteln, für die ein Profil existiert. Für ausgewählte Profile soll dann später der entsprechende User-Ast der Registry geladen werden und dort bestimmte Einstellungen durchgeführt werden.
Grundsätzlich funktioniert auch alles so wie beabsichtigt. Für die endgültige Implementierung wollte ich aber noch etwas "aufräumen" und allgemein benutzbare Funktionen realisieren.
Dabei ist ein Problem aufgetauch, dass
LOOKUPACCOUNTSID in einer Prozedur nur dann funktioniert, wenn diese mit max. 2 string Parametern aufgerufen wurde.
Ich erhalte folgende Fehlermeldung:
Der an einen Systemaufruf übergebene Datenbereich ist zu klein.
Variante die funktioniert:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
| procedure TForm2.Button3Click(Sender: TObject);
var
RegistryZugriff: TRegistry;
VorhandeProfile: TStringList;
i: integer;
resourcestring
rsProfilschluessel = '\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\';
begin
CheckListBox2.Items.Clear;
RegistryZugriff := TRegistry.Create(KEY_READ);
VorhandeProfile := TStringList.Create;
try
RegistryZugriff.RootKey := HKEY_LOCAL_MACHINE;
if not RegistryZugriff.OpenKey(rsProfilschluessel, false) then
exit;
RegistryZugriff.GetKeyNames(VorhandeProfile);
RegistryZugriff.CloseKey;
for i := 1 to VorhandeProfile.Count do
if RegistryZugriff.OpenKey(rsProfilschluessel + VorhandeProfile[i - 1], false) then
try
ProfileintragAuslesenVariante2(RegistryZugriff);
finally
RegistryZugriff.CloseKey;
end;
finally
VorhandeProfile.Free;
RegistryZugriff.Free;
end;
end;
procedure TForm2.ProfileintragAuslesenVariante2(RegistryZugriff: TRegistry);
var
UserName: string;
begin
if ProfileintragAnalysierenVariante2(UserName, RegistryZugriff) then
CheckListBox2.Items.Add(UserName);
end;
function TForm2.ProfileintragAnalysierenVariante2(var Benutzer: string; AktProfil: TRegistry):
boolean;
var
puser: PSidAndAttributes;
userName, domainName: array[0..256] of char;
userNameLen, domainNameLen: DWORD;
use: Sid_Name_Use;
begin
result := false;
GetMem(puser, 65536);
try
if AktProfil.ReadBinaryData('SID', puser^, 65536) > 0 then
begin
if LookupAccountSid(nil, puser, userName, userNameLen, domainName,
domainNameLen, Use) then
begin
Benutzer := string(UserName);
result := true;
end
else
begin
ShowMessage(FormatAPIMessage(GetLastError));
end;
end;
finally
FreeMem(puser);
end;
end; |
Variante die nicht funktioniert:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
| procedure TForm2.Button1Click(Sender: TObject);
var
RegistryZugriff: TRegistry;
VorhandeProfile: TStringList;
i: integer;
resourcestring
rsProfilschluessel = '\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\';
begin
CheckListBox2.Items.Clear;
RegistryZugriff := TRegistry.Create(KEY_READ);
VorhandeProfile := TStringList.Create;
try
RegistryZugriff.RootKey := HKEY_LOCAL_MACHINE;
if not RegistryZugriff.OpenKey(rsProfilschluessel, false) then
exit;
RegistryZugriff.GetKeyNames(VorhandeProfile);
RegistryZugriff.CloseKey;
for i := 1 to VorhandeProfile.Count do
begin
if RegistryZugriff.OpenKey(rsProfilschluessel + VorhandeProfile[i - 1], false) then
try
ProfileintragAuslesenVariante1(RegistryZugriff);
finally
RegistryZugriff.CloseKey;
end;
end;
finally
VorhandeProfile.Free;
RegistryZugriff.Free;
end;
end;
procedure TForm2.ProfileintragAuslesenVariante1(RegistryZugriff: TRegistry);
var
UserName, DomainName, Pfad: string;
begin
if ProfileintragAnalysierenVariante1(UserName, DomainName, Pfad, RegistryZugriff) then
CheckListBox2.Items.Add(DomainName + '\\' + UserName + ';' + Pfad);
end;
function TForm2.ProfileintragAnalysierenVariante1(var Benutzer, Domaine, Pfad: string;
AktProfil: TRegistry): boolean;
var
puser: PSidAndAttributes;
userName, domainName: array[0..256] of char;
userNameLen, domainNameLen: DWORD;
use: Sid_Name_Use;
begin
result := false;
GetMem(puser, 65536);
try
if AktProfil.ReadBinaryData('SID', puser^, 65536) > 0 then
begin
if LookupAccountSid(nil, puser, userName, userNameLen, domainName,
domainNameLen, Use) then
begin
Pfad := AktProfil.ReadString('ProfileImagePath');
if Trim(Pfad) <> '' then
begin
Benutzer := string(UserName);
Domaine := string(DomainName);
Pfad := Pfad;
result := true;
end;
end
else
begin
ShowMessage(FormatAPIMessage(GetLastError));
end;
end;
finally
FreeMem(puser);
end;
end; |
Hat jemand in diesem Forum eine Idee womit die Probleme zusammenhängen könnten?
Zur Info: Ich benutze Delphi 6 Enterprise (Build 6.240) Update Pack 2
Danke Markus
