Programming Tool Box/SIMS_2.iso/vb_code1/nw_bind2/nwbind.frm

Text File | 1994-06-21 | 20KB | 605 lines

VERSION 2.00
Begin Form WinBindBrow
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   Caption         =   "WinBindBrow"
   ClientHeight    =   6990
   ClientLeft      =   255
   ClientTop       =   1140
   ClientWidth     =   6570
   Height          =   7680
   Icon            =   NWBIND.FRX:0000
   Left            =   195
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   6990
   ScaleWidth      =   6570
   Top             =   510
   Width           =   6690
   Begin Frame Frame1
      Caption         =   "&Display Style"
      Height          =   1005
      Left            =   1620
      TabIndex        =   8
      Top             =   5850
      Width           =   3435
      Begin OptionButton optDispType
         Caption         =   "&Set"
         Height          =   285
         Index           =   3
         Left            =   1800
         TabIndex        =   12
         Top             =   630
         Width           =   1545
      End
      Begin OptionButton optDispType
         Caption         =   "&Hex Dump"
         Height          =   285
         Index           =   1
         Left            =   90
         TabIndex        =   10
         Top             =   630
         Width           =   1545
      End
      Begin OptionButton optDispType
         Caption         =   "No&rmal"
         Height          =   285
         Index           =   0
         Left            =   90
         TabIndex        =   9
         Top             =   270
         Width           =   1545
      End
      Begin OptionButton optDispType
         Caption         =   "&Enhanced"
         Height          =   285
         Index           =   2
         Left            =   1800
         TabIndex        =   11
         Top             =   270
         Width           =   1545
      End
   End
   Begin TextBox txtPropertyValue
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Terminal"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   2175
      Left            =   180
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   7
      Text            =   "Text1"
      Top             =   3600
      Width           =   6345
   End
   Begin PictureBox picPropSec
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   1095
      Left            =   4230
      ScaleHeight     =   1065
      ScaleWidth      =   2235
      TabIndex        =   14
      TabStop         =   0   'False
      Top             =   2250
      Width           =   2265
   End
   Begin ListBox lbProperty
      Height          =   1005
      Left            =   180
      Sorted          =   -1  'True
      TabIndex        =   5
      Top             =   2250
      Width           =   3975
   End
   Begin PictureBox picObjSec
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   1005
      Left            =   4230
      ScaleHeight     =   975
      ScaleWidth      =   2235
      TabIndex        =   13
      TabStop         =   0   'False
      Top             =   900
      Width           =   2265
   End
   Begin ListBox lbObject
      Height          =   1005
      Left            =   180
      Sorted          =   -1  'True
      TabIndex        =   3
      Top             =   900
      Width           =   3975
   End
   Begin ComboBox cmbObjType
      Height          =   300
      Left            =   180
      Sorted          =   -1  'True
      TabIndex        =   1
      Text            =   "Combo1"
      Top             =   270
      Width           =   4245
   End
   Begin Label lblControl
      Caption         =   "&Value:"
      Height          =   195
      Index           =   3
      Left            =   180
      TabIndex        =   6
      Top             =   3330
      Width           =   1545
   End
   Begin Label lblControl
      Caption         =   "&Properties:"
      Height          =   195
      Index           =   2
      Left            =   180
      TabIndex        =   4
      Top             =   1980
      Width           =   1545
   End
   Begin Label lblControl
      Caption         =   "Object &Names:"
      Height          =   195
      Index           =   1
      Left            =   180
      TabIndex        =   2
      Top             =   630
      Width           =   1545
   End
   Begin Label lblControl
      Caption         =   "Object &Types:"
      Height          =   195
      Index           =   0
      Left            =   180
      TabIndex        =   0
      Top             =   0
      Width           =   1545
   End
   Begin Menu MNU_File
      Caption         =   "&File"
      Begin Menu MNU_FileSave
         Caption         =   "&Save"
      End
      Begin Menu MNU_FileAbout
         Caption         =   "&About"
      End
      Begin Menu MNU_FileExit
         Caption         =   "E&xit"
      End
   End
   Begin Menu MNU_Options
      Caption         =   "&Options"
      Begin Menu MNU_OptionsSel
         Caption         =   "&Auto Switch"
         Checked         =   -1  'True
         Index           =   0
      End
      Begin Menu MNU_OptionsSel
         Caption         =   "&Prompt for save"
         Checked         =   -1  'True
         Index           =   1
      End
   End
