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 / property.frm (.txt) < prev    next >
Visual Basic Form  |  1997-07-29  |  9KB  |  290 lines
  1. VERSION 4.00
  2. Begin VB.Form frmProp 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Properties"
  5.    ClientHeight    =   4710
  6.    ClientLeft      =   5955
  7.    ClientTop       =   4245
  8.    ClientWidth     =   7080
  9.    Height          =   5115
  10.    Left            =   5895
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   4710
  15.    ScaleWidth      =   7080
  16.    Top             =   3900
  17.    Width           =   7200
  18.    Begin VB.CommandButton cmdSet 
  19.       Caption         =   "Set"
  20.       Height          =   375
  21.       Left            =   5760
  22.       TabIndex        =   13
  23.       Top             =   4080
  24.       Width           =   1215
  25.    End
  26.    Begin VB.TextBox txtValue 
  27.       BeginProperty Font 
  28.          name            =   "MS Sans Serif"
  29.          charset         =   0
  30.          weight          =   400
  31.          size            =   9.75
  32.          underline       =   0   'False
  33.          italic          =   0   'False
  34.          strikethrough   =   0   'False
  35.       EndProperty
  36.       Height          =   360
  37.       Left            =   840
  38.       TabIndex        =   12
  39.       Top             =   4080
  40.       Width           =   4815
  41.    End
  42.    Begin VB.ListBox lstProperties 
  43.       Appearance      =   0  'Flat
  44.       BeginProperty Font 
  45.          name            =   "MS Sans Serif"
  46.          charset         =   0
  47.          weight          =   400
  48.          size            =   9.75
  49.          underline       =   0   'False
  50.          italic          =   0   'False
  51.          strikethrough   =   0   'False
  52.       EndProperty
  53.       Height          =   1950
  54.       ItemData        =   "property.frx":0000
  55.       Left            =   120
  56.       List            =   "property.frx":0002
  57.       Sorted          =   -1  'True
  58.       TabIndex        =   9
  59.       Top             =   1920
  60.       Width           =   6735
  61.    End
  62.    Begin VB.CommandButton cmdOK 
  63.       Caption         =   "Close"
  64.       Height          =   375
  65.       Left            =   5760
  66.       TabIndex        =   8
  67.       Top             =   480
  68.       Width           =   975
  69.    End
  70.    Begin VB.Label Label8 
  71.       Caption         =   "Value:"
  72.       BeginProperty Font 
  73.          name            =   "MS Sans Serif"
  74.          charset         =   0
  75.          weight          =   400
  76.          size            =   9.75
  77.          underline       =   0   'False
  78.          italic          =   0   'False
  79.          strikethrough   =   0   'False
  80.       EndProperty
  81.       Height          =   255
  82.       Left            =   120
  83.       TabIndex        =   11
  84.       Top             =   4200
  85.       Width           =   735
  86.    End
  87.    Begin VB.Label Label5 
  88.       Caption         =   "Properties"
  89.       BeginProperty Font 
  90.          name            =   "MS Sans Serif"
  91.          charset         =   0
  92.          weight          =   400
  93.          size            =   9.75
  94.          underline       =   0   'False
  95.          italic          =   0   'False
  96.          strikethrough   =   0   'False
  97.       EndProperty
  98.       Height          =   255
  99.       Left            =   240
  100.       TabIndex        =   10
  101.       Top             =   1560
  102.       Width           =   3255
  103.    End
  104.    Begin VB.Label lblIsContainer 
  105.       BackColor       =   &H00C0C0C0&
  106.       Height          =   255
  107.       Left            =   1200
  108.       TabIndex        =   7
  109.       Top             =   1200
  110.       Width           =   1935
  111.    End
  112.    Begin VB.Label lblClass 
  113.       BackColor       =   &H00C0C0C0&
  114.       Height          =   255
  115.       Left            =   1200
  116.       TabIndex        =   6
  117.       Top             =   840
  118.       Width           =   4575
  119.    End
  120.    Begin VB.Label lblPath 
  121.       BackColor       =   &H00C0C0C0&
  122.       Height          =   255
  123.       Left            =   1200
  124.       TabIndex        =   5
  125.       Top             =   480
  126.       Width           =   4575
  127.    End
  128.    Begin VB.Label lblName 
  129.       BackColor       =   &H00C0C0C0&
  130.       Height          =   255
  131.       Left            =   1200
  132.       TabIndex        =   4
  133.       Top             =   120
  134.       Width           =   1935
  135.    End
  136.    Begin VB.Label Label4 
  137.       Alignment       =   1  'Right Justify
  138.       Appearance      =   0  'Flat
  139.       BackColor       =   &H00C0C0C0&
  140.       Caption         =   "IsContainer:"
  141.       ForeColor       =   &H80000008&
  142.       Height          =   255
  143.       Left            =   120
  144.       TabIndex        =   3
  145.       Top             =   1200
  146.       Width           =   855
  147.    End
  148.    Begin VB.Label Label3 
  149.       Alignment       =   1  'Right Justify
  150.       BackColor       =   &H00C0C0C0&
  151.       Caption         =   "Class:"
  152.       Height          =   255
  153.       Left            =   120
  154.       TabIndex        =   2
  155.       Top             =   840
  156.       Width           =   855
  157.    End
  158.    Begin VB.Label Label2 
  159.       Alignment       =   1  'Right Justify
  160.       Appearance      =   0  'Flat
  161.       BackColor       =   &H00C0C0C0&
  162.       Caption         =   "ADsPath:"
  163.       ForeColor       =   &H80000008&
  164.       Height          =   255
  165.       Left            =   120
  166.       TabIndex        =   1
  167.       Top             =   480
  168.       Width           =   855
  169.    End
  170.    Begin VB.Label Label1 
  171.       Alignment       =   1  'Right Justify
  172.       Appearance      =   0  'Flat
  173.       BackColor       =   &H00C0C0C0&
  174.       Caption         =   "Name:"
  175.       ForeColor       =   &H80000008&
  176.       Height          =   255
  177.       Left            =   120
  178.       TabIndex        =   0
  179.       Top             =   120
  180.       Width           =   855
  181.    End
  182. Attribute VB_Name = "frmProp"
  183. Attribute VB_Creatable = False
  184. Attribute VB_Exposed = False
  185. Option Explicit
  186. Private Sub cmdCancel_Click()
  187. ' Allow user to cancel
  188.     Unload Me
  189. End Sub
  190. Private Sub cmdOK_Click()
  191. ' Allow user to close form
  192.     Unload Me
  193. End Sub
  194. Private Sub cmdSet_Click()
  195. ' Process Set Property command
  196.     Dim strProp As String
  197.     Dim strSyntax As String
  198.     Dim strOld As String
  199.     Dim Val As Variant
  200.     Dim I As Integer
  201.     Dim pos1 As Integer  'Finds "(" in string to locate syntax
  202.     Dim pos2 As Integer  'Finds ")" in string to locate syntax
  203.     '
  204.     ' Set error handling
  205.     '
  206.     On Error Resume Next
  207.     I = lstProperties.ListIndex
  208.     If currentADsObj Is Nothing Then
  209.         '
  210.         ' There is no object associated with this interface.
  211.         ' Do nothing.
  212.         '
  213.         GoTo finish
  214.         
  215.     End If
  216.     '
  217.     'Need to strip Prop off Prop(SYNTAX):Value
  218.     '
  219.     strOld = lstProperties.Text
  220.     pos1 = InStr(strOld, "(")
  221.     pos2 = InStr(pos1, strOld, ")")
  222.     strSyntax = Right(strOld, (Len(strOld) - pos1))
  223.     strSyntax = Left(strSyntax, ((pos2 - pos1) - 1))
  224.     strProp = Left(strOld, (pos1 - 1))
  225.     If (strSyntax = "ADsPath") Or (strSyntax = "String") Or (strSyntax = "DirectoryString") Then
  226.         Val = txtValue.Text
  227.     ElseIf (strSyntax = "Counter") Or (strSyntax = "Integer") _
  228.             Or (strSyntax = "Interval") Then
  229.         Val = CLng(txtValue.Text)
  230.     ElseIf (strSyntax = "SmallInterval") Then
  231.         Val = CLng(txtValue.Text)
  232.     ElseIf (strSyntax = "List") Or (strSyntax = "OctetString") Then
  233.         Val = CVar(txtValue.Text)
  234.     ElseIf (strSyntax = "PhoneNumber") Or (strSyntax = "PostalAddress") Then
  235.         Val = txtValue.Text
  236.     ElseIf strSyntax = "Boolean" Then
  237.         Val = CBool(txtValue.Text)
  238.     ElseIf (strSyntax = "EmailAddress") Or (strSyntax = "FaxNumber") Then
  239.         Val = txtValue.Text
  240.     ElseIf strSyntax = "NetAddress" Or strSyntax = "Path" Then
  241.         Val = txtValue.Text
  242.     ElseIf strSyntax = "Time" Then
  243.         Val = CDate(txtValue.Text)
  244.     Else
  245.         '
  246.         ' If none of the syntax cases above are found we bail out silently
  247.         '
  248.         GoTo finish
  249.     End If
  250.     strOld = Left(strOld, (pos2 + 1)) & txtValue.Text
  251.     currentADsObj.Put strProp, Val
  252.     Err = 0
  253.     currentADsObj.SetInfo
  254.     If Err Then
  255.         MsgBox "Could not Set Property, check access "
  256.         GoTo finish
  257.     End If
  258.     lstProperties.RemoveItem I
  259.     lstProperties.AddItem strOld, I
  260. finish:
  261. End Sub
  262. Private Sub Form_Load()
  263.     '
  264.     ' User cannot bring up second properties dialog box
  265.     '
  266.         frmBrwsTree.cmdProperties.Enabled = False
  267. End Sub
  268. Private Sub Form_Unload(Cancel As Integer)
  269.     '
  270.     ' Enable properties command
  271.     '
  272.     frmBrwsTree.cmdProperties.Enabled = True
  273. End Sub
  274. Private Sub lstProperties_Click()
  275. 'Do on Properties command
  276.     Dim pos1 As Integer
  277.     Dim pos2 As Integer
  278.     Dim strVal As String
  279.     Dim strTemp As String
  280.     On Error GoTo finish
  281.     strTemp = lstProperties.List(lstProperties.ListIndex)
  282.     pos1 = InStr(strTemp, "(")
  283.     pos2 = InStr(pos1, strTemp, ")")
  284.     pos1 = InStr(pos2, strTemp, ":")
  285.     strVal = Right(strTemp, (Len(strTemp) - pos1))
  286.     txtValue.Text = strVal
  287.     frmProp.Refresh
  288. finish:
  289. End Sub
  290.