FAQ DelphiConsultez toutes les FAQ

1
2
3
4
5
6
7
8
9
10
11
12
13
unit Main; 
  
interface 
  
Uses ...,LM; 
  
Type 
  TNomServerNT      = array[1..UNCLEN] of widechar; {17} 
  TNomDomainNT      = array[1..DNLEN] of widechar; {15} 
  
  TNomUserNT        = array[1..LM20_UNLEN] of widechar; {20} 
  TNomGroupNT       = array[1..UNLEN] of widechar; {256} 
...

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
74
75
76
77
uses 
  AccCtrl; 
  
type 
  PTOKEN_USER = ^TOKEN_USER; 
  TOKEN_USER = record 
    User: TSIDAndAttributes; 
  end; 
  
function GetCurrentUserAndDomain(var User, Domain: string): boolean; 
var 
  hToken: THandle; 
  ptiUser: PTOKEN_USER; 
  cbti: DWORD; 
  snu: SID_NAME_USE; 
  pcchUser, pcchDomain: DWORD; 
begin 
  result:= false; 
  hToken:= 0; 
  ptiUser:= nil; 
  cbti:= 0; 
  pcchUser:= 0; 
  pcchDomain:= 0; 
  
  try 
    { Get the calling thread's access token.} 
    if not OpenThreadToken(GetCurrentThread, TOKEN_QUERY, true, hToken) then 
    begin 
      if GetLastError <> ERROR_NO_TOKEN then 
exit; 
  
      { Retry against process token if no thread token exists.} 
      if not OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hToken) then 
exit; 
    end; 
  
    { Obtain the size of the user information in the token.} 
    if GetTokenInformation(hToken, TokenUser, nil, 0, cbti) then 
      { Call should have failed due to zero-length buffer.} 
      exit 
    else 
    begin 
      { Call should have failed due to zero-length buffer.} 
      if GetLastError <> ERROR_INSUFFICIENT_BUFFER then 