End
DefInt A-Z

' Feel free to use or modify NWBIND.
' Address any questions or comments to
' Scott Johnston, CIS: 72677,1570 MHS: ScottJ@Alta

'This program will scan the bindery of a netware file server
'v1.5 6-21-1994 changed declares to 'new' nwNetAPI
'               made the code look a little better
'

Declare Function GetConnectionInformation Lib "NWNetAPI.dll" (ByVal Conn&, ByVal UserID As String, ObjType%, ObjID&, ByVal LoginTime As String) As Integer
Declare Function GetConnectionNumber Lib "NWNetAPI.dll" () As Long
Declare Function ScanBinderyObject Lib "NWNetAPI.dll" (ByVal SObjName$, ByVal SObjType%, LastObjID&, ByVal ObjName$, ObjType%, ObjProp%, ObjFlag%, ObjSec%) As Integer
Declare Function ScanProperty Lib "NWNetAPI.dll" (ByVal SObjName$, ByVal SObjType%, ByVal SPropName$, SeqNum&, ByVal PropName$, PropFlag%, PropSec%, PropVal%, PropMore%) As Integer
Declare Function ReadPropertyValue Lib "NWNetAPI.dll" (ByVal SObjName$, ByVal SObjType%, ByVal SPropName$, ByVal Segment%, ByVal PropValue$, PropValMore%, PropValFlag%) As Integer
Declare Function GetBinderyObjectName Lib "NWNetAPI.dll" (ByVal SObjID&, ByVal ObjName$, ObjType%)


Dim FileName$
Dim CR$
Dim Zero$
Dim TabC$

Sub cmbObjType_Click ()
    UpdateList
    cmbObjType.Tag = Str$(cmbObjType.ListIndex)
    If lbObject.ListCount > 0 Then
        lbObject.ListIndex = 0
    End If
End Sub

Sub cmbObjType_KeyPress (KeyAscii As Integer)
    If KeyAscii = 13 Then
        If InStr(cmbObjType.Text, " - ") > 0 Then
            UpdateObjs (cmbObjType.Text)
        End If
        UpdateList
        KeyAscii = 0
        cmbObjType.SelStart = 0
        cmbObjType.SelLength = Len(cmbObjType.Text)
    End If
End Sub

Sub DispObjInfo (ObjProp%, ObjFlag%, ObjSec%)
    picObjSec.Cls
    WSec$ = GetSecurity$(Int(ObjSec% / 16))
    RSec$ = GetSecurity$((ObjSec% And &HF))
    picObjSec.Print "Object Security:" + TabC$ + TabC$ + Hex$(ObjSec%)
    picObjSec.Print "Write: " + TabC$ + WSec$
    picObjSec.Print "Read:  " + TabC$ + RSec$
    If ObjFlag% = 0 Then
        picObjSec.Print "Static  " + TabC$ + TabC$ + TabC$ + Hex$(ObjFlag%)
    Else
        picObjSec.Print "Dynamic" + TabC$ + TabC$ + Hex$(ObjFlag%)
    End If
    If ObjProp% = 0 Then
        picObjSec.Print "No properties" + TabC$ + TabC$ + Hex$(ObjProp%)
    Else
        picObjSec.Print "Object has properties" + TabC$ + Hex$(ObjProp%)
    End If

End Sub

