[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[原创] VBS源码-LDAP查询器命令行版

本帖最后由 yu2n 于 2013-12-1 13:35 编辑

VBS源码-LDAP查询器
功能:查询域用户信息
环境:WinXP域内主机、WinXP域外主机、Win2003
作者:yu2n
简介:很小众的东西,因为一般人用不上就不多说了,知道的人自然知道。
提示:注意需要域用户账号验证的部分
  1. GetADInfo("hkadmin", "hk123456", "hkHeXie.com", sColumnName, sQuery, CInt(sPageSize), CInt(sThisPage))
复制代码
  1.     ' 使用其他域用户验证-开始
  2.     objConnection.Properties("User ID") = sADUserName
  3.     objConnection.Properties("Password") = sADPassword
  4.     objConnection.Properties("Encrypt Password") = TRUE
  5.     objConnection.Properties("ADSI Flag") = 1
  6.     ' 使用其他域用户验证-结束
复制代码

代码如下:
  1. 'On Error Resume Next
  2. CmdMode "LDAP查询", "1f"
  3. Main
  4. Sub Main
  5.     Dim sQuery, sInfo
  6.     sQuery = "(Department='*采购部*' And samAccountName='*CG*' And DisplayName='**')"
  7.     sQuery = "(samAccountName='*CG001*')"
  8.     sQuery = "(Department='*料*' And DisplayName='*min*')"
  9.     Do
  10.         sInfo = ""
  11.         ' 取得輸入的SQL 命令
  12.         sQuery = InputBox(  "請輸入以下查询字段:" & vbCrLf & vbCrLf & _
  13.                             " 登陸名(samAccountName)" & vbCrLf & _
  14.                             " 用戶名(Name)" & vbCrLf & _
  15.                             " 姓名(DisplayName)" & vbCrLf & _
  16.                             " 部门(Department)" & vbCrLf & vbCrLf & _
  17.                             "SQL 命令:", _
  18.                             "LDAP 查詢", _
  19.                             sQuery)
  20.         If sQuery = "" Then
  21.             Exit Do
  22.         Else
  23.             ' 取得姓名(displayName)、郵箱地址(mail)信息
  24.             ' physicalDeliveryOfficeName,Department,Title,CN,givenName,sn,samAccountName,DisplayName,Mail
  25.             ' cn,givenName,sn,samAccountName,
  26.             ' name,samAccountName, userPrincipalName, distinguishedName
  27.             sPageSize = 50
  28.             sThisPage = 1
  29.             sColumnName = "physicalDeliveryOfficeName,department,title,samAccountName,DisplayName,Mail"
  30.             arrTable = GetADInfo("hkadmin", "hk123456", "hkHeXie.com", sColumnName, sQuery, CInt(sPageSize), CInt(sThisPage))
  31.             If IsArray(arrTable) Then
  32.                 sTable = TableFormat_Arr2String(arrTable, Split(sColumnName,","))
  33.                 sTable = "  +----------------------------------------------------------------------------+" & vbCrLf & sTable & vbCrLf
  34.                 sTable = sTable & "  +----------------------------------------------------------------------------+" & vbCrLf
  35.                 WScript.Echo sTable
  36.                 EchoLog sTable
  37.             End If
  38.          End If
  39.     Loop
  40. End Sub
  41. ' 使用域用户来查找其他域用户信息
  42. ' 示例:GetADInfo("hkadmin", "hk123456", "dc1.demo.com", "samAccountName,Name,DisplayName,Mail", "samAccountName='*He*'")
  43. ' 参数1=域用户名,参数2=域用户密码,参数3=网域名,参数4=查询的字段,参数5=查询条件
  44. Function GetADInfo(ByVal sADUserName, ByVal sADPassword, ByVal sDC, ByVal sColumnName, ByVal sConditional, ByVal sPageSize, ByVal sThisPage)
  45.     On Error Resume Next
  46.     Const ADS_SCOPE_SUBTREE = 2
  47.     Dim objConnection, objCommand, strSQL, sInfo
  48.    
  49.     ' 創建 ADODB 連接查詢
  50.     Set objConnection = CreateObject("ADODB.Connection")
  51.     Set objCommand =   CreateObject("ADODB.Command")
  52.     objConnection.Provider = "ADsDSOObject"
  53.     ' 使用其他域用户验证-开始
  54.     objConnection.Properties("User ID") = sADUserName
  55.     objConnection.Properties("Password") = sADPassword
  56.     objConnection.Properties("Encrypt Password") = TRUE
  57.     objConnection.Properties("ADSI Flag") = 1
  58.     ' 使用其他域用户验证-结束
  59.     objConnection.Open "Active Directory Provider"
  60.     ' 查询信息限制(分页、排序)
  61.     Set objCommand.ActiveConnection = objConnection
  62.     objCommand.Properties("Page Size") = CInt(sPageSize)
  63.     objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
  64.     objCommand.Properties("Sort On") = "Name"
  65.    
  66.     ' 执行 SQL 搜索
  67.     strSQL = " SELECT " & sColumnName & _
  68.             " FROM 'LDAP://" & sDC & "' " & _
  69.             " WHERE objectCategory='user' AND (" & sConditional & ")"
  70.     objCommand.CommandText = Trim(strSQL)
  71.     WScript.Echo "SQL: " & vbCrLf & strSQL & vbCrLf
  72.    
  73.     ' 在返回的搜索結果中提取
  74.     Dim objRecordSet, rsCount
  75.     Set objRecordSet = objCommand.Execute
  76.     objRecordSet.MoveFirst
  77.     rsCount = objRecordSet.RecordCount
  78.     If Not rsCount = 0 Then
  79.         If Not objRecordSet.Eof Then
  80.             objRecordSet.PageSize = CInt(sPageSize)
  81.             sPageCount = objRecordSet.PageCount
  82.             If sThisPage = "" Or sThisPage =< 1 Then sThisPage = 1
  83.             If sThisPage > sPageCount Then  sThisPage = sPageCount
  84.             objRecordSet.AbsolutePage = CInt(sThisPage)
  85.             sLastPageSize = objRecordSet.RecordCount - (objRecordSet.PageCount - 1) * CInt(sPageSize)
  86.             ' 当前页面的记录数
  87.             If CInt(sPageCount) = CInt(sThisPage) Then
  88.                 sThisPageRecordCount = sLastPageSize
  89.             Else
  90.                 sThisPageRecordCount = CInt(sPageSize)
  91.             End If
  92.             WScript.Echo "页数:  " & "  第 " & sThisPage & " 页 / 共 " & sPageCount & " 页"
  93.             WScript.Echo "记录:  " & "显示 " & sThisPageRecordCount & " 条 / 共 " & rsCount & " 条"
  94.         End If
  95.         ' 要搜索的字段(列)
  96.         Dim arrColumnName, arrColumnValue, arrRS(), x, y
  97.         arrColumnName = Split(sColumnName, ",")
  98.         ' 定义二维数组记录
  99.         ReDim Preserve arrRS(sThisPageRecordCount -1, Ubound(arrColumnName))
  100.         'Do Until objRecordSet.EOF
  101.         ' 遍历记录数(行)
  102.         For x = 0 To sThisPageRecordCount -1
  103.             ' If objRecordSet.EOF Then Exit For
  104.             ' 遍历记录条目(列)
  105.             For y = 0 To UBound(arrColumnName)
  106.                 'sTmp = objRecordSet(y)  '
  107.                 sTmp = objRecordSet.Fields( Trim(arrColumnName(y)) ).Value
  108.                 If IsNull(sTmp) Then
  109.                     arrRS(x,y) = ""
  110.                 ElseIf IsArray(sTmp) Then
  111.                     arrRS(x,y) = Join(sTmp,"|")
  112.                 Else
  113.                     arrRS(x,y) = sTmp
  114.                 End If
  115.             Next
  116.             objRecordSet.MoveNext
  117.         Next
  118.         GetADInfo = arrRS
  119.     Else
  120.         Exit Function
  121.     End If
  122. End Function
  123. ' 将二维数组输出成字符串
  124. ' arrTable 二维数组表,arrColumnName 一维数组列名
  125. Function TableFormat_Arr2String(ByVal arrTable, ByVal arrColumnName)
  126.     arr2string = ""
  127.     If IsArray(arrTable) Then
  128.         ' 添加列到首行
  129.         Dim arrTableText()
  130.         ReDim Preserve arrTableText(UBound(arrTable, 1) +1, Ubound(arrTable,2))
  131.         For i = 0 To UBound(arrTable, 2)
  132.             arrTableText(0, i) = arrColumnName(i)
  133.         Next
  134.         ' 重新定义二维数组
  135.         Dim x, y
  136.         For x = 0 To UBound(arrTable, 1)
  137.             For y = 0 To UBound(arrTable, 2)
  138.                 arrTableText(x +1, y) = arrTable(x, y)
  139.             Next
  140.         Next
  141.         ' 等列宽,不足补充空格
  142.         Dim sTable, sTableLine, arrLength()
  143.         For y = 0 To UBound(arrTableText, 2)
  144.             ReDim Preserve arrLength(y)
  145.             For x = 0 To UBound(arrTableText, 1)
  146.                 If arrLength(y) = "" Then arrLength(y) = 0
  147.                 If arrLength(y) < strLength(arrTableText(x, y)) Then
  148.                     arrLength(y) = strLength(arrTableText(x, y))
  149.                 End If
  150.             Next
  151.         Next
  152.         For x = 0 To UBound(arrTableText, 1)
  153.             sTableLine = ""
  154.             For y = 0 To UBound(arrTableText, 2)
  155.                 sTableLine = sTableLine & arrTableText(x, y) & Space(arrLength(y) - strLength(arrTableText(x, y))) & ","
  156.             Next
  157.             sTableLine = Left(sTableLine, Len(sTableLine)-Len(","))
  158.             If x = 0 Then
  159.                 sNo = " "
  160.             Else
  161.                 sNo = x
  162.             End If
  163.             sNo = Space(Len(UBound(arrTableText, 1)+1) - Len(sNo)) & sNo
  164.             sTableLine = sNo & "| " & sTableLine
  165.             sTable = sTable & sTableLine & vbCrLf
  166.         Next
  167.         sTable = Left(sTable, Len(sTable)-Len(vbCrLf))
  168.         TableFormat_Arr2String = sTable
  169.     End If
  170. End Function
  171. Function strLength(ByVal str)
  172.     On Error Resume Next
  173.     Dim WINNT_CHINESE
  174.     WINNT_CHINESE = (Len("论坛") = 2)
  175.     If WINNT_CHINESE  Then
  176.         Dim l,t,c
  177.         Dim i
  178.         l = Len(str)
  179.         t = l
  180.         For i = 1  To  l
  181.             c = Asc(Mid(str,i,1))
  182.             If  c < 0  Then  c = c + 65536
  183.             If  c > 255  Then
  184.                 t = t + 1
  185.             End If
  186.         Next
  187.         strLength = t
  188.     Else
  189.         strLength = Len(str)
  190.     End If
  191.     If Err.Number <> 0 Then Err.Clear
  192. End Function
  193. Function CmdMode(ByVal title,ByVal color)   '强制以命令行模式运行
  194.     If LCase(Right(WScript.FullName,11))="wscript.exe" Then
  195.         With CreateObject("Wscript.Shell")
  196.             .Run "cmd /c mode con: cols=200&title "&title&"&color "&color&"&Cscript //Nologo """ & WScript.ScriptFullName & """"
  197.             '.Run "taskkill /f /im cmd.exe",0
  198.         End With
  199.         WScript.Quit
  200.     End If
  201. End Function
  202. Function EchoLog(str)
  203. On Error Resume  Next
  204. str = str & vbCrLf
  205.     'sFileDir = Left(sFilePath, InStrRev(sFilePath, "\")-1)
  206.     file = WScript.ScriptFullName & ".log"
  207. Dim fso, wtxt
  208. Const ForAppending = 8 'ForReading = 1 (只读不写), ForWriting = 2 (只写不读), ForAppending = 8 (在文件末尾写)
  209. Const Create = True 'Boolean 值,filename 不存在时是否创建新文件。允许创建为 True,否则为 False。默认值为 False。
  210. Const TristateTrue = -1 'TristateUseDefault = -2 (SystemDefault), TristateTrue = -1 (Unicode), TristateFalse = 0 (ASCII)
  211. Set fso = CreateObject("Scripting.filesystemobject")
  212. set wtxt = fso.OpenTextFile(file, ForAppending, Create, TristateTrue)
  213. wtxt.Write str      :     wtxt.Close()
  214. set fso = Nothing      :     set wtxt = Nothing     :     WriteLog = True
  215. End Function
复制代码
2

评分人数

『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

楼主给力啊
nevermore

TOP

返回列表