Top / TIPS / VB で LDAP

LDAP 認証を行う手順は

になります。

匿名接続を行い、識別名(DN:Distinguished Name)を取得する。

※ ユーザIDで検索を行うわけですが、識別名にユーザIDが入っていれば、この手順は必要ありません。

いろいろやり方はあると思いますが、ADO の ADsDSOObject プロバイダを使ってみます。

   Dim con  As ADODB.Connection
   Dim cmd  As ADODB.Command
   Dim rec  As ADODB.Recordset
   Dim sql  As String

   Const ADS_SCOPE_ONELEVEL = 1

   ' ADODB.Connection を作成
   Set con = New ADODB.Connection
   con.Open "Provider=ADsDSOObject"

   ' ADODB.Command を作成
   Set cmd = New ADODB.Command

   ' クエリの作成
   sql = ""
   sql = sql & "SELECT AdsPath FROM 'LDAP://xxx.xxx.xxx.xxx/ou=Users,dc=my-domain,dc=com'"
   sql = sql & " WHERE uid = '" & uid & "'"

   With cmd
       .ActiveConnection = con
       .Properties("SearchScope") = ADS_SCOPE_ONELEVEL '1レベル下を検索
       .CommandText = sql
   End With

   ' クエリを実行
   Set rec = cmd.Execute

DN とパスワードを使用して認証

認証は、ADSI の OpenDSObject メソッドで行います。

上の手順で得られたレコードセットから、AdsPath なるものが取得されます。

内容は、

例)LDAP://192.168.1.10/uid=user0001,ou=Users,dc=my-domain,dc=com

のようになっています。

これを OpenDSObject メソッドに渡すため、サーバー名の部分とDNの部分に分割しましょう。

   adsPath = rec.Fields("AdsPath").Value
   nPos = InStrRev(adsPath, "/")
   server = Left(adsPath, nPos - 1)
   userdn = Mid(adsPath, nPos + 1)

さて、認証です。

   On Error Resume Next
   Set ldap = GetObject("LDAP:")
   Set account = ldap.OpenDSObject(server, userdn, pwd, 0)

認証に失敗すると、エラーが発生するので、エラートラップは必ず行ってください。

プロパティの取得

白状してしまうと、いろいろやっては見たものの、どうしてもやり方がわからず、納期も迫っていたので、当時は C でDLLを作って逃げてしまいました。ヽ(;^^)/
cn,uid など基本的な項目は簡単に取れるのですが、拡張した部分にアクセスしようとすると、

ディレクトリのデータ型と、ネイティブ DS のデータ型を相互に変換することはできません。

なんてエラーが出てたのです。
その後、いろいろ調べて、やっとわかったので、このコンテンツを書いているというわけ(^_^;)

取得した AdsPath を使用してプロパティを取得します。 システムの System32 フォルダの中に、「activeds.tlb」というタイプライブラリがあるので 参照設定してください。

   Dim propList  As IADsPropertyList
   Dim propEntry As IADsPropertyEntry
   Dim propVal   As IADsPropertyValue
   Dim v         As Variant

   Set propList = GetObject(rec.Fields("AdsPath").Value)
   propList.GetInfo

   Set propEntry = propList.GetPropertyItem("(プロパティ名)", ADSTYPE_CASE_IGNORE_STRING)
   For Each v In propEntry.Values
       Set propVal = v
       Debug.Print propVal.CaseIgnoreString
   Next

文字、あるいは、文字として取得できるプロパティは、これで取得することが出来ます。
propEntry.Values は、コレクションではなく、配列になっているため、For Each では いったん Variant 型の変数で受けています。  


ほかのプロパティについては、以下のように取得できます。 とはいっても、すべてを把握できたわけではないです。(^_^;) 参考になれば幸い

       For Each v In propEntry.Values

           Set propVal = v

           Select Case propEntry.ADsType

               Case ADSTYPE_UTC_TIME
                   ListAdd propEntry, propVal.UTCTime

               Case ADSTYPE_OCTET_STRING
                   Dim strHex As String
                   Dim bArray() As Byte

                   bArray = propVal.OctetString
                   strHex = ""
                   For cnt = LBound(bArray) To UBound(bArray)
                       strHex = strHex & ",0x" & Right("00" & Hex(bArray(cnt)), 2)
                   Next
                   ListAdd propEntry, "(" & Mid(strHex, 2) & ")"

               Case ADSTYPE_INTEGER
                   ListAdd propEntry, propVal.Integer

               Case ADSTYPE_DN_STRING
                   ListAdd propEntry, propVal.DNString

               Case ADSTYPE_CASE_IGNORE_STRING
                   ListAdd propEntry, propVal.CaseIgnoreString

               Case ADSTYPE_BOOLEAN
                   ListAdd propEntry, propVal.Boolean

               Case ADSTYPE_NT_SECURITY_DESCRIPTOR
                   Dim sd As IADsSecurityDescriptor
                   Set sd = propVal.SecurityDescriptor
                   ListAdd propEntry, "Control = " & sd.Control & ",Group=" & sd.Group & ",Owner=" & sd.Owner

               Case ADSTYPE_LARGE_INTEGER
                   Dim li As IADsLargeInteger
                   Set li = propVal.LargeInteger
                   ListAdd propEntry, "HighPart = " & li.HighPart & ",LowPart=" & li.LowPart

               Case ADSTYPE_DN_WITH_BINARY
                   Dim vArray() As Variant
                   Dim oCont As IADs
                   Dim var As Variant
                   Dim bin As IADsDNWithBinary

                   Set oCont = propList
                   vArray = oCont.GetEx(propEntry.Name)
                   For Each var In vArray
                       Set bin = var
                       ListAdd propEntry, bin.DNString
                   Next

               Case ADSTYPE_PROV_SPECIFIC
                   ' ADSTYPE_PROV_SPECIFIC は ADSTYPE_CASE_IGNORE_STRING で取得

               ' ここから先は未確認です。情報をいただけるとありがたいです
               Case ADSTYPE_PRINTABLE_STRING
                   ListAdd propEntry, propVal.PrintableString

               Case ADSTYPE_NUMERIC_STRING
                   ListAdd propEntry, propVal.NumericString

               Case ADSTYPE_CASE_EXACT_STRING
                   ListAdd propEntry, propVal.CaseExactString

               Case ADSTYPE_DN_WITH_STRING
                   Dim dws As IADsDNWithString
                   Set dws = v
                   ListAdd propEntry, "DNString = " & dws.DNString & ",CaseExactString = " & dws.CaseExactString

               Case Else
                   ListAdd propEntry, "**** UNKNOWN OBJECT ****"
           End Select
       Next

というわけでサンプルソースです。

テストには、OpenLDAP for Win32 を使いました。

設定ファイルを置いておきますので参考にしてみてください。



VC++6.0 に付属の Wldap32.Lib は古く、XP(SP2)や 2003 Server では使えません。

PRB: 特定 LDAP API 関数上げるエラー呼び出される場合
http://support.microsoft.com/kb/283199

相変わらずぶっとんだ日本語訳だ(^_^;)

つーか、なんでこーゆーことするんだヽ(`Д´)ノ
IE4リリース時の反省はどこいった!
最新の VC++ 使え?ウチではまだ VS6.0 使ってるんだyo! VB6.0 も現役だぜぇぇぇ




トップ   編集 凍結 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   最終更新のRSS
Last-modified: 2009-10-25 (日) 23:56:04 (2800d)