Sub DispProp (Property$, PropFlag%)
    'displays to properly formatted property
    HexDisp% = Val(txtPropertyValue.Tag)
    Select Case HexDisp%
        Case 0  'normal string
            DispProperty$ = Property$
        Case 1  'display hex dump of the property value
            Temp$ = Property$
            IntCount% = 1
            For i% = 1 To Len(Temp$)
                HexCode$ = Hex$(Asc(Mid$(Temp$, i%, 1)))
                If Len(HexCode$) = 1 Then HexCode$ = "0" + HexCode$
                HexCode$ = HexCode$ + " "
                HStr$ = HStr$ + HexCode$
                If IntCount% = 16 Then
                    HStr$ = HStr$ + CR$
                    IntCount% = 1
                Else
                    IntCount% = IntCount% + 1
                End If
            Next i%
            DispProperty$ = HStr$
        Case 2  'display as text,  but ignore nulls
            PropHold$ = Property$
            For i% = 1 To Len(PropHold$)
                If Mid$(PropHold$, i%, 1) = Zero$ Then
                    Prop$ = Prop$ + "_"
                Else
                    Prop$ = Prop$ + Mid$(PropHold$, i%, 1)
                End If
            Next i%
            DispProperty$ = Prop$
        Case 3  'display as list of members of set
            ObjectCount% = 1
            Do  'get all the names of the object ids in the set
                ObjID$ = Mid$(Property$, ObjectCount%, 4)
                If Len(ObjID$) = 0 Then Exit Do
                ObjHex$ = ""
                If ObjID$ = String$(4, Chr$(0)) Then Exit Do
                For i% = 1 To 4
                    HexCode$ = Hex$(Asc(Mid$(ObjID$, i%, 1)))
                    If Len(HexCode$) = 1 Then HexCode$ = "0" + HexCode$
                    ObjHex$ = ObjHex$ + HexCode$
                Next i%
                SetObjID& = (Val("&h" + ObjHex$))
                OName$ = Space$(50)
                Ret% = GetBinderyObjectName(SetObjID&, OName$, OType%)
                ObjTy$ = FindObjDesc$(OType%)
                ONameT$ = GetCString$(OName$)
                If Len(ONameT$) = 0 Then
                    ONameT$ = "Unknown Object"
                Else
                    ONameT$ = ONameT$ + " - " + ObjTy$ + " (" + Hex$(OType%) + ")"

                End If
                SetProp$ = SetProp$ + ONameT$ + Chr$(13) + Chr$(10)
                ObjectCount% = ObjectCount% + 4
            Loop
            DispProperty$ = SetProp$
    End Select
    txtPropertyValue.Text = DispProperty$

End Sub

Sub DispPropInfo (PropFlag%, PropSec%, PropHasVal%, PropMore%)
    picPropSec.Cls
    picPropSec.Print "Property Security" + TabC$ + Hex$(PropSec%)
    picPropSec.Print "Write" + TabC$ + GetSecurity$(Int(PropSec% / &H10))
    picPropSec.Print "Read" + TabC$ + GetSecurity$(PropSec% And &HF)
    If (PropFlag% And 1) = 1 Then
        picPropSec.Print "Dynamic" + TabC$ + TabC$ + Hex$(PropFlag%)
    Else
        picPropSec.Print "Static" + TabC$ + TabC$ + TabC$ + Hex$(PropFlag%)
    End If
    If (PropFlag% And 2) = 2 Then
        picPropSec.Print "Set"
    Else
        picPropSec.Print "Item"
    End If
    If PropHasVal% = 0 Then
        picPropSec.Print "Property has no value" + TabC$ + Hex$(PropHasVal%)
    Else
        picPropSec.Print "Property has value" + TabC$ + Hex$(PropHasVal%)
    End If

End Sub

Function FindObjDesc$ (ObjType%)
    For i% = 0 To cmbObjType.ListCount - 1
        If Val("&H" + cmbObjType.List(i%)) = ObjType% Then
            FindObjDesc$ = ReadFromDash$((cmbObjType.List(i%)))
            Exit For
        End If
    Next i%
End Function

Sub Form_Load ()
    CR$ = Chr$(13) + Chr$(10)
    Zero$ = Chr$(0)
    TabC$ = Chr$(9)
    optDispType(0).Value = 1       'set to normal disp

    If Len(Command$) > 0 Then
        FileName$ = Command$
    Else
        FileName$ = "NWBind.Dat"
    End If
    LoadObjTypes FileName$

    ObjName$ = Space$(50)
    LastSeen& = -1
    Do  'scan all objects to get all object types
        Ret% = ScanBinderyObject("*", -1, LastSeen&, ObjName$, ObjType%, Properties%, Flag%, Security%)
        For i% = 0 To cmbObjType.ListCount - 1
            If Val("&H" + cmbObjType.List(i%)) = ObjType% Then Exit For
        Next i%
        If i% = cmbObjType.ListCount Then
            AddStr$ = Hex$(ObjType%)
            If Len(AddStr$) < 4 Then AddStr$ = String$(4 - Len(AddStr$), "0") + AddStr$
            AddStr$ = AddStr$ + " - Unknown Object Type"
            cmbObjType.AddItem AddStr$
        End If
    Loop While Ret% = 0
    picObjSec.Height = picObjSec.TextHeight("X") * 5
    picPropSec.Height = picPropSec.TextHeight("X") * 6
    Show
    cmbObjType.ListIndex = 0
    UserInfo

