Comment
==========================================================

Copyright 1992-96 by Marc Perkel * All right reserved.

This utility will dump the contents of the NetWare bindery to a
file or printer.

USAGE: BINDDUMP <file>

Example:
  BINDDUMP BIND.TXT   ;output to file
  BINDDUMP PRN        ;to print bindary

=========================================================
EndComment

;#Define Shareware

Var
  Objects
  Obj
  Prop
  Ty
  Values
  ObjStatic
  PropType
  PropStatic
  TypeName
  TypeNumber
  ObjFilter
  ObjNameFilter

Qualifier
  ObjName
  ObjType


OutFile = ParamStr(2)
ObjNameFilter = UpperCase(ParamStr(3))
if ObjNameFilter > ''
   ObjFilter = Value(ObjNameFilter)
   if ObjFilter = 0 then ObjFilter = -1
else
   ObjFilter = 0
endif

#If Shareware

   Beg

#Endif

StandardIO

if OutFile = ''
   Writeln
   Writeln 'Computer Tyme BindDump * Copyright 1992-96 by Marc Perkel'
   Writeln 'All Rights Reserved * Version 1.2 * Release Date: 01-02-96'

   Include 'ADDRESS.INC'

   Writeln 'This utility will dump the contents of the NetWare bindery to a'
   Writeln 'file or printer.'
   Writeln
   Writeln 'USAGE: BINDDUMP <file> <object type>
   Writeln 'If no object type is specified, all objects are read.'
   Writeln
   Writeln 'Example:'
   Writeln '  BINDDUMP BIND.TXT      ;output to file
   Writeln '  BINDDUMP PRN           ;to print bindary
   Writeln '  BINDDUMP USERS.TXT 1   ;Dumps just Users'
   Writeln
   Writeln 'Price $95 per Server.'
   Writeln 'Written in MarxMenu. Comes free with the Network Survival Kit.'
   exitmenu
endif

NovObjects (Objects)

SetTypeNames

Main

;=============================================

;----- Subroutines

Procedure Main
var St ObjSecurity PropSecurity
   Loop Objects
      Obj = LoopVal.ObjName
      Ty = LoopVal.ObjType
      if (ObjFilter = 0) or (ObjFilter = Ty) or (Obj = ObjNameFilter)
         WriteError 'Processing ' Obj ' ' ObjType(Ty) ' ... '
         ObjSecurity = NovObjectSecurity (Obj,Ty)
         if NovStaticObject (Obj,Ty)
            ObjStatic = 'Static      '
         else
            ObjStatic = 'Dynamic     '
         endif
         Write PadRight(Obj,31) 'Type: ' PadRight(ObjType(Ty),10)
         Write ' Write: ' ObjSecurity / 16 '  Read: ' ObjSecurity and 15
         Writeln '  ' ObjStatic
         Writeln
         NovScanProperties (Prop,Obj,Ty)
         Loop Prop
            PropSecurity = NovPropertySecurity (Obj,LoopVal,Ty)
            if NovSetProperty (Obj,LoopVal,Ty)
               PropType = 'SET       '
            else
               PropType = 'ITEM      '
            endif
            if NovStaticProperty (Obj,LoopVal,Ty)
               PropStatic = 'Static      '
            else
               PropStatic = 'Dynamic     '
            endif
            Write PadRight('   ' + LoopVal,31) 'Type: ' PropType
            Write ' Write: ' PropSecurity / 16 '  Read: ' PropSecurity and 15
            Writeln '  ' PropStatic
            Writeln
            if NovSetProperty (Obj,LoopVal,Ty)
               NovPropertyValues(Values,Obj,LoopVal,Ty)
               Loop Values
                  Writeln '      ' LoopVal
               EndLoop
            else
               NovPropertyValues(Values,Obj,LoopVal,Ty)
               Loop Values
                  DumpString(LoopVal)
                  if LoopIndex < NumberOfElements(Values) then Writeln
               EndLoop
            endif
            Writeln
         EndLoop
         Writeln
         WritelnError
      endif
   EndLoop
EndProc


;----- Known Object Types

Procedure SetTypeNames
   AppendArray(TypeName,'user')
   AppendArray(TypeName,'group')
   AppendArray(TypeName,'queue')
   AppendArray(TypeName,'server')
   AppendArray(TypeName,'job serv')
   AppendArray(TypeName,'gateway')
   AppendArray(TypeName,'prn serv')

   AppendArray(TypeNumber,'1')
   AppendArray(TypeNumber,'2')
   AppendArray(TypeNumber,'3')
   AppendArray(TypeNumber,'4')
   AppendArray(TypeNumber,'5')
   AppendArray(TypeNumber,'6')
   AppendArray(TypeNumber,'7')
EndProc


Procedure ObjType (Ty)
var P St
   Ty = Str(Ty)
   P = PosInList(Ty,TypeNumber)
   if P > 0
      St = TypeName[P] + ' ' + Ty
   else
      St = Ty
   endif
   Return '(' + St + ')'
EndProc


Procedure DumpString (St)
var X St2 Ch
   Loop 8
      Write '      '
      St2 = ''
      Loop 16
         X = X + 1
         Ch = Mid(St,X,1)
         Write HexString(ord(Ch),2) ' '
         if (Ch >= ' ') and (Ch <= '~')
            St2 = St2 + Ch
         else
            St2 = St2 + '.'
         endif
      endloop
      Writeln '   ' St2
   endloop
EndProc


#If Shareware

Procedure Beg
   BoxBorderColor Green Blue
   BoxInsideColor White Blue
   BoxHeaderColor Yellow Mag
   InverseColor Yellow Mag
   BoxHeader ' * Shameless Beg Screen * '
   DrawBox 10 8 61 6
   Writeln
   WriteCenter '* BindDump Evaluation Copy *'
   Writeln
   WriteCenter 'Please remember to register this software.'
   Wait 600
   EraseTopWindow
   ClearKbdBuffer
EndProc

#Endif