home *** CD-ROM | disk | FTP | other *** search
/ Tricks of the Windows Gam…ming Gurus (2nd Edition) / Disc2.iso / msdn_vcb / samples / vc98 / sdk / netds / adsi / sampapp / dsbrowse / main.frm (.txt) < prev    next >
Visual Basic Form  |  1997-07-29  |  12KB  |  373 lines
  1. VERSION 4.00
  2. Begin VB.Form frmBrwsTree 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Active Directory VB Browser"
  6.    ClientHeight    =   7065
  7.    ClientLeft      =   4125
  8.    ClientTop       =   2790
  9.    ClientWidth     =   7575
  10.    FillStyle       =   0  'Solid
  11.    ForeColor       =   &H00000000&
  12.    Height          =   7470
  13.    Left            =   4065
  14.    LinkTopic       =   "Form1"
  15.    MaxButton       =   0   'False
  16.    MinButton       =   0   'False
  17.    ScaleHeight     =   7065
  18.    ScaleWidth      =   7575
  19.    Top             =   2445
  20.    Width           =   7695
  21.    Begin VB.CommandButton cmdAbort 
  22.       Caption         =   "Stop"
  23.       Height          =   375
  24.       Left            =   6360
  25.       TabIndex        =   4
  26.       Top             =   720
  27.       Visible         =   0   'False
  28.       Width           =   1095
  29.    End
  30.    Begin VB.CommandButton cmdProperties 
  31.       Caption         =   "Properties..."
  32.       Height          =   375
  33.       Left            =   6360
  34.       TabIndex        =   3
  35.       Top             =   240
  36.       Width           =   1095
  37.    End
  38.    Begin VB.CommandButton cmdExit 
  39.       Caption         =   "Exit"
  40.       Height          =   375
  41.       Left            =   6360
  42.       TabIndex        =   2
  43.       Top             =   1200
  44.       Width           =   1095
  45.    End
  46.    Begin VB.Label txtPath 
  47.       Appearance      =   0  'Flat
  48.       AutoSize        =   -1  'True
  49.       BackColor       =   &H00C0C0C0&
  50.       Caption         =   "Path"
  51.       BeginProperty Font 
  52.          name            =   "Times New Roman"
  53.          charset         =   0
  54.          weight          =   400
  55.          size            =   11.25
  56.          underline       =   0   'False
  57.          italic          =   0   'False
  58.          strikethrough   =   0   'False
  59.       EndProperty
  60.       ForeColor       =   &H80000008&
  61.       Height          =   255
  62.       Left            =   360
  63.       TabIndex        =   7
  64.       Top             =   6720
  65.       Width           =   405
  66.    End
  67.    Begin VB.Label txtName 
  68.       Appearance      =   0  'Flat
  69.       BackColor       =   &H00C0C0C0&
  70.       Caption         =   "ADS:"
  71.       BeginProperty Font 
  72.          name            =   "Times New Roman"
  73.          charset         =   0
  74.          weight          =   400
  75.          size            =   12
  76.          underline       =   0   'False
  77.          italic          =   0   'False
  78.          strikethrough   =   0   'False
  79.       EndProperty
  80.       ForeColor       =   &H80000008&
  81.       Height          =   375
  82.       Left            =   360
  83.       TabIndex        =   6
  84.       Top             =   6000
  85.       Width           =   6255
  86.    End
  87.    Begin VB.Label Label3 
  88.       Caption         =   "Path:"
  89.       BeginProperty Font 
  90.          name            =   "Times New Roman"
  91.          charset         =   0
  92.          weight          =   400
  93.          size            =   11.25
  94.          underline       =   0   'False
  95.          italic          =   0   'False
  96.          strikethrough   =   0   'False
  97.       EndProperty
  98.       Height          =   375
  99.       Left            =   240
  100.       TabIndex        =   5
  101.       Top             =   6360
  102.       Width           =   855
  103.    End
  104.    Begin VB.Label Label1 
  105.       Caption         =   "Name:"
  106.       BeginProperty Font 
  107.          name            =   "Times New Roman"
  108.          charset         =   0
  109.          weight          =   400
  110.          size            =   12
  111.          underline       =   0   'False
  112.          italic          =   0   'False
  113.          strikethrough   =   0   'False
  114.       EndProperty
  115.       Height          =   375
  116.       Left            =   240
  117.       TabIndex        =   1
  118.       Top             =   5640
  119.       Width           =   855
  120.    End
  121.    Begin ComctlLib.ImageList ImageList1 
  122.       Left            =   11160
  123.       Top             =   6960
  124.       _Version        =   65536
  125.       _ExtentX        =   1005
  126.       _ExtentY        =   1005
  127.       _StockProps     =   1
  128.       BackColor       =   -2147483643
  129.       MaskColor       =   12632256
  130.    End
  131.    Begin ComctlLib.TreeView TreeView1 
  132.       Height          =   5535
  133.       Left            =   0
  134.       TabIndex        =   0
  135.       Top             =   0
  136.       Width           =   6135
  137.       _Version        =   65536
  138.       _ExtentX        =   10821
  139.       _ExtentY        =   9763
  140.       _StockProps     =   196
  141.       Appearance      =   1
  142.       ImageList       =   ""
  143.       MousePointer    =   1
  144.       PathSeparator   =   "\"
  145.       Sorted          =   -1  'True
  146.       Style           =   7
  147.    End
  148. Attribute VB_Name = "frmBrwsTree"
  149. Attribute VB_Creatable = False
  150. Attribute VB_Exposed = False
  151. Option Explicit
  152. Private Sub cmdAbort_Click()
  153. ' Allows the user to cancel a tree expand
  154.     bAbort = True
  155. End Sub
  156. Private Sub cmdExit_Click()
  157. ' Allows user to end program
  158.     End
  159. End Sub
  160. Private Sub cmdProperties_Click()
  161. ' Allows viewing of Active Directory object properties
  162.     Dim Class As IADsClass
  163.     Dim Property As IADsProperty
  164.     Dim v As Variant
  165.     Dim Value As Variant
  166.     Dim EmptyVar As Variant
  167.     '
  168.     ' Set Error handler
  169.     '
  170.     On Error Resume Next
  171.     '
  172.     ' Don't allow exit while getting properties
  173.     '
  174.     cmdExit.Visible = False
  175.     '
  176.     ' Set cursor to wait/arrow
  177.     '
  178.     Screen.MousePointer = 13
  179.     '
  180.     ' Get the object and its properties
  181.     '
  182.     Set currentADsObj = GetObject(TreeView1.SelectedItem.Key)
  183.     If Err Then
  184.         MsgBox "Could not get object"
  185.         GoTo skip
  186.     End If
  187.     frmProp.lblName.Caption = currentADsObj.Name
  188.     frmProp.lblPath.Caption = currentADsObj.ADsPath
  189.     frmProp.lblClass.Caption = currentADsObj.Class
  190.     '
  191.     ' Namespaces object and Schema object are the only two objects that
  192.     ' do not have an associated schema
  193.     '
  194.     If currentADsObj.Class = "Schema" Or _
  195.             currentADsObj.Class = "NameSpaces" Then
  196.         MsgBox "Please chose non schema object"
  197.         GoTo skip
  198.     End If
  199.     '
  200.     ' Load the form
  201.     '
  202.     Load frmProp
  203.     Set Class = GetObject(currentADsObj.Schema)
  204.     If Err Then
  205.         MsgBox "Could not get schema object"
  206.         GoTo skip
  207.     End If
  208.     If Class.Container Then
  209.         frmProp.lblIsContainer.Caption = "Yes"
  210.     Else
  211.         frmProp.lblIsContainer.Caption = "No"
  212.     End If
  213.     For Each v In Class.MandatoryProperties
  214.         Set Property = GetObject(Class.Parent + "\" + v)
  215.         Value = EmptyVar
  216.         Value = currentADsObj.Get(Property.Name)
  217.         If VarType(Value) = vbEmpty Then
  218.             frmProp.lstProperties.AddItem Property.Name & "(" & Property.Syntax & _
  219.             "):" & "<Empty>"
  220.         Else
  221.             frmProp.lstProperties.AddItem Property.Name & "(" & Property.Syntax & _
  222.             "):" & Value
  223.         End If
  224.     Next v
  225.     '
  226.     'Make form visible
  227.     '
  228.     frmProp.Visible = True
  229. skip:
  230.     cmdExit.Visible = True
  231.     '
  232.     'Set cursor to default
  233.     '
  234.     Screen.MousePointer = 0
  235. End Sub
  236. Private Sub Form_Load()
  237. ' Sets up the application main form
  238.     '
  239.     ' Define indexs for LoadResPicture API
  240.     '
  241.     Const idxComputer = 101
  242.     Const idxUser = 102
  243.     Const idxDomain = 103
  244.     Const idxSyntax = 104
  245.     Const idxService = 105
  246.     Const idxGroup = 106
  247.     Const idxPrintQueue = 107
  248.     Const idxOU = 108
  249.     Const idxFileShare = 109
  250.     Const idxOrganization = 110
  251.     Const idxCountry = 111
  252.     Const idxTop = 112
  253.     Const idxNamespace = 113
  254.     Const idxDefault = 114
  255.     Const idxNamespaces = 115
  256.     ' App icon index
  257.     Const idxApp = 101
  258.     '
  259.     ' Create temp Node variable
  260.     '
  261.     Dim nodX As Node
  262.     '
  263.     ' Load pictures into ImageList control.
  264.     '
  265.     'Dim pic As Picture
  266.     '
  267.     'Create Image variable
  268.     '
  269.     Dim imgI As ListImage
  270.     '
  271.     ' Set Error handler
  272.     '
  273.     On Error GoTo ErrorHandler
  274.     '
  275.     ' Each image/icon is loaded from the resource file.  If the image
  276.     ' is not present, the default image is used.
  277.     '
  278.     Set imgI = ImageList1.ListImages.Add(, _
  279.         "imgComputer", LoadResPicture(idxComputer, vbResBitmap))
  280.     Set imgI = ImageList1.ListImages.Add(, _
  281.         "imgUser", LoadResPicture(idxUser, vbResBitmap))
  282.     Set imgI = ImageList1.ListImages.Add(, _
  283.         "imgDomain", LoadResPicture(idxDomain, vbResBitmap))
  284.     Set imgI = ImageList1.ListImages.Add(, _
  285.         "imgSchema", LoadResPicture(idxSyntax, vbResBitmap))
  286.     Set imgI = ImageList1.ListImages.Add(, _
  287.         "imgService", LoadResPicture(idxService, vbResBitmap))
  288.     Set imgI = ImageList1.ListImages.Add(, _
  289.         "imgGroup", LoadResPicture(idxGroup, vbResBitmap))
  290.     Set imgI = ImageList1.ListImages.Add(, _
  291.         "imgPrintQueue", LoadResPicture(idxPrintQueue, vbResBitmap))
  292.     Set imgI = ImageList1.ListImages.Add(, _
  293.         "imgFileShare", LoadResPicture(idxFileShare, vbResBitmap))
  294.     Set imgI = ImageList1.ListImages.Add(, _
  295.         "imgOrganization", LoadResPicture(idxOrganization, vbResBitmap))
  296.     Set imgI = ImageList1.ListImages.Add(, _
  297.         "imgCountry", LoadResPicture(idxCountry, vbResBitmap))
  298.     Set imgI = ImageList1.ListImages.Add(, _
  299.         "imgNameSpace", LoadResPicture(idxNamespace, vbResBitmap))
  300.     Set imgI = ImageList1.ListImages.Add(, _
  301.         "imgNamespaces", LoadResPicture(idxNamespaces, vbResBitmap))
  302.     Set imgI = ImageList1.ListImages.Add(, _
  303.         "imgFileService", LoadResPicture(idxDefault, vbResBitmap))
  304.     Set imgI = ImageList1.ListImages.Add(, _
  305.         "imgDefault", LoadResPicture(idxDefault, vbResBitmap))
  306.     frmBrwsTree.Icon = LoadResPicture(idxApp, vbResIcon)
  307.     '
  308.     ' Set TreeView control properties.
  309.     '
  310.     TreeView1.ImageList = ImageList1    ' Initialize ImageList
  311.     TreeView1.Style = tvwTreelinesPlusMinusPictureText ' Style 7
  312.     TreeView1.LineStyle = tvwRootLines
  313.     TreeView1.Indentation = 50
  314.     strPath = "ADS:" ' Default start of browse
  315.     Call enumerate_path(nodX)
  316.     GoTo finish
  317. ErrorHandler:
  318.     errstring = "Had an error:" & Err.Number
  319.     ERRNUMB = Err.Number
  320.     MsgBox errstring
  321.     Resume Next
  322. finish:
  323. End Sub
  324. Private Sub TreeView1_Collapse(ByVal Node As Node)
  325. ' To do when collapsing a node
  326.     txtName.Caption = Node.Text
  327.     txtPath.Caption = Node.Key
  328. End Sub
  329. Private Sub TreeView1_Expand(ByVal Node As Node)
  330. ' Process a node expand
  331.     Dim ChildNode As Node
  332.     On Error GoTo ErrorHandler
  333.     TreeView1.MousePointer = 13
  334.     ' Only expand once so check for "Dummy" child
  335.     If Node.Child = "Dummy" Then
  336.         Node.Sorted = True
  337.         If bStartup = False Then
  338.         
  339.             cmdExit.Visible = False
  340.             txtName.Caption = Node.Text
  341.             txtPath.Caption = Node.Key
  342.         
  343.             Set ChildNode = Node.Child
  344.             If ChildNode.Text = "Dummy" Then
  345.                 TreeView1.Nodes.Remove (ChildNode.Key)
  346.             End If
  347.             cmdAbort.Visible = True
  348.             cmdAbort.SetFocus
  349.             DoEvents
  350.             
  351.             strPath = Node.Key
  352.         
  353.             Call enumerate_path(Node)
  354.             
  355.         End If
  356.     End If
  357. GoTo finish
  358. ErrorHandler:
  359.     errstring = "Had an error:" & Err.Number
  360.     ERRNUMB = Err.Number
  361.     MsgBox errstring
  362. finish:
  363.     cmdExit.Visible = True
  364.     Node.Sorted = True
  365.     cmdAbort.Visible = False
  366.     TreeView1.MousePointer = 0
  367. End Sub
  368. Private Sub TreeView1_NodeClick(ByVal Node As Node)
  369. ' Process a node click
  370.     txtName.Caption = Node.Text
  371.     txtPath.Caption = Node.Key
  372. End Sub
  373.