End Sub

Sub Form_Unload (Cancel As Integer)
    If MNU_OptionsSel(1).Checked Then
        WriteChanges% = MsgBox("Write object types to " + FileName$ + "?", 35, "Windows Bindery Browser")
        Select Case WriteChanges%
            Case 2
                Cancel = 1
                Exit Sub
            Case 6
                WriteEmOut FileName$
        End Select
    End If
End Sub

Function GetCString$ (ByVal Text$)
    ZeroPos = InStr(Text$, Zero$)
    If ZeroPos > 0 Then ZeroPos = ZeroPos - 1
    GetCString$ = Left$(Text$, ZeroPos)
End Function

Function GetSecurity$ (Sec%)
    Select Case Sec%
        Case 0
            T$ = "Anyone"
        Case 1
            T$ = "Logged"
        Case 2
            T$ = "Object"
        Case 3
            T$ = "Supervisor"
        Case 4
            T$ = "Netware"
        Case Else
            T$ = "Invalid -" + Hex$(Sec%)
    End Select
    GetSecurity$ = T$
End Function

Sub lbObject_Click ()

    lbProperty.Clear
    Prop$ = Space$(256)
    SearchProp$ = "*"
    SearchObjName$ = lbObject.List(lbObject.ListIndex)
    SearchObjType% = Val("&H" + (cmbObjType.Text))
    LastProp& = -1

    ObjName$ = Space$(50)
    Ret% = ScanBinderyObject(SearchObjName$, SearchObjType%, -1, ObjName$, ObjType%, ObjProp%, ObjFlag%, ObjSec%)
    If Ret% = 0 Then
        DispObjInfo ObjProp%, ObjFlag%, ObjSec%
        Do  'scan for all properties of this object
            Ret% = ScanProperty(SearchObjName$, SearchObjType%, SearchProp$, LastProp&, Prop$, PropFlag%, PropSec%, PropHasVal%, PropMore%)
            If Ret% = 0 Then lbProperty.AddItem GetCString$(Prop$)
        Loop While Ret% = 0
        If lbProperty.ListCount > 0 Then
            lbProperty.ListIndex = 0
        End If
    Else
        MsgBox "ScanBinderyObject returned: " + Hex$(Ret%), 16, "Windows Bindery Browser"
    End If
End Sub

Sub lbProperty_Click ()

    SearchProp$ = lbProperty.List(lbProperty.ListIndex)
    SearchObjName$ = lbObject.List(lbObject.ListIndex)
    SearchObjType% = Val("&H" + cmbObjType.Text)

    Prop$ = Space$(50)
    Ret% = ScanProperty(SearchObjName$, SearchObjType%, SearchProp$, -1, Prop$, PropFlag%, PropSec%, PropHasVal%, PropMore%)
    DispPropInfo PropFlag%, PropSec%, PropHasVal%, PropMore%
    If (PropFlag% And 2) = 2 Then
        If Not Val(txtPropertyValue.Tag) = 3 And MNU_OptionsSel(0).Checked = -1 Then
            optDispType(3).Value = -1
        End If
    Else
        If Not Val(txtPropertyValue.Tag) = 1 And MNU_OptionsSel(0).Checked = -1 Then
            optDispType(0).Value = -1
        End If
    End If
    ReadProperty PropV$, PropType%
    DispProp PropV$, PropType%
End Sub

Sub LoadObjTypes (FileName$)
    'load list of defined object types
    FileNum% = FreeFile
    Open FileName$ For Binary As FileNum%
    lDataFile# = Len(FileNum%)
    Close FileNum%
    If lDataFile# > 0 Then
        Open FileName$ For Input As FileNum%
        While Not EOF(FileNum%)
            Input #FileNum%, ObjType%, ObjTypeDesc$
            SObjType$ = Hex$(ObjType%)
            If Len(SObjType$) < 4 Then SObjType$ = String$(4 - Len(SObjType$), "0") + SObjType$

            LoadStr$ = SObjType$ + " - " + ObjTypeDesc$
            cmbObjType.AddItem LoadStr$
        Wend
        Close FileNum%
    Else
        Kill FileName$
    End If