exit; 
    end; 
  
    { Allocate buffer for user information in the token.} 
    ptiUser:= PTOKEN_USER(HeapAlloc(GetProcessHeap, 0, cbti)); 
    if not Assigned(ptiUser) then 
      exit; 
  
    { Retrieve the user information from the token.} 
    if not GetTokenInformation(hToken, TokenUser, ptiUser, cbti, cbti) then 
      exit; 
  
    { Retrieve user name and domain name based on user's SID.} 
    { Delphi adaptation : 
      The first call is used to get the length of the two strings } 
  
    LookupAccountSid(nil, ptiUser.User.Sid, nil, pcchUser, nil, pcchDomain, snu); 
    Setlength(User, pcchUser); 
    Setlength(Domain, pcchDomain); 
    if not LookupAccountSid(nil, ptiUser.User.Sid, PChar(User), pcchUser, 
      PChar(Domain), pcchDomain, snu) then 
      exit; 
  
    result:= true; 
  finally 
    { Free resources.} 
    if hToken <> 0 then 
      CloseHandle(hToken); 
  
    if Assigned(ptiUser) then 
      HeapFree(GetProcessHeap, 0, ptiUser); 
  end; 
end;

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
Uses ...,LM; 
  
Function GetPDCName(LDomain:String):String; 
var 
  PDomainName, 
  Bufptr       : Pointer; 
  DomainName   : TNomDomainNT; 
  Res          : NET_API_STATUS; 
  
begin 
 Result:=''; 
 FillChar(DomainName,SizeOF(DomainName),#0); 
 PDomainName:=@DomainName; 
  
 StringtoWideChar(lDomain,@DomainName,Length(lDomain)+1); 
try 
 Res:=NetGetDCName('',PDomainName,@bufptr); 
  
  {Ne peux pas trouver le contrôleur de domaine pour ce domaine ou le nom ne peut être trouvé.} 
 if (( Res=NERR_DCNotFound) or (Res=ERROR_INVALID_NAME) ) 
  then 
   begin 
    Res:=NetGetAnyDCName('',@PDomainName,@bufptr); 
    if Res<>ERROR_SUCCESS then 
     MessageDlg('Impossible de trouver un contrôleur de domaine pour le domaine '+lDomain, mtError,[mbOk], 0); 
     Exit; 
   end; 
  
 Result:=WideCharToString(Bufptr); 
  
 Finally 
  NetApiBufferFree(BufPtr); 
 end; 
end;

MessageDlg('Le contrôleur de domaine est : '+GetPDCName('MyDomaine'), mtError,[mbOk], 0);

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
Uses ...,LM; 
  
procedure GetServerListNT(LDomain:String;ServerType:DWord;lLstServeur:TStrings); 
var 
  Res           : NET_API_STATUS; 
  
  PDomainName   : LPCWSTR; 
  
  Bufptr        : Pointer; 
  
  LocalPtr      : ^byte; 
  
  Prefmaxlen    : Cardinal; 
  
  Level, 
  Entriesread, 
  Totalentries  : DWORD; 
  Resume_handle : PDWORD; 
  
  Str           : String; 
  
  ServerInfo : TServerInfo100 ; 
  DomainName : TNomDomainNT; 
  I          : Word; 
  
begin 
 Level:=100; 
 FillChar(DomainName,SizeOF(DomainName),#0); 
 Resume_handle:=0; 
 PDomainName:=@DomainName; 
 Prefmaxlen:=$FFFFFFFF; {max} 
  
 StringtoWideChar(LDomain,@DomainName,Length(lDomain)+1); 
 Try 
  Res:=NetServerEnum(NIL,Level, Bufptr,Prefmaxlen,Entriesread,Totalentries,ServerType,PDomainName,Resume_handle); 
  
  LocalPtr:=Bufptr; 
  if (( Res=Error_Success) or (Res=Error_More_Data) ) and (Entriesread>0) 
   Then 
    for I := 0 to EntriesRead - 1 do 
    begin 
     Move(LocalPtr^,ServerInfo,SizeOf(ServerInfo)); 
     Inc(LocalPtr,SizeOf(ServerInfo)); 
     Str:=WideCharToString(ServerInfo.sv100_name); 
     lLstServeur.Add(Str); 
    end; 
  
 Finally 
  NetApiBufferFree(BufPtr); 
 end; 
end;

1
2
ListBox1.Items.Clear; 
 GetServerListNT('MyDomaine',SV_TYPE_NT,ListBox1.Items);

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
Uses ...,LM; 
  
procedure GetUserLocalGroupList(lDCServer:String;lLocalGroupName:String;lLstUserLocalGroup:TStrings); 
var 
  Res           : NET_API_STATUS; 
  
  Bufptr        : Pointer; 
  
  LocalPtr      : ^byte; 
  
  Prefmaxlen    : Cardinal; 
  
  Level, 
  Entriesread, 
  Totalentries  : DWORD; 
  Resume_handle : PDWORD; 
  
  PServerName, 
  PLocalGroupName    :PWideChar; 
  
  ServerName     : TNomServerNT; 
  LocalGroupName : TNomGroupNT; 
  LocalGroupInfo : TLocalGroupMembersInfo2; 
  I              : Word; 
  S              : String; 
  
begin 
 Level:=2; 
 Resume_handle:=0; 
 FillChar(ServerName,SizeOF(ServerName),#0); 
 FillChar(LocalGroupName,SizeOF(LocalGroupName),#0); 
 PServerName:=@ServerName; 
 PLocalGroupName:=@LocalGroupName; 
 Prefmaxlen:=$FFFFFFFF; {max} 
  
 StringtoWideChar(lDCServer,@ServerName,Length(lDCServer)+1);  
 StringtoWideChar(lLocalGroupName,@LocalGroupName,Length(lLocalGroupName)+1); 
 Try 
   Res:=NetLocalGroupGetMembers(PServername,PLocalgroupname,Level, 
             Bufptr,Prefmaxlen,Entriesread,Totalentries,Resume_handle); 
   LocalPtr:=Bufptr; 
   if Res=ERROR_ACCESS_DENIED 
    then 
     begin 
      MessageDlg('Droits insuffisant pour lire les membres du groupe local '+lLocalGroupName, mtInformation,[mbOk], 0); 
      Exit; 
     end; 
  
   if (( Res=Error_Success) or (Res=Error_More_Data) ) and (Entriesread>0) 
    Then 
     for I := 0 to EntriesRead - 1 do 
     begin 
      Move(LocalPtr^,LocalGroupInfo,SizeOf(LocalGroupInfo)); 
      Inc(LocalPtr,SizeOf(LocalGroupInfo)); 
      S:=WideCharToString(LocalGroupInfo.lgrmi2_domainandname); 
      lLstUserLocalGroup.Add(S); 
     end; 
  
 Finally 
  NetApiBufferFree(BufPtr); 
 end; 
end;

1
2
3
4
5
ListBox1.Items.Clear; 
  // Groupe local du poste exécutant l'appel 
 GetUserLocalGroupList(ComputerName,'Administrateurs',ListBox1.Items); 
 // Groupe local du PDC d'un domaine  
 GetUserLocalGroupList(AnsiReplaceStr(GetPDCName('MyDomaine'), '\\',''),'Administrateurs',ListBox1.Items);

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
Uses ...,LM; 
  
procedure GetUserGlobalGroupList(lDCServer:String;lGroupName:String;lLstUserGroup:TStrings); 
  
var 
  Res           : NET_API_STATUS; 
  
  Bufptr        : Pointer; 
  
  LocalPtr      : ^byte; 
  
  Prefmaxlen    : Cardinal; 
  
  Level, 
  Entriesread, 
  Totalentries  : DWORD; 
  Resume_handle : PDWORD; 
  
  Str           : String; 
  
  PServerName, 
  PGroupName    :PWideChar; 
  
  ServerName : TNomServerNT; 
  GroupName  : TNomGroupNT; 
  GroupInfo  : TGroupInfo0 ; 
  I          : Word; 
  
begin 
 Level:=0; 
 Resume_handle:=0; 
 FillChar(ServerName,SizeOF(ServerName),#0); 
 FillChar(GroupName,SizeOF(GroupName),#0); 
 PServerName:=@ServerName; 
 PGroupName:=@GroupName; 
 Prefmaxlen:=$FFFFFFFF; {max} 
  
 StringtoWideChar(lDCServer,@ServerName,Length(lDCServer)+1); 
 StringtoWideChar(lGroupName,@GroupName,Length(lGroupName)+1); 
 Try 
   Res:=NetGroupGetUsers(PServername,PGroupName,Level,Bufptr, 
             Prefmaxlen,Entriesread,Totalentries,Resume_handle); 
   LocalPtr:=Bufptr; 
   if Res=ERROR_ACCESS_DENIED 
    then 
     begin 
      MessageDlg('Droits insuffisant pour lire les membres du groupe global : '+LgroupName, mtInformation,[mbOk], 0); 
      Exit; 
     end; 
  
   if (( Res=Error_Success) or (Res=Error_More_Data) ) and (Entriesread>0) 
    Then 
     for I := 0 to EntriesRead - 1 do 
     begin 
      Move(LocalPtr^,GroupInfo,SizeOf(GroupInfo)); 
      Inc(LocalPtr,SizeOf(GroupInfo)); 
      Str:=WideCharToString(GroupInfo.grpi0_name); 
      lLstUserGroup.Add(Str); 
     end; 
 Finally 
  NetApiBufferFree(BufPtr); 
 end; 
end;

1
2
3
4
ListBox1.Items.Clear; 
  // Groupe Global sur le PDC NT 4.0 
 GetUserGlobalGroupList(AnsiReplaceStr(GetPDCName('MyDomaine'), '\\',''), 
'Admins du domaine',ListBox1.Items);

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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
Type 
  TNetResources = array[0..0] of TNetResource; 
  pNetResources = ^TNetResources; 
  
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Button1.Enabled:=False; 
  EnumererRessources( NIL ); 
  ShowMessage('Enumération des ressources réseaux terminée.'); 
  Button1.Enabled:=True; 
end; 
  
procedure TForm1.EnumererRessources( aRessource:pNetResource ); 
var 
  Handle       : THandle; 
  NetResources : pNetResources; 
  S            : String; 
  Size,Count, 
  Ret,Index    : LongWord; 
  
begin 
  if WNetOpenEnum( RESOURCE_GLOBALNET, //Indique l'étendue de l'énumération, ici toutes les ressources. 
                   RESOURCETYPE_ANY,  
                   0, 
                   aRessource, 
                   Handle ) = No_Error then 
    begin 
      Ret := No_Error; 
      Size := 50 * Sizeof( TNetResource ); 
      GetMem( NetResources, Size ); 
      while Ret = No_Error do 
        begin 
          Count := $FFFFFFFF;   //paramètre in/out 
          Size := 50 * Sizeof( TNetResource ); //paramètre in/out 
          Ret := WNetEnumResource( Handle, Count, NetResources, Size ); 
          if Ret <> No_Error then 
            Break; 
          for Index := 0 to Count - 1 do 
            begin 
              S:='Type d''affichage '; 
              case NetResources[Index].dwDisplayType of 
                 //Type affichage, permet de déterminer  
                 //le mode d'affichage approprié à la ressource 
                 // Ex : RESOURCEDISPLAYTYPE_TREE peut être visualisé  
                 // dans un TListView en mode vsReport... 
                RESOURCEDISPLAYTYPE_GENERIC: S :=S+'Générique'; 
                RESOURCEDISPLAYTYPE_DOMAIN : S :=S+'Domaine'; 
                RESOURCEDISPLAYTYPE_SERVER : S :=S+'Serveur'; 
                RESOURCEDISPLAYTYPE_SHARE : S :=S+'Partage'; 
                RESOURCEDISPLAYTYPE_FILE  : S:=S+'Fichier'; 
                RESOURCEDISPLAYTYPE_GROUP : S:=S+'Groupe'; 
                RESOURCEDISPLAYTYPE_NETWORK : S:=S+'Réseau'; 
                RESOURCEDISPLAYTYPE_ROOT     : S:=S+'Racine'; 
                RESOURCEDISPLAYTYPE_SHAREADMIN  : S:=S+'Partage administrateur'; 
                RESOURCEDISPLAYTYPE_DIRECTORY   : S:=S+'Répertoire'; 
                RESOURCEDISPLAYTYPE_TREE        : S:=S+'Arbre'; 
                RESOURCEDISPLAYTYPE_NDSCONTAINER : S:=S+'NDSCONTAINER' 
                else S:='inconnu'; 
              end; 
  
               //Type de la ressource 
              Case NetResources[Index].dwType of 
                 //C'est un disque partagé 
                RESOURCETYPE_DISK:  S:=S+' [disque]'; 
                 //C'est une imprimante partagée 
                RESOURCETYPE_PRINT: S:=S+' [imprimante]'; 
                 // Soit disque et imprimante ou aucun des 2. 
                RESOURCETYPE_ANY : S:=S+' [autre]'; 
                else S:=S+' [inconnu] '; 
              end; 
  
              With NetResources[Index] Do 
              begin 
               ListBox1.Items.Add(Format('%S %S',[S,lpRemoteName])); 
               // Le temps de traitement peut être long (parcours du réseau) 
               Application.ProcessMessages; 
               if dwUsage and ResourceUsage_Container > 0 
                then 
                 Begin 
                  ListBox1.Items.Add('       * La dernière ressource est un conteneur, appel récursif.'); 
                  EnumererRessources( @NetResources^[Index] ); 
                 end 
                else ListBox1.Items.Add('Vous devez vous connecter à la dernière ressource pour l''énumérer.'); 
              end; 
            end; 
        end; 
      WNetCloseEnum( Handle ); 
      FreeMem(NetResources); 
    end; 
end;

EnumererRessources(nil, ListBox1.Items );