library Project2;
uses
 ShareMem,
 SysUtils,
 Classes,
 ADODB,
 ActiveDs_TLB in 'ActiveDS_TLB.pas';

function ADsOpenObject(lpszPathName, lpszUserName, lpszPassword: PWideChar;
                        dwReserved: DWORD; const riid: TGUID; out ppObject):HResult; external 'activeds.dll';
function ADsGetObject(lpszPathName: PWideChar; const riid: TGUID; out ppObject): HRESULT; external 'activeds.dll';

{$R *.res}
function Q_Base(
                 Server_Name,   // èìÿ áàçû äëÿ äîñòóïà ê íåé
                 User_Name,     // èìÿ ïîëüçîâàòåëÿ
                 User_Pass,     // ïàðîëü ïîëüçîâàòåëÿ
                 Dir            // êàòàëîã ãäå äîëæíà íàõîäèòñÿ
                                // çàïèñü ïîëüçîâàòåëÿ
                     :widestring;
                  var
                 ErrorCount:Integer;
                 var
                 ErrorType      // âîçâðàùåíèå ðåçóëüòàòà ðàáîòû ïðîãðàììû
                     :pwidechar):Hresult;
var
   usr:IADs;//IADsUser;
   s1,s2,s3:PWideChar;
   s5:widestring;
   //TransBase:TADOConnection;    // äëÿ ñâÿçè òàáëèöû è çàïðîñíèêà
   streem:HResult;
BEGIN
    // äëÿ íà÷àëà ïðîâåðèì âõîäíûå äàííûå è çàäàäèì îòñóòñòâèå îøèáîê
    ErrorType:='0000000';
    ErrorCount:=0;
    // ïðîâåðèì èìÿ íà íåïóñòîå, åñëè ïóñòîå çàäàäèì 'anonimouse'
    if User_Name='' then
       begin
             User_Name:='anonimouse';
             ErrorType[2]:='1';
       end;
    // ïðîâåðèì íà ïóñòîòó èìÿ ñåðâåðà
    if Server_Name='' then
       begin
             Server_Name:='ldap://';
             ErrorType[1]:='1';
       end;
    // ïðîâåðèì ïàðîëü è âûâåäåì ÷òî îí íå ââåäåí
    if User_Pass='' then
             ErrorType[3]:='1';
    // ïðîâåðèì çàäàí ëè êàòàëîã
    if Dir='' then
             ErrorType[4]:='1';
               s5:=user_pass;
             s3:=pwidechar(s5);
             s5:=server_name;
           s1:=pwidechar(s5);
     Streem:=ADsGetObject(s1, IID_IADs,usr );
   if  Streem=HResult($00000001) then
             ErrorType[7]:='1' //Îøèáêà ñîåäåíåíèÿ ñ ñåðâåðîì
       else
           begin
           s5:=Server_Name+'/OU='+Dir;
           s1:=pwidechar(s5);
                 Streem:=ADsGetObject(s1, IID_IADs, usr );
                if Streem=hresult($00000001) then
                         ErrorType[7]:='2' //Îøèáêà äèðåêòîðèè
                     else
                         begin           s5:=Server_Name+'/OU='+Dir+',DC='+User_Name;
                         s1:=pwidechar(s5);
                               Streem:=ADsGetObject(s1, IID_IADs, usr );
                              if Streem=hresult($00000001) then
                                       ErrorType[7]:='3'
                                   else
                                       begin        s5:=Server_Name+'/OU='+Dir;
                                       s1:=pwidechar(s5);
                                                    s5:='DC='+User_Name+'OU='+Dir;
                                                    s2:=pwidechar(s5);
Streem:=ADsOpenObject(s1,s2,s3,ADS_SECURE_AUTHENTICATION , IID_IADs, usr );
                                             If streem=hresult($00000001) then
                                                     errorType[7]:='4'
                                                 else
                                                     begin
case streem of                                   hresult($80004002):errorType[6]:='2';         hresult($8000FFFF):errorType[6]:='3';        hresult($80004001):errorType[6]:='4';        hresult($80004005):errorType[6]:='5';         hresult($80030003):errorType[6]:='6';  hresult($80030005):errorType[6]:='7';
hresult($80030057):errorType[6]:='8';
hresult($800300FC):errorType[6]:='9';
                                                          end;
                                                     end;
                                     end;
                     end;
           end;
           Q_Base:=streem;
END;
exports
Q_Base;
begin
end.