End Sub

Sub MNU_FileAbout_Click ()
    CR$ = Chr$(13)
    AStr$ = "Scott Johnston" + CR$
    AStr$ = AStr$ + "Alta Enterprises" + CR$
'    AStr$ = AStr$ + "1-14-92 v1.3"
    AStr$ = AStr$ + "6-21-94 v1.5"
    MsgBox AStr$, 0, "Windows Bindery Browser"
End Sub

Sub MNU_FileExit_Click ()
    Unload WinBindBrow

End Sub

Sub MNU_FileSave_Click ()
    WriteEmOut "NWBIND.DAT"
End Sub

Sub MNU_OptionsSel_Click (Index As Integer)
    MNU_OptionsSel(Index).Checked = Not MNU_OptionsSel(Index).Checked

End Sub

Sub optDispType_Click (Index As Integer)
    txtPropertyValue.Tag = Str$(Index)
    ReadProperty PropV$, PropType%
    DispProp PropV$, PropType%

End Sub

Function ReadFromDash$ (Text$)
    ReadFromDash$ = Mid$(Text$, InStr(Text$, "-") + 1)
End Function

Sub ReadProperty (PropV$, PropType%)
    PropV$ = ""
    PropValue$ = Space$(128)
    SearchProp$ = lbProperty.List(lbProperty.ListIndex)
    SearchObjName$ = lbObject.List(lbObject.ListIndex)
    SearchObjType% = Val("&H" + cmbObjType.Text)
    Segment% = 1
    Do          'read all property value segments for this property
        Ret% = ReadPropertyValue(SearchObjName$, SearchObjType%, SearchProp$, Segment%, PropValue$, PropMore%, PropFlag%)
        Segment% = Segment% + 1
        If Ret% = 0 Then
            PropV$ = PropV$ + PropValue$
        End If
    Loop While Ret% = 0 And PropMore% <> 0
    PropType% = PropFlag% And &HF

End Sub

Sub UpdateList ()

    lbObject.Clear
    lbProperty.Clear
    txtPropertyValue.Text = ""
    SearchObjType% = Val("&h" + cmbObjType.Text)
    LastSeen& = -1
    ObjName$ = Space$(50)
    Do  'scan for all objects of this object type
        Ret% = ScanBinderyObject("*", SearchObjType%, LastSeen&, ObjName$, ObjType%, ObjProp%, ObjFlag%, ObjSec%)
        If Ret% = 0 Then
            AddString$ = GetCString$(ObjName$)
            lbObject.AddItem AddString$
        End If
    Loop While Ret% = 0
End Sub

Sub UpdateObjs (NewDesc$)
    NewObj% = Val("&H" + NewDesc$)
    ObjStr$ = Hex$(NewObj%)
    If Len(ObjStr$) < 4 Then ObjStr$ = String$(4 - Len(ObjStr$), "0") + ObjStr$
    ObjDesc$ = Mid$(NewDesc$, InStr(NewDesc$, "-") + 1)
    ObjDesc$ = RTrim$(LTrim$(ObjDesc$))
    cmbObjType.RemoveItem Val(cmbObjType.Tag)
    cmbObjType.AddItem ObjStr$ + " - " + ObjDesc$
    cmbObjType.Text = ObjStr$ + " - " + ObjDesc$
    cmbObjType.ListIndex = Val(cmbObjType.Tag)
End Sub

Sub UserInfo ()
    OurConn& = GetConnectionNumber()            'get our connection number
    OurName$ = Space$(50)
    OurLogin$ = Space$(7)
    'get our connection numbers information
    Ret% = GetConnectionInformation(OurConn&, OurName$, OurType%, OurObjID&, OurLogin$)

    OurName$ = GetCString$(OurName$)
    caption = "Windows Bindery Browser - User: " + OurName$
End Sub

Sub WriteEmOut (FileName$)
    FileNum = FreeFile
    Open FileName$ For Output As FileNum
    For i% = 0 To cmbObjType.ListCount - 1
        ObjType% = Val("&H" + cmbObjType.List(i%))
        ObjDesc$ = ReadFromDash$((cmbObjType.List(i%)))
        ObjDesc$ = LTrim$(ObjDesc$)
        Write #FileNum, ObjType%, ObjDesc$

    Next i%
    Close #FileNum
End Sub