unit Abform;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Db, ADODB, Grids, DBGrids, comobj, ComCtrls;

type
  TMainForm = class(TForm)
    Label1: TLabel;
    ADOConnection1: TADOConnection;
    DataSource1: TDataSource;
    Button1: TButton;
    Label2: TLabel;
    edtName: TEdit;
    Label3: TLabel;
    edtEmail: TEdit;
    cbServer: TComboBox;
    ADSIQuery: TADOQuery;
    Searchbtn2: TButton;
    ResultList: TListView;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Searchbtn2Click(Sender: TObject);
    procedure cbServerChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function GetInternetAddress(iIndex : integer ) : string;
  end;

var
  MainForm: TMainForm;

implementation

uses adshlp, ActiveDs_TLB;

{$R *.DFM}
type
  TMyAdoQuery=class(TAdoQuery)
  end;
  TMyAdoCommand = class(TAdoCommand)
  end;

procedure TMainForm.Button1Click(Sender: TObject);
var szPath : string;
    item : TlistItem;
    i, j : integer;
    s : string;
    temp : Variant;
begin
  ADSIQuery.Active := FALSE;

  ADSIQuery.SQL.Clear;
  szPath := 'SELECT cn,mail,givenName,sn,st,c,homePhone from ';
  szPath := szPath + ' GC://' + GetInternetAddress(cbServer.ItemIndex) + ':389'+' where ';
  if edtEmail.Text <> '' then
    szPath := szPath + 'mail=' + edtEmail.Text + ' * '
  else
    szPath := szPath + 'cn=' + edtName.Text +
            ' * or sn=' + edtName.Text +' * or givenName='
            + edtName.Text + ' * ';
  ADSIQuery.SQL.Add(szPath);
  with TMyAdoQuery(ADSIQuery) do
  begin
    TMyADOCommand(Command).CommandObject._Set_ActiveConnection(ADOConnection1.ConnectionObject) ;
    Command.CommandText := szPath;
    Command.Properties['SearchScope'].Value := ADS_SCOPE_SUBTREE;
    Command.Properties['Cache Results'].Value := False;
    Command.Properties['Timeout'].Value := 600;
    Command.Properties['Size Limit'].Value := 200;
    Command.Properties['Chase referrals'].Value := ADS_CHASE_REFERRALS_EXTERNAL;
  end;
  ADSIQuery.Open;
  with ADSIQuery do
  while not EOF do
  begin
    item := ResultList.Items.Add;
    temp := Fields[0].Value;
    For i := 1 To Fields.Count - 1 do
    begin
       If VarIsArray(Fields[i].Value) And Not (VarIsNull(Fields[i].Value)) Then
       begin
         s := '';
         temp := Fields[i].Value;
         For j := VarArrayLowBound(temp,1) To
                  VarArrayHighBound(temp,1) do
         begin
           If (s <> '') Then
             s := s + ', ';
           s := s + temp[j];
         end;
         if Fields[i].FieldName='cn' then
           item.Caption := s
         else
           item.SubItems.Add(s);
      end
      Else
      begin
        If (Not (VarIsNull(Fields[i].Value))) Then
          Item.SubItems.Add(Fields[i].Value);
      end;
    end;
    Next;
  end;
end;

function TMainForm.GetInternetAddress(iIndex: integer): string;
begin
  Case iIndex of
    0: Result := 'ldap.bigfoot.com';
    1: Result := 'ldap.whowhere.com';
  Else
    Result := '';
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  cbServer.ItemIndex := 1;
end;

procedure TMainForm.Searchbtn2Click(Sender: TObject);
var temp, conn , com, rs : Variant;
    szPath : string;
    item : TlistItem;
    i, j : integer;
    s : string;
begin
  //conn.Open('Active Directory Provider');
  com := CreateOleObject('ADODB.Command');
  szPath := '<GC://' + GetInternetAddress(cbServer.ItemIndex) + ':389>;';
  if edtEmail.Text <> '' then
    szPath := szPath + '(mail=' + edtEmail.Text + '*)'
  else
    szPath := szPath + '(|(|(|(cn=' + edtName.Text +
            '*))(sn=' + edtName.Text +'*))(givenName='
            + edtName.Text + '*))';
  szPath := szPath + ';cn,mail,givenName,sn,st,c,homePhone;subtree';
  com.ActiveConnection := AdoConnection1.ConnectionObject;
  com.CommandText := szPath;
  Com.Properties['Timeout'].Value := 600;
  Com.Properties['Cache Results'].Value := False;
  Com.Properties['Size Limit'].Value := 200;
  rs := Com.Execute;

  while not rs.EOF do
  begin
    item := ResultList.Items.Add;

    temp := rs.Fields[0].Value;
    if VarIsArray(temp) then
      s := temp[0]
    else
      s := temp;
    item.Caption := s;
    For i := 1 To rs.Fields.Count - 1 do
    begin
       If VarIsArray(rs.Fields[i].Value) And Not (VarIsNull(rs.Fields[i].Value)) Then
       begin
         s := '';
         temp := rs.Fields[i].Value;
         For j := VarArrayLowBound(temp,1) To
                  VarArrayHighBound(temp,1) do
         begin
           If (s <> '') Then
             s := s + ', ';
           s := s + temp[j];
         end;
         item.SubItems.Add(s);
      end
      Else
      begin
        If (Not (VarIsNull(rs.Fields[i].Value))) Then
          Item.SubItems.Add(rs.Fields[i].Value);
      end;
    end;
    rs.MoveNext;
  end;
  rs :=null;
  com := NULL;
end;

procedure TMainForm.cbServerChange(Sender: TObject);
begin

end;

end.



以上代码为互联网搜集所得，但运行始终报错。
希望各路高手帮忙解答！谢谢！