{$X+,B-,V-,S-,I-} {essential compiler directives}

Program ScanBind;

{ Example for the nwBindry unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }

{ Purpose: Dumps the entire contents of the bindery. }

{ Tests the following nwBindry calls:

  IsShellLoaded
  GetBinderyAccessLevel
  ScanBinderyObject
  ScanProperty
  ReadPropertyValue
  GetRealUserName
}

Uses nwMisc,nwBindry;

Type string30=string[30];
     PobjRec =^objRec;
     objRec  =Record
              objId:LongInt;
              name:string30;
              next:PobjRec;
              end;

Var PstartObj:Pobjrec;
    GlobalPath:string;
    f:text;

procedure WriteReadSecurity(sec:Byte);
begin
Case LoNibble(Sec) of
   BS_ANY_READ       :write('Any (0)');
   BS_LOGGED_READ    :write('Log (1)');
   BS_OBJECT_READ    :write('Obj (2)');
   BS_SUPER_READ     :write('Sup (3)');
   BS_BINDERY_READ   :write('Netw(4)');
   else writeln('Unknown. (Read Rights Flag=$',HexStr(LoNibble(Sec),2),')');
end;{case}
end;

Procedure WriteWriteSecurity(Sec:Byte);
begin
Case (HiNibble(Sec) SHL 4) of
   BS_ANY_WRITE      :write('Any (0)');
   BS_LOGGED_WRITE   :write('Log (1)');
   BS_OBJECT_WRITE   :write('Obj (2)');
   BS_SUPER_WRITE    :write('Sup (3)');
   BS_BINDERY_WRITE  :write('Netw(4)');
   else writeln('Unknown. (Write Rights Flag=$',HexStr(HiNibble(Sec) SHL 4,2),')');
end; {case}
end;

Procedure PutInLinkedList(objId:LongInt;objName:String;objType:Word);
Var rp,np,lp:PobjRec;
    lName   :string;
begin
lName:=objname;
if lName[0]>#20
 then lName[0]:=#20; { shorten object name; }
New(np);
if objType=OT_USER
 then lname:=lname+' (User)'
 else if objType=OT_USER_GROUP
       then lname:=lname+' (Group)';
np^.name:=lname;
np^.objId:=objId;
np^.next:=NIL;
If PstartObj=NIL
 then PstartObj:=np
 else begin
      lp:=PstartObj;
      while (lp^.next<>NIL) do lp:=lp^.next;
      lp^.next:=np;
      end;
end;

Function getNameFromLL(id:Longint):String;
Var rp:PobjRec;
begin
rp:=PstartObj;
While ((rp<>NIL) and (rp^.objId<>id)) do rp:=rp^.next;
if rp=NIL then getNameFromLL:='!error: ID not found in stored ID List.'
          else getNameFromLL:=rp^.name;
end;

Procedure ShowSet(pset:Tproperty);
Var i    :Byte;
    objId:LongInt;
begin
{ A segment of a set-property consists of a list of object IDs,
  each ID 4 bytes long, stored hi-lo.
  The end of the list (within THIS segment) is marked by an ID of 00000000. }
i:=1;
Repeat
 objId:=MakeLong((pset[i] *256 +pset[i+1]), ( pset[i+2] *256 + pset[i+3] ) );
 if objId<>0
  then writeln('    *',GetNameFromLL(objId),'(',HexStr(objId,8),')');
 inc(i,4);
Until (i>128) or (objId=0);
end;

Procedure DumpPropVal(DontSkipZeros:boolean;pv:Tproperty);
Var t,g,skip:Byte;
    c       :char;
    s       :string;
begin
if DontSkipZeros
 then skip:=7
 else begin
      skip:=128;
      while (pv[skip]=$00) and (skip>1) do dec(skip);
      skip:=(skip-1) DIV 16;
      end;
t:=0;
While t<=skip
do begin
   s:='';
   write('    *');
   for g:=1 to 16
   do begin
      write(HexStr(pv[t*16+g],2),' ');
      c:=chr(pv[t*16+g]);
      if c>=' ' then s:=s+c else s:=s+' ';
      end;
   writeln(s);
   inc(t);
   end;
end;


