Hilfsmittel zur Windows-Administration

  ...
  uses ..., JwaAdsHlp, JwaAdsTLB, JwaAdsErr;
  ...
  function TfrmDomUser.InitDomainData : boolean;
  const
    szLen = 256;
  
  var
    bind         : widestring;
    opt          : ads_searchpref_info;
    hr           : HResult;
    ptrResult    : THandle;
    col          : ads_search_column;
    dwErr        : DWord;
    szErr,szName : array[0..szLen-1] of WideChar;
    sd,sn,sp     : string;
    root         : IADs;
    DSearch      : IDirectorySearch;
  
    function ToPrincipal(cs : string) : string;
    var
      i : integer;
      t : string;
    begin
      t:='';
      while length(cs)>0 do begin
        i:=pos('DC=',cs);
        if i>0 then begin
          delete(cs,1,3);
          if length(t)=0 then t:=ReadNxtStr(cs,',')
          else t:=t+'.'+ReadNxtStr(cs,',');
          end
        else cs:='';
        end;
      Result:=t;
      end;
  
  begin
    ...
    bind:='LDAP://'+FDomain;
    try
      ADsGetObject(PWideChar(Bind),IID_IADs,pointer(root));
      Context:=root.Get('distinguishedName');
      DNSName:=ToPrincipal(Context);
      edtDNSName.Text:='@'+DNSName;
      ...
      ADsGetObject(PWideChar(bind),IID_IDirectorySearch,pointer(DSearch));
      ...
      with opt do begin
        dwSearchPref:=ADS_SEARCHPREF_SEARCH_SCOPE;
        vValue.dwType:=ADSTYPE_INTEGER;
        vValue.Integer:=ADS_SCOPE_SUBTREE;
        end;
      with DSearch do begin
        if Failed(SetSearchPreference(@opt,1)) then begin
          ADsGetLastError(dwErr,@szErr,szLen,@szName[0],szLen);
          ShowMessage(WideCharToString(szErr)+sLineBreak+WideCharToString(szName));
          btnMakeUser.Enabled:=false;
          exit;
          end;
      ...

  ...
  uses ..., JwaAdsHlp, JwaAdsTLB, JwaAdsErr;
  ...
  type
    TADsObject = class (TObject)
      FName,FDesc,FPath : string;
      constructor Create (AName,ADesc,Apath : string);
      end;
  const
    ColCount = 3;
    ColNames : array[0..ColCount-1] of WideString = ('Name','Description','ADsPath');
    ...
  function TfrmDomUser.InitDomainData : boolean;
    ...                      // see code snippet above
      // Organisationseinheiten suchen
      cbxOU.Clear;
      ExecuteSearch('(objectClass=organizationalUnit)',@ColNames,ColCount,ptrResult);
      hr:=GetNextRow(ptrResult);
      while (hr<>S_ADS_NOMORE_ROWS) do begin
        sd:=''; sd:=''; sp:='';
        if Succeeded(GetColumn(ptrResult,ColNames[1],col)) then begin
          with col do if pADsValues<>nil then sd:=pAdsvalues^.CaseExactString;
          FreeColumn(@col);
          if (length(sd)>0) and (sd[1]='-') then sd:='';
          end;
        if length(sd)>0 then begin
          if Succeeded(GetColumn(ptrResult,ColNames[0],col)) then begin
            with col do if pADsValues<>nil then sn:=pAdsvalues^.CaseIgnoreString;
            FreeColumn(@col);
            end;
          if Succeeded(GetColumn(ptrResult,ColNames[2],col)) then begin
            with col do if pADsValues<>nil then sp:=pAdsvalues^.CaseIgnoreString;
            FreeColumn(@col);
            end;
          if length(sp)>0 then cbxOU.Items.AddObject(sd,TADsObject.Create(sn,sd,sp));
          end;
        hr:=GetNextRow(ptrResult);
        end;
      ...

      // Gruppen suchen
      lbxAg.Clear;
      ExecuteSearch('(&(objectClass=group)(!CN=Builtin))',@ColNames,ColCount-1,ptrResult);
      hr:=GetNextRow(ptrResult);
      while (hr<>S_ADS_NOMORE_ROWS) do begin
        sd:=''; sd:=''; sp:='';
        if Succeeded(GetColumn(ptrResult,ColNames[1],col)) then begin
          with col do if pADsValues<>nil then sd:=pAdsvalues^.CaseExactString;
          FreeColumn(@col);
          end;
        if length(sd)>0 then begin
          if Succeeded(GetColumn(ptrResult,ColNames[0],col)) then begin
            with col do if pADsValues<>nil then sn:=pAdsvalues^.CaseIgnoreString;
            FreeColumn(@col);
            end;
          if Succeeded(GetColumn(ptrResult,ColNames[2],col)) then begin
            with col do if pADsValues<>nil then sp:=pAdsvalues^.CaseIgnoreString;
            FreeColumn(@col);
            end;
          if length(sp)>0 then lbxAg.Items.AddObject(sd,TADsObject.Create(sn,sd,sp));
          end;
        hr:=GetNextRow(ptrResult);
        end;
    ...

  procedure TfrmDomUser.btnMakeUserClick(Sender: TObject);
  var
    ADsCont  : IADsContainer;
    ADsOU    : IADsOU;
    User     : IDispatch;
    Grp      : IAdsGroup;
    bind     : widestring;
    ap,s     : string;
    i,n      : integer;

  const
    SpecChars : set of char = [',','/',';'];
  
    function ReplaceSpecChar(s : string) : string;
    var
      t : string;
      i : integer;
    begin
      t:='';
      for i:=1 to length(s) do if (s[i] in SpecChars) then t:=t+'\'+s[i] else t:=t+s[i];
      Result:=t;
      end;
  
  begin
    if CheckHomeDir and (length(edtKontoName.Text)>0) then begin
      if rbtGlobal.Checked then bind:='LDAP://'+FDomain+'/CN=Users,'+Context
      else with cbxOU do bind:=(Items.Objects[ItemIndex] as TAdsObject).FPath;
    // prüfen, ob der Benutzer bereits eingetragen ist
      ap:=SearchUser (edtKontoName.text);
      if length(ap)>0 then begin
        ADsGetObject(PWideChar(ap),IID_IADsUser,pointer(user));
        with User as IADsUser  do begin
          GetInfo;
          try
            edtFullName.Text:=FullName;
          except
            edtFullName.Text:='';
            end;
          ErrorDialog(Caption,'Der Benutzer '+edtFullname.Text+' ('+edtKontoName.Text+'@'+DNSName+')'+
                     sLineBreak+'ist bereits eingetragen!');
          ...
        end
      else if ConfirmDialog (Caption,'Neuen Benutzer: '+edtKontoName.Text+edtDNSName.Text+
                       sLineBreak+'unter: '+bind+' anlegen?') then begin // noch nicht vorhanden
        ADsGetObject(PWideChar(bind),IID_IADsContainer,pointer(ADsCont));
        User:=ADsCont.Create('user','CN='+ReplaceSpecChar(edtFullname.Text));
        ...
        end;
      end;  
    ADsCont:=nil;
    Pwd:=''; btnPwd.Font.Color:=clRed;
    end;

  function TfrmDomUser.SearchUser (CommonName : string) : string;
  var
    DSearch      : IDirectorySearch;
    opt          : ads_searchpref_info;
    ptrResult    : THandle;
    col          : ads_search_column;
  begin
    Result:='';
    ADsGetObject('LDAP://'+FDomain,IDirectorySearch,DSearch);
    with opt do begin
      dwSearchPref:=ADS_SEARCHPREF_SEARCH_SCOPE;
      vValue.dwType:=ADSTYPE_INTEGER;
      vValue.Integer:=ADS_SCOPE_SUBTREE;
      end;
    with DSearch do begin
      if Succeeded(SetSearchPreference(@opt,1)) then begin
        ExecuteSearch(PWideChar('(&(objectClass=user)(sAMAccountName='+CommonName+'))'),@ColNames,ColCount,ptrResult);
        if GetNextRow(ptrResult)<>S_ADS_NOMORE_ROWS then begin
          if Succeeded(GetColumn(ptrResult,ColNames[2],col)) then begin
            with col do if pADsValues<>nil then Result:=pAdsvalues^.CaseIgnoreString;
            FreeColumn(@col);
            end;
          end
        end
      end;
    end;

  

      ...
      ADsGetObject(PWideChar(ap),IID_IADsUser,pointer(user));
      with User as IADsUser  do begin
        GetInfo;
        try
          edtFullName.Text:=FullName;
        except
          edtFullName.Text:='';
          end;
        ErrorDialog(Caption,'Der Benutzer '+edtFullname.Text+' ('+edtKontoName.Text+'@'+DNSName+')'+
                   sLineBreak+'ist bereits eingetragen!');
        try
          edtFirstName.Text:=FirstName;
        except
          edtFirstName.Text:='';
          end;
        try
          edtLastName.Text:=LastName;
        except
          edtLastName.Text:='';
          end;
        try
          edtDescription.Text:=Description;
        except
          edtDescription.Text:='';
          end;
        try
          edtKontoName.Text:=Get('sAMAccountName');
        except
          edtKontoName.Text:='';
          end;
        try
          edtRoom.Text:=OfficeLocations;
        except
          edtRoom.Text:='';
          end;
        try
          edtPhone.Text:=TelephoneNumber;
        except
          edtPhone.Text:='';
          end;
        try
          chbDisabled.Checked:=AccountDisabled;
        except
          chbDisabled.State:=cbGrayed;
          end;
        try
          s:=Profile;
          with hcbProfile do begin
            Text:=s;
            AddItem(ReplaceUsername(s));
            end;
        except
          end;
        try
          s:=HomeDirectory;
          with hcbHomeDir do begin
            Text:=s;
            AddItem(ReplaceUsername(s));
            end;
        except
          end;
        try
          s:=Get('homeDrive');
          with cbHomeDrive do begin
            n:=Items.IndexOf(s);
            if n<0 then n:=0;
            ItemIndex:=n;
            end;
        except
          end;
        try
          ADsGetObject(PWideChar(Parent),IID_IADsOU,pointer(ADsOU));
          rbtOU.Checked:=true;
          with cbxOU do ItemIndex:=Items.IndexOf(ADsOU.Description);
        except
          rbtGlobal.Checked:=true;
          cbxOU.ItemIndex:=-1;
          end;
        ADsOU:=nil;
        end;
      ...

      ...
        ADsGetObject(PWideChar(bind),IID_IADsContainer,pointer(ADsCont));
        User:=ADsCont.Create('user','CN='+ReplaceSpecChar(edtFullname.Text));
        with User as IADsUser do begin
      // set Mandatory attributes
          Put('sAMAccountName',edtKontoName.Text);
      // set Optional attributes
          FullName:=edtFullName.Text;
          if length(edtFirstName.Text)>0 then FirstName:=edtFirstName.Text;
          LastName:=edtLastName.Text;
          Description:=edtDescription.Text;
          with hcbHomeDir do if length(Text)>0 then HomeDirectory:=ReplacePlaceholder(Text);
          with cbHomeDrive do if ItemIndex>0 then Put('homeDrive',Items[ItemIndex]);
          with hcbProfile do if length(Text)>0 then Profile:=ReplacePlaceholder(Text);
          Put('userPrincipalName',edtKontoname.Text+'@'+DNSName);
          try
            SetInfo;       // Speichern
          except
            on E:EOleException do ShowExceptionError(E);
            end;
      // additional attributes
          if length(Pwd)=0 then begin
            if not chbDisabled.Checked then begin  // Kennwort
              Put('pwdLastSet',0);   // ändern bei nächster Anmeldung
              s:=StringReplace(DefPwd,'#',edtKontoname.Text,[]);
              try
                SetPassword (s);
              except
                on E:EOleException do ShowExceptionError(E);
                end;
              end;
            Put('userAccountControl',0);
            end
          else begin
            try
              SetPassword (Pwd);
            except
              on E:EOleException do ShowExceptionError(E);
              end;
            if NoExpire then
              Put('userAccountControl',ADS_UF_DONT_EXPIRE_PASSWD)
            else Put('userAccountControl',0);
            end;
          AccountDisabled:=chbDisabled.Checked;
          if length(edtRoom.Text)>0 then OfficeLocations:=edtRoom.Text;
          if length(edtPhone.Text)>0 then TelephoneNumber:=edtPhone.Text;
          EmailAddress:=edtKontoname.Text+'@'+DNSName;
          try
            SetInfo;       // Speichern
          except
            on E:EOleException do ShowExceptionError(E);
            end;
          end;
      // Arbeitsgruppen zuordnen
        with lbxAG do if SelCount>0 then for i:=0 to Items.Count-1 do if Selected[i] then begin
          if succeeded(ADsGetObject((Items.Objects[i] as TADsObject).FPath,IID_IADsGroup,Grp)) then
            Grp.Add((user as IAdsUser).AdsPath);
          end;
        Grp:=nil;
        ...
        MessageDlg('In '+FDomain+' wurde ein neuer Benutzer angelegt:'+sLineBreak
                     +edtFullname.Text+'('+edtKontoname.Text+'@'+DNSName+')',
                     mtInformation,[mbOK],0);
        user:=nil;
        end;
      ADsCont:=nil;
      ...
      end
    ...

      // Set "User Cannot Change Password"
      // see sample in "Windows Platform SDK"
      IU:=(User as IADsUser).Get('ntSecurityDescriptor');
      IU.QueryInterface(IID_IADsSecurityDescriptor,SecDesc);
      ACL:=IADsAccessControlList(SecDesc.DiscretionaryAcl);
      IU:=ACL._NewEnum;
      if succeeded(IU.QueryInterface(IID_IEnumVARIANT,Enum)) then begin
        while (Succeeded(ADsEnumerateNext(Enum,1,VarArr,lNumEl)))and (lNumEl>0) do begin
          if Succeeded(IDispatch(varArr).QueryInterface(IID_IADsAccessControlEntry,ACE)) then with ACE do begin
            if UpperCase(ObjectType)=UpperCase(CHANGE_PASSWORD_GUID) then begin
            // nachfolgend sind die länderspez. Namen zu benutzen:
            // z.B. "Jeder" und "NT-AUTORITÄT\SELBST"
            // Die Ermittlung dieser Namen erfolgt über die Funktion
            // GetAccountName in WinApi (s.o.)
              if Trustee=TrEvrOne then begin  // 'Everyone'
                // Modify the ace type of the entry.
                if UserCannotChangePassword then AceType:=ADS_ACETYPE_ACCESS_DENIED_OBJECT
                else AceType:=ADS_ACETYPE_ACCESS_ALLOWED_OBJECT;
                end;
            // TrSelf (s.o.) enthält nicht den Teil "NT AUTHORITY\" (bzw. "NT-AUTORITÄT\")
            // Ich habe keine Infos gefunden, wie das anders zu machen geht
            // Da die Strings so nicht mit Trustee verglichen werden können,
            // wird der Teil vor "\" entfernt
              j:=AnsiPos('\',Trustee);
              if j>0 then begin
                s:=AnsiRightStr(Trustee,length(Trustee)-j);
                if s=TrSelf then begin // 'NT AUTHORITY\SELF'
                  // Modify the ace type of the entry.
                  if UserCannotChangePassword then AceType:=ADS_ACETYPE_ACCESS_DENIED_OBJECT
                  else AceType:=ADS_ACETYPE_ACCESS_ALLOWED_OBJECT;
                  end;
                end;
              end;
            end;
          end;
        // Update the ntSecurityDescriptor property.
        (User as IADsUser).Put ('ntSecurityDescriptor',SecDesc);
        //Commit the changes to the server.
        (User as IADsUser).SetInfo;
        end;
    ...

  type
    TADsObject = class (TObject)
      FName,FDesc,FPath : string;
      constructor Create (AName,ADesc,Apath : string);
      end;
  const
    UserCols = 'Name,sAMAccountName,ADsPath,userAccountControl,mail';
    ...
  procedure StringToPwArray (SListe : string; var PwArr : TPWideArray; var Count : integer);
  var
    s : string;
  begin
    Count:=0;
    while length(SListe)>0 do begin
      s:=ReadNxtStr(SListe,Comma);
      if length(s)>0 then begin
        SetLength(PwArr,Count+1);
        GetMem(PwArr[Count],256);
        StringToWideChar(s,PwArr[Count],256);
        inc(Count)
        end;
      end;
    end;
  ...
  function TfrmDelUser.LoadUserList (const OU : string) : boolean;
  var
    hr           : HResult;
    ptrResult    : THandle;
    colnames     : TPWideArray;
    col          : ads_search_column;
    sd,sn,sp,sm  : string;
    ColCount,ns  : integer;
    ok           : boolean;
  begin
    try
      with DSearch do begin
        // Benutzer suchen
        UserList.Clear;
        StringToPwArray(UserCols,ColNames,ColCount);
        ExecuteSearch('(&(objectCategory=person)(objectClass=user))',@ColNames[0],ColCount,ptrResult);
        hr:=GetNextRow(ptrResult);
        while (hr<>S_ADS_NOMORE_ROWS) do begin
          sd:=''; sd:=''; sp:=''; sn:=''; sm:=''; ns:=4;
          if Succeeded(GetColumn(ptrResult,ColNames[1],col)) then begin
            with col do if pADsValues<>nil then sd:=pAdsvalues^.CaseExactString;
            FreeColumn(@col);
            if (length(sd)>0) and (sd[1]='-') then sd:='';
            end;
          if length(sd)>0 then begin
            if Succeeded(GetColumn(ptrResult,ColNames[0],col)) then begin
              with col do if pADsValues<>nil then sn:=pAdsvalues^.CaseIgnoreString;
              FreeColumn(@col);
              end;
            if Succeeded(GetColumn(ptrResult,ColNames[2],col)) then begin
              with col do if pADsValues<>nil then sp:=pAdsvalues^.CaseIgnoreString;
              FreeColumn(@col);
              end;
            if Succeeded(GetColumn(ptrResult,ColNames[3],col)) then begin
              with col do if pADsValues<>nil then begin
                if (pAdsvalues^.Integer and ADS_UF_ACCOUNTDISABLE)<>0 then ns:=1
                else ns:=0;
                end;
              FreeColumn(@col);
              end;
            if Succeeded(GetColumn(ptrResult,ColNames[4],col)) then begin
              with col do if pADsValues<>nil then sm:=pAdsvalues^.CaseIgnoreString;
              FreeColumn(@col);
              end;
            if length(OU)=0 then ok:=TextPos('ou',sp)=0
            else ok:=TextPos(OU,sp)>0;
            if (length(sn)>0) and ok then begin
              UserList.AddObject(sn,TADsObject.Create(sn,sd,sp,sm,ns));
              end;
            end;
          hr:=GetNextRow(ptrResult);
          end;
        lvUser.Items.Count:=UserList.Count;
        Result:=true;
        end;
    except
      Result:=false;
      end;
    end;
  ...

  procedure TfrmDelUser.ShowUserData (AIndex : integer);
  var
    ap    : string;
    ADsOU : IADsOU;
  begin
    if (AIndex=0) and (AIndex<UserList.Count) then begin
      cbUserData.Checked:=false;
      lbUserDirs.Clear;
      ap:=(UserList.Objects[AIndex] as TADsObject).FPath;
      if Failed(ADsGetObject(PWideChar(ap),IID_IADsUser,pointer(user))) then Exit;
      with User as IADsUser  do begin
        GetInfo;
        try
          edtFullName.Text:=FullName;
        except
          edtFullName.Text:='';
          end;
        try
          edtFirstName.Text:=FirstName;
        except
          edtFirstName.Text:='';
          end;
        try
          edtLastName.Text:=LastName;
        except
          edtLastName.Text:='';
          end;
        try
          edtDescription.Text:=Description;
        except
          edtDescription.Text:='';
          end;
        try
          edtKontoName.Text:=Get('sAMAccountName');
        except
          edtKontoName.Text:='';
          end;
        try
          edtRoom.Text:=OfficeLocations;
        except
          edtRoom.Text:='';
          end;
        try
          edtPhone.Text:=TelephoneNumber;
        except
          edtPhone.Text:='';
          end;
        try
          AccDisabled:=AccountDisabled;
          with btToggleAccount do begin
            Enabled:=true;
            Glyph:=nil;
            if AccDisabled then begin
              Caption:=_('Enable account');
              ImageList.GetBitmap(0,Glyph);
              end
            else begin
              Caption:=_('Disable account');
              ImageList.GetBitmap(1,Glyph);
              end;
            end;
        except
          AccDisabled:=false;
          btToggleAccount.Enabled:=false;
          end;
        lmDisabled.Visible:=AccDisabled;
        laDisabled.Visible:=AccDisabled;
        try
          ADsGetObject(PWideChar(Parent),IID_IADsOU,pointer(ADsOU));
          OUPath:=ADsOU.AdsPath;
        except
          OuPath:='';
          end;
        ADsOU:=nil;
        end;
      end;
    end;

  function TfrmDelUser.SearchDir (Base,SubDir,UserName : string) : string;
  var
    DirInfo    : TSearchRec;
    Findresult : integer;
    sd         : string;
  begin
    Result:='';
    if (length(SubDir)=0) then sd:=Base
    else if (SubDir[1]='\') then  sd:=Base+SubDir
    else sd:=IncludeTrailingPathDelimiter(Base)+SubDir;
    FindResult:=FindFirst(IncludeTrailingPathDelimiter(sd)+'*.*',faDirectory+faReadOnly+faHidden+faSysfile,DirInfo);
    while (length(Result)=0) and (FindResult=0) do with DirInfo do begin
      if NotSpecialDir(Name) then begin
        if SameFileName(DirInfo.Name,UserName) then Result:=IncludeTrailingPathDelimiter(sd)+DirInfo.Name
        else Result:=SearchDir(Base,IncludeTrailingPathDelimiter(SubDir)+DirInfo.Name,UserName);
        end;
      FindResult:=FindNext(DirInfo);
      end;
    FindClose(DirInfo);
    end;
    ...

  procedure TfrmDelUser.RemoveUser (const ABind : string);
  var
    s          : string;
    dc,fc,i,n  : integer;
    ADsCont    : IADsContainer;
  ...
  begin
    ADsGetObject(PWideChar(ABind),IID_IADsContainer,pointer(ADsCont));
    try
      ADsCont.Delete('user','CN='+ReplaceSpecChar(edtFullName.Text));
      s:=Format(_('User: %s was removed from ADS!'),[edtFullName.Text]); //'Der Benutzer: %s wurde aus dem ADS entfernt!';
      if cbUserData.Checked then begin
        StatusWindow.ShowStatus(BottomLeftPos(btnSearch,Point(0,-150)),_('Deleting user data'),'',true,5);
        dc:=0; fc:=0;
        s:=s+sLineBreak+_('Following user data were deleted:'); //'Folgende Benutzerdaten wurden gelöscht:'
        with lbUserDirs do for i:=0 to Items.Count-1 do if Selected[i] then begin
          StatusWindow.Status:=Items[i];
          Application.ProcessMessages;
          // Löschen Benutzerverzeichnis einschließlich aller Unterverzeichnisse und Dateien
          DeleteDirectories(Items[i],'',dc,fc); 
          s:=s+sLineBreak+_('  Directory: ')+Items[i]; //'  Verzeichnis: '
          end;
        StatusWindow.Close;
        dec(dc);
        if dc>0 then begin
          s:=s+sLineBreak+IntToStr(dc);
          if dc=1 then s:=s+_(' Subdirectory') //' Unterverzeichnis'
          else s:=s+_(' Subdirectories') //' Unterverzeichnisse';
          end
        else s:=s+sLineBreak+_('No subdirectories found'); //'keine Unterverzeichnisse gefunden'
        if fc>0 then begin
          s:=s+sLineBreak+IntToStr(fc);
          if fc=1 then s:=s+_(' file') //' Datei'
          else s:=s+_(' files'); //' Dateien';
          end;
        end ;
  ...