Objekte im Active Directory verschieben

[kuba]

Hallo,

ich habe folgenden Code mit dem es möglich sein soll Objecte im Active Directory zu verschieben.
Leider funktioniert das bei mir nicht, hat jemand eine Idee woran das liegen könnte ?

Code:

//if MoveADObject('LDAP://CN=Benutzer1,OU=Quellcontainer,DC=domain,DC=com', 'LDAP://OU=Zielcontainer,DC=domain,DC=com') then
  //ShowMessage('Das Objekt wurde erfolgreich verschoben.')
//else
  //ShowMessage('Fehler beim Verschieben des Objekts.');
//if MoveADObject('LDAP://CN=Computer1,OU=Quellcontainer,DC=domain,DC=com', 'LDAP://OU=Zielcontainer,DC=domain,DC=com') then
  //ShowMessage('Das Computerobjekt wurde erfolgreich verschoben.')
//else
  //ShowMessage('Fehler beim Verschieben des Computerobjekts.');
function MoveADObject(const ldapPath, newParentPath: string): Boolean;
var
  sourceObject: IADs;
  destinationParent: IADsContainer;
  destinationName: string;
begin
  Result := False;

  try
    // Bind zum Quellobjekt, das verschoben werden soll
    sourceObject := nil;
    ADsGetObject(PWideChar(WideString(ldapPath)), IADs, Pointer(sourceObject));

    // Bind zum Zielübergeordneten Container
    destinationParent := nil;
    ADsGetObject(PWideChar(WideString(newParentPath)), IADsContainer, Pointer(destinationParent));

    // Holen Sie den Namen des Quellobjekts
    destinationName := sourceObject.Name;

    // Verschieben Sie das Objekt in den Zielcontainer
    destinationParent.MoveHere(Format('LDAP://%s', [destinationName]), destinationName);

    Result := True;
  except
    // Fehlerbehandlung
  end;
end;

[kuba]

Was besseres ist mir jetzt nicht eingefallen, falls noch jemand eine Idee hat bitte melden.

Workaround:

Code:

Memo_defaultVBS:

' This code moves Object from one container to another.
' ------ SCRIPT CONFIGURATION ------
strSource = "#Source"  ' e.g. cn=rallen,cn=users,dc=rallencorp,dc=com
strTarget = "#Target"  ' e.g. ou=Sales,dc=rallencorp,dc=com
' ------ END CONFIGURATION ---------

Set objSource = GetObject(strSource)
Set objTarget = GetObject(strTarget)
objTarget.MoveHere objSource.ADsPath, objSource.Name


procedure MoveObjectADS:
var
  Source, Target: string;
  Value, filename :string;
  i : integer;
begin
  Memo_VBS.Clear;
  Memo_VBS.Text := Memo_defaultVBS.Text;
  Source:=SearchComputer(lvComputerRoom.Selected.Caption+'$');
  Target:= StringReplace(Source, PCWORKEROUPATH, PCMASTEROUPATH,[rfReplaceAll]);
  Target:= StringReplace(Target, 'CN='+lvComputerRoom.Selected.Caption+',', '',[rfReplaceAll]);
  filename := 'objMove.vbs';
  if FileExists(filename) then DeleteFile(filename);
  for i := 0 to Memo_VBS.Lines.Count - 1 do Memo_VBS.lines[i]:=StringReplace(Memo_VBS.lines[i],'#Source',Source,[rfReplaceAll]);
  for i := 0 to Memo_VBS.Lines.Count - 1 do Memo_VBS.lines[i]:=StringReplace(Memo_VBS.lines[i],'#Target',Target,[rfReplaceAll]);
  Memo_VBS.Lines.SaveToFile(ExtractFilePath(ParamStr(0)) + filename);
  ShellExecAndWait('WScript.exe',PChar(filename),'');
  Application.ProcessMessages;
end;

[kuba]

Ich habe jetzt eine andere Variante des Code bei dem ich Fehlerbehandlungen eingebaut habe. Ich erhalte jetzt vom Betriebssystem die Meldung "unbekannter Fehler". Ich vermute dass die Ursache in der von mir verwendeten JEDI-Library vorhanden ist. Ich verwende die "trunc" Version. Kennt sich jemand aus ? Sollte ich eine "branches" Version benutzen ? Wenn ja, welche ?

Code:

uses
  SysUtils, JwaWindows, JwaActiveDs, JwaAdsTlb, ComObj;

function MoveADObject(const ldapPath, newParentPath: string): Boolean;
var
  sourceObject: IADs;
  destinationParent: IADsContainer;
  destinationName: string;
begin
  Result := False;

  try
    // Bind zum Quellobjekt, das verschoben werden soll
    if ADsGetObject(PWideChar(WideString(ldapPath)), IADs, Pointer(sourceObject)) = S_OK then
    begin
      try
        // Bind zum Zielübergeordneten Container
        if ADsGetObject(PWideChar(WideString(newParentPath)), IADsContainer, Pointer(destinationParent)) = S_OK then
        begin
          try
            // Holen Sie den Namen des Quellobjekts
            destinationName := sourceObject.Name;

            // Verschieben Sie das Objekt in den Zielcontainer
            destinationParent.MoveHere(Format('LDAP://%s', [destinationName]), destinationName);

            Result := True;
          finally
            destinationParent := nil; // Freigeben des Zielübergeordneten Containers
          end;
        end
        else
          ShowMessage('Zielübergeordneter Container konnte nicht gefunden werden.');
      finally
        sourceObject := nil; // Freigeben des Quellobjekts
      end;
    end
    else
      ShowMessage('Quellobjekt konnte nicht gefunden werden.');
  except
    on E: Exception do
    begin
      ShowMessage('Fehler beim Verschieben des Objekts: ' + E.Message);
    end;
  end;
end;

[kuba]

Fehler gefunden !!!
Falls es jemand gebrauchen kann, hier der finale Code:

Code:

function MoveADObject(const ldapPath, newParentPath: string): Boolean;
var
  sourceObject: IADs;
  destinationParent: IADsContainer;
  destinationName: string;
begin
  Result := False;

  try
    // Bind zum Quellobjekt, das verschoben werden soll
    if Succeeded(ADsGetObject(PWideChar(ldapPath), IID_IADs, Pointer(sourceObject))) then
    begin
      try
        // Bind zum Zielübergeordneten Container
        if Succeeded(ADsGetObject(PWideChar(newParentPath), IID_IADsContainer, Pointer(destinationParent))) then
        begin
          try
            // Holen Sie den Namen des Quellobjekts
            destinationName := sourceObject.Name;

            // Verschieben Sie das Objekt in den Zielcontainer
            destinationParent.MoveHere(WideString(ldapPath), WideString(destinationName));

            Result := True;
          finally
            destinationParent := nil; // Freigeben des Zielübergeordneten Containers
          end;
        end
        else
          ShowMessage('Zielübergeordneter Container konnte nicht gefunden werden.');
      finally
        sourceObject := nil; // Freigeben des Quellobjekts
      end;
    end
    else
      ShowMessage('Quellobjekt konnte nicht gefunden werden.');
  except
    on E: Exception do
    begin
      ShowMessage('Fehler beim Verschieben des Objekts: ' + E.Message);
    end;
  end;
end;