Var lastObjSeen:LongInt;
    objName    :String;
    objType    :Word;
    objId      :LongInt;
    objFlag    :Byte;
    objSec     :Byte;
    objHasProp :Boolean;

    SecAccessLevel:Byte;
    MyObjId       :LongInt;

    SeqNumber     :LongInt;
    propName      :String;
    propFlags,
    propSecurity  :Byte;
    propHasValue,
    moreProperties:Boolean;

    SegNbr   :Byte;
    propValue:Tproperty; { array[1..128] of byte }
    accVal: record
            balance :LongInt; {hi-lo}
            limit   :LongInt;   {hi-lo}
            Reserved:array[1..120] of byte; { NW internal info }
            end ABSOLUTE PropValue;
    holdVal: array[1..16]
              of record
                 AccountServerID:Longint; {hi-lo}
                 HoldAmount     :LongInt; {hi-lo}
                 end ABSOLUTE PropValue;
    holds  :Longint;
    moreSeg:boolean;

    t         :word;
    tempString:String;

    OTfileFound:Boolean;
    ObjTypeStr,s:string;

begin
Writeln('ScanBind V1.2');
Writeln('Provides information about all accessible bindery objects.');

GlobalPath:=ParamStr(0);
while NOT (GlobalPath[ord(GlobalPath[0])] IN [':','\','/'])
 do dec(GlobalPath[0]);

assign(f,GlobalPath+'OT_XXX.');
reset(f);
OTfileFound:=(IOresult=0);
IF NOT OTfileFound
 then begin
      writeln('WARNING: OT_XXX. file with object types not found.');
      writeln('         A limited number of object type descriptions will be shown.');
      writeln;
      end;

If NOT ({IpxInitialize and} IsShellLoaded)
 then begin
      writeln('Error: Scanbind requires:');
      writeln('       -IPX to be loaded;');
      writeln('       -The Netware Shell to be loaded.');
      halt(1);
      end;
GetBinderyAccessLevel(SecAccessLevel,MyObjId);
write('All objects with a read security level <= ');
WriteReadSecurity(SecAccessLevel); writeln(' will be shown.');
writeln;

{ put all objects in a table}
lastObjSeen:=-1;
PstartObj:=NIL;

While ScanBinderyObject('*',OT_WILD,lastObjSeen,
                        objName,objType,objID,objFlag,objSec,objHasProp)
  do PutInLinkedList(objId,objName,objType);

if nwBindry.Result<>$FC { no such object }
 then writeln('Error Scanning Objects: $',HexStr(nwBindry.Result,2));


{ show all objects and asociated properties/values:}
lastObjSeen:=-1;

While ScanBinderyObject('*',OT_WILD,lastObjSeen,
                        objName,objType,objID,objFlag,objSec,objHasProp)
do begin
   writeln(HexStr(objId,8),' ',objName);

   write('The object type is :');
   Case objType of
      OT_UNKNOWN                     :writeln('Unknown Object Type ');
      OT_USER                        :writeln('User ');
      OT_USER_GROUP                  :writeln('User group ');
      OT_PRINT_QUEUE                 :writeln('Print Queue ');
      OT_FILE_SERVER                 :writeln('Fileserver ');
      OT_JOB_SERVER                  :writeln('Jobserver ');
      OT_GATEWAY                     :writeln('Gateway ');
      OT_PRINT_SERVER                :writeln('Printserver ');
      OT_ARCHIVE_QUEUE               :writeln('Archive Queue ');
      OT_ARCHIVE_SERVER              :writeln('Archive Server ');
      OT_JOB_QUEUE                   :writeln('Job Queue ');
      OT_ADMINISTRATION              :writeln('Administration Object');
      OT_RSPCX_SERVER                :writeln('RSPCX Server (Rconsole) ');
      else begin
           if OTfileFound
            then begin
                 reset(f);
                 ObjTypeStr:=HexStr(objType,4);
                 REPEAT
                 readln(f,s);
                 UNTIL eof(f) or (pos(ObjTypeStr,s)=1);
                 if pos(ObjTypeStr,s)=1
                  then begin
                       delete(s,1,5);
                       writeln(s);
                       end;
                 end
            else writeln('objType= 0x',HexStr(objType,4),' (unknown)');
           end;
   end; {case}

   Case objFlag of
    0:writeln('The object is a static object.');
    1:writeln('The object is a dynamic object.');
    else writeln('Unknown objectFlag:',objFlag);
   end; {case}

   write('Security: Read: ');WriteReadSecurity(objSec);
   write(' / Write: ');WriteWriteSecurity(objSec); writeln;

   if objHasProp
    then begin
         SeqNumber:=-1;
         writeln('The object has the following properties:');

         While ScanProperty({in}  objName,objType,'*',
                            {i/o} SeqNumber,
                            {out} propName,propFlags,propSecurity,
                                  propHasValue,moreProperties)
         do begin
            write('  ',propName);

            if HiNibble(propFlags)=0
             then write ('  (Static')   { 0 }
             else write ('  (Dynamic');  { 1 }

            Case LoNibble(propFlags) of
             BF_ITEM:writeln(' Item-Property)');
             BF_SET :writeln(' Set-Property)');
             else writeln(' property), Property type=  ',LoNibble(propFlags),' (Unknown, not Item or Set)');
            end; {case}

            write('    Security: Read: ');WriteReadSecurity(propSecurity);
            write(' /Write: ');WriteWriteSecurity(propSecurity); writeln;

          { show value of properties: }
            if propHasValue
             then begin
                  if LoNibble(propFlags)=BF_SET
                   then begin
                        SegNbr:=1;

                        While ReadPropertyValue(objName,objType,propName,SegNbr,
                                                propValue,moreSeg,propFlags)
                         do begin
                            ShowSet(propValue);
                            inc(SegNbr);
                            end;
                        If nwBindry.Result<>$EC { no such segment }
                         then writeln('Error Reading Property Values: $',
                                       HexStr(nwBindry.Result,2));
                        end
                   else begin { item property }
                        if propName='IDENTIFICATION'
                         then begin
                              getRealUserName(objName,tempString);
                              writeln('    *',tempString)
                              end
                        else if propname='Q_DIRECTORY'
                         then begin
                              { asciiz string in 1st seg }
                              SegNbr:=1;
                              IF ReadPropertyValue(objName,objType,propName,SegNbr,
                                                   propValue,moreSeg,propFlags)
                              then begin
                                   ZStrCopy(tempString,propValue,127);
                                   writeln('    *',tempString);
                                   end
                              end
                        else if propname='ACCOUNT_BALANCE'
                         then begin
                              { conversion of 1st 4 bytes to longint }
                              SegNbr:=1;
                              IF ReadPropertyValue(objName,objType,propName,SegNbr,
                                                   propValue,moreSeg,propFlags)
                               then writeln('    * Balance:',Lswap(accVal.balance),' Limit: ',Lswap(accVal.Limit));
                              end
                        else if propname='ACCOUNT_HOLDS'
                         then begin
                              SegNbr:=1;
                              IF ReadPropertyValue(objName,objType,propName,SegNbr,
                                                   propValue,moreSeg,propFlags)
                              then begin
                                   holds:=0;
                                   for t:=1 to 16
                                    do if holdVal[t].AccountServerID<>0
                                       then holds:=holds+Lswap(holdVal[t].HoldAmount);
                                   writeln('    * Total holds:',holds)
                                   end;
                              end
                         else begin { structure not known, dump it }
                              SegNbr:=1;
                              While ReadPropertyValue(objName,objType,propName,SegNbr,
                                                      propValue,moreSeg,propFlags)
                               do begin
                                  inc(segNbr);
                                  DumpPropVal(moreSeg,propValue);
                                  end;

                              If nwBindry.Result<>$EC { no such segment }
                                then writeln('Error Reading Property Values: $',
                                             HexStr(nwBindry.Result,2));
                              end

                        end;
                  end {if propHasValue then }
             else begin { prop has NO value }
                  writeln('    *<property has no value>');
                  end;
            end; { While scanProperty do }

         If nwBindry.Result<>$FB { no such property }
          then writeln('Error Scanning Properties: $',HexStr(nwBindry.Result,2));
         end { if objHasProp then }
    else begin { object has NO properties }
         writeln('  <object has no properties>');
         end;

   writeln;
   end;  { While scanObject }
if nwBindry.Result<>$FC { no such object }
 then writeln('Error Scanning Objects: $',HexStr(nwBindry.Result,2));

IF OTfileFound
 then close(f);
end.