home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / NWTP04 / XBINDRY / SCANBIND.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-29  |  15KB  |  371 lines
  1. {$B-,V-,X+}
  2. Program ScanBind; {as of 931229}
  3.  
  4. { Example for the nwBindry unit / NwTP 0.4 API. (c) 1994, R.Spronk }
  5.  
  6. Uses nwMisc,nwComm,nwBindry;
  7.  
  8. Type string30=string[30];
  9.      PobjRec=^objRec;
  10.      objRec=Record
  11.             objId:LongInt;
  12.             name:string30;
  13.             next:PobjRec;
  14.             end;
  15.  
  16. Var PstartObj:Pobjrec;
  17.  
  18. procedure WriteReadSecurity(sec:Byte);
  19. begin
  20. Case LoNibble(Sec) of
  21.    BS_ANY_READ       :write('Any (0)');
  22.    BS_LOGGED_READ    :write('Log (1)');
  23.    BS_OBJECT_READ    :write('Obj (2)');
  24.    BS_SUPER_READ     :write('Sup (3)');
  25.    BS_BINDERY_READ   :write('Netw(4)');
  26.    else writeln('Unknown. (Read Rights Flag=$',HexStr(LoNibble(Sec),2),')');
  27. end;{case}
  28. end;
  29.  
  30. Procedure WriteWriteSecurity(Sec:Byte);
  31. begin
  32. Case (HiNibble(Sec) SHL 4) of
  33.    BS_ANY_WRITE      :write('Any (0)');
  34.    BS_LOGGED_WRITE   :write('Log (1)');
  35.    BS_OBJECT_WRITE   :write('Obj (2)');
  36.    BS_SUPER_WRITE    :write('Sup (3)');
  37.    BS_BINDERY_WRITE  :write('Netw(4)');
  38.    else writeln('Unknown. (Write Rights Flag=$',HexStr(HiNibble(Sec) SHL 4,2),')');
  39. end; {case}
  40. end;
  41.  
  42. Procedure PutInLinkedList(objId:LongInt;objName:String;objType:Word);
  43. Var rp,np,lp:PobjRec;
  44.     lName:string;
  45. begin
  46. lName:=objname;
  47. if lName[0]>#20 then lName[0]:=#20; { shorten object name; }
  48. New(np);
  49. if objType=OT_USER
  50.  then lname:=lname+' (User)'
  51.  else if objType=OT_USER_GROUP
  52.       then lname:=lname+' (Group)';
  53. np^.name:=lname;
  54. np^.objId:=objId;
  55. np^.next:=NIL;
  56. If PstartObj=NIL
  57.  then PstartObj:=np
  58.  else begin
  59.       lp:=PstartObj;
  60.       while (lp^.next<>NIL) do lp:=lp^.next;
  61.       lp^.next:=np;
  62.       end;
  63. end;
  64.  
  65. Function getNameFromLL(id:Longint):String;
  66. Var rp:PobjRec;
  67. begin
  68. rp:=PstartObj;
  69. While ((rp<>NIL) and (rp^.objId<>id)) do rp:=rp^.next;
  70. if rp=NIL then getNameFromLL:='!error: ID not found in stored ID List.'
  71.           else getNameFromLL:=rp^.name;
  72. end;
  73.  
  74. Procedure ShowSet(pset:PropertyType);
  75. Var i:Byte;
  76.     objId:LongInt;
  77. begin
  78. { A segment of a set-property consists of a list of object IDs,
  79.   each ID 4 bytes long, stored hi-lo.
  80.   The end of the list (within THIS segment) is marked by an ID of 00000000. }
  81. i:=1;
  82. Repeat
  83.  objId:=MakeLong((pset[i] *256 +pset[i+1]), ( pset[i+2] *256 + pset[i+3] ) );
  84.  if objId<>0
  85.   then writeln('    *',GetNameFromLL(objId),'(',HexStr(objId,8),')');
  86.  inc(i,4);
  87. Until (i>128) or (objId=0);
  88. end;
  89.  
  90. Procedure DumpPropVal(DontSkipZeros:boolean;pv:propertyType);
  91. Var t,g,skip:Byte;
  92.     c:char;
  93.     s:string;
  94. begin
  95. if DontSkipZeros
  96.  then skip:=7
  97.  else begin
  98.       skip:=128;
  99.       while (pv[skip]=$00) and (skip>1) do dec(skip);
  100.       skip:=(skip-1) DIV 16;
  101.       end;
  102. t:=0;
  103. While t<=skip
  104. do begin
  105.    s:='';
  106.    write('    *');
  107.    for g:=1 to 16
  108.    do begin
  109.       write(HexStr(pv[t*16+g],2),' ');
  110.       c:=chr(pv[t*16+g]);
  111.       if c>=' ' then s:=s+c else s:=s+' ';
  112.       end;
  113.    writeln(s);
  114.    inc(t);
  115.    end;
  116. end;
  117.  
  118.  
  119. Var lastObjSeen:LongInt;
  120.     objName:String;
  121.     objType:Word;
  122.     objId:LongInt;
  123.     objFlag:Byte;
  124.     objSec:Byte;
  125.     objHasProp:Boolean;
  126.  
  127.     SecAccessLevel:Byte;
  128.     MyObjId:LongInt;
  129.  
  130.     SeqNumber:LongInt;
  131.     propName:String;
  132.     propFlags,propSecurity:Byte;
  133.     propHasValue,moreProperties:Boolean;
  134.  
  135.     SegNbr:Byte;
  136.     propValue:propertyType; { array[1..128] of byte }
  137.     moreSeg:boolean;
  138.  
  139.     tempString:String;
  140.  
  141. begin
  142. Writeln('ScanBind V1.2');
  143. Writeln('Provides information about all accessible bindery objects.');
  144.  
  145. If NOT (IpxInitialize and IsShellLoaded)
  146.  then begin
  147.       writeln('Error: Scanbind requires:');
  148.       writeln('       -IPX to be loaded;');
  149.       writeln('       -The Netware Shell to be loaded.');
  150.       halt(1);
  151.       end;
  152.  
  153. GetBinderyAccessLevel(SecAccessLevel,MyObjId);
  154. write('All objects with a read security level <= ');
  155. WriteReadSecurity(SecAccessLevel); writeln(' will be shown.');
  156. writeln;
  157.  
  158. { put all objects in a table}
  159. lastObjSeen:=-1;
  160. PstartObj:=NIL;
  161.  
  162. While ScanBinderyObject('*',OT_WILD,lastObjSeen,
  163.                         objName,objType,objID,objFlag,objSec,objHasProp)
  164.   do PutInLinkedList(objId,objName,objType);
  165.  
  166. if nwBindry.Result<>$FC { no such object }
  167.  then writeln('Error Scanning Objects: $',HexStr(nwBindry.Result,2));
  168.  
  169.  
  170. { show all objects and asociated properties/values:}
  171. lastObjSeen:=-1;
  172.  
  173. While ScanBinderyObject('*',OT_WILD,lastObjSeen,
  174.                         objName,objType,objID,objFlag,objSec,objHasProp)
  175. do begin
  176.    writeln(HexStr(objId,8),' ',objName);
  177.  
  178.    write('The object type is :');
  179.    Case objType of
  180.       OT_UNKNOWN                     :writeln('Unknown Object Type ');
  181.       OT_USER                        :writeln('User ');
  182.       OT_USER_GROUP                  :writeln('User group ');
  183.       OT_PRINT_QUEUE                 :writeln('Print Queue ');
  184.       OT_FILE_SERVER                 :writeln('Fileserver ');
  185.       OT_JOB_SERVER                  :writeln('Jobserver ');
  186.       OT_GATEWAY                     :writeln('Gateway ');
  187.       OT_PRINT_SERVER                :writeln('Printserver ');
  188.       OT_ARCHIVE_QUEUE               :writeln('Archive Queue ');
  189.       OT_ARCHIVE_SERVER              :writeln('Archive Server ');
  190.       OT_JOB_QUEUE                   :writeln('Job Queue ');
  191.       OT_ADMINISTRATION              :writeln('Administration Object');
  192.       OT_NAS_SNA_GATEWAY             :writeln('NAS SNA Gateway ');
  193.       OT_REMOTE_BRIDGE_SERVER        :writeln('Remote Bridge Server ');
  194.       OT_ASYNC_BRIDGE_SERVER         :writeln('Asynchrone Comm. Bridge Server ');
  195.       OT_TCPIP_GATEWAY               :writeln('TCP/IP Gateway ');
  196.       OT_X25_BRIDGE                  :writeln('X.25 Bridge ');
  197.       OT_X25_GATEWAY                 :writeln('X.25 Gateway ');
  198.       OT_TIME_SYNCHRONIZATION_SERVER :writeln('Time Synchronization Server ');
  199.       OT_ARCHIVE_SERVER_DYNAMIC_SAP  :writeln('Archive Server (Dynamic SAP) ');
  200.       OT_DI3270_GATEWAY              :writeln('DI3270 Gateway ');
  201.       OT_ADVERTISING_PRINTSERVER     :writeln('Printserver ');
  202.       OT_BTRIEVE_VAP                 :writeln('Btrieve VAP ');
  203.       OT_BTRIEVE_5_SERVER            :writeln('Btrieve 5.x server ');
  204.       OT_PRINT_QUEUE_USER            :writeln('Print Queue User ');
  205.       OT_X25_BRIDGE                  :writeln('X.25 Bridge ');
  206.       OT_DI3270_GATEWAY              :writeln('DI 3270 Gateway ');
  207.       OT_NETWARE_SQL_SERVER          :writeln('NW SQL Server ');
  208.       OT_XTREE_NETWORK               :writeln('XTree Network ');
  209.       OT_WANCOPY_UTILITY             :writeln('Wancopy Utility ');
  210.       OT_TES_NETWARE_FOR_VMS         :writeln('TES NW for VMS ');
  211.       OT_NETWARE_ACCESS_SERVER       :writeln('NW Access Server ');
  212.       OT_PORTABLE_NETWARE            :writeln('Portable Netware ');
  213.       OT_BINDERY                     :writeln('Bindery ');
  214.       OT_ORACLE_DATABASE_SERVER      :writeln('Oracle Dtabase Server ');
  215.       OT_COMMUNICATIONS_EXEC         :writeln('Communications Exec ');
  216.       OT_NNS_DOMAIN                  :writeln('NNS Domain ');
  217.       OT_NW386_PRINT_QUEUE           :writeln('NW 386 Print Queue ');
  218.       OT_LANSPOOL_SERVER             :writeln('LanSpool Server ');
  219.       OT_BTRIEVE_4_SERVER            :writeln('Btrieve 4.x Server ');
  220.       OT_EICON_ROUTER                :writeln('EICON Router ');
  221.       OT_ARCSERVE_30                 :writeln('ArcServe 3.0 ');
  222.       OT_EMERALD_BACKUP              :writeln('Emerald Backup ');
  223.       OT_POWERCHUTE                  :writeln('Powerchute ');
  224.       OT_COMPAQ_IDA_STATUS_MONITOR   :writeln('Compaq IDA status Monitor ');
  225.       OT_RSPCX_SERVER                :writeln('RSPCX Server (Rconsole) ');
  226.       OT_CSA_MUX                     :writeln('CSA MUX ');
  227.       OT_CSA_LSA                     :writeln('CSA LSA ');
  228.       OT_CSA_CM                      :writeln('CSA CM ');
  229.       OT_CSA_SMA                     :writeln('CSA SMA ');
  230.       OT_CSA_DBA                     :writeln('CSA DBA ');
  231.       OT_CSA_NMA                     :writeln('CSA NMA ');
  232.       OT_CSA_SSA                     :writeln('CSA SSA ');
  233.       OT_CSA_STATUS                  :writeln('CSA Status ');
  234.       OT_CSA_APPC                    :writeln('CSA Appc ');
  235.       OT_CSA_TEST                    :writeln('CSA Test ');
  236.       OT_CSA_TRACE                   :writeln('CSA Trace ');
  237.       OT_NNS_DOMAIN                  :writeln('NNS Domain ');
  238.       OT_NNS_PROFILE                 :writeln('NNS Profile ');
  239.       OT_NW386_PRINT_QUEUE           :writeln('NW386 Print Queue ');
  240.       OT_COMPAQ_SNMP_AGENT           :writeln('Compaq SNMP Agent ');
  241.       OT_HP_LASERJET                 :writeln('HP Laserjet ');
  242.       OT_PC3M                        :writeln('PC3M (? tapebackup) ');
  243.       OT_ARCSERVE_40                 :writeln('ArcServe 4.0 ');
  244.       OT_NETWARE_SQL                 :writeln('Netware SQL ');
  245.       OT_SITE_LOCK_VRS_FILES         :writeln('SiteLock -Vrs_files ');
  246.       OT_SITE_LOCK_CHECKS            :writeln('SiteLock -checks ');
  247.       OT_SITE_LOCK                   :writeln('SiteLock ');
  248.       OT_SITE_LOCK_APPLICATIONS      :writeln('SiteLock -applications ');
  249.       OT_SITE_LOCK_2                 :writeln('SiteLock ');
  250.       OT_SITE_LOCK_SERVER            :writeln('SiteLock Server ');
  251.       OT_SITE_LOCK_USER              :writeln('SiteLock User ');
  252.       OT_RABBIT_GATEWAY              :writeln('Rabbit Gateway ');
  253.       OT_PEGASUS_MAIL                :writeln('Pegasus Mail ');
  254.       OT_TAPEWARE_AGENT              :writeln('TapeWare File System Agent ');
  255.       OT_TAPEWARE                    :writeln('TapeWare NLM ');
  256.       OT_QNT_ACCESS_WS               :writeln('QNT Access ');
  257.       $8002                          :writeln('Intel Lanport / Netport ');
  258.  
  259.       else writeln('objType=',objType,' (unknown)');
  260.    end; {case}
  261.  
  262.    Case objFlag of
  263.     0:writeln('The object is a static object.');
  264.     1:writeln('The object is a dynamic object.');
  265.     else writeln('Unknown objectFlag:',objFlag);
  266.    end; {case}
  267.  
  268.    write('Security: Read: ');WriteReadSecurity(objSec);
  269.    write(' / Write: ');WriteWriteSecurity(objSec); writeln;
  270.  
  271.    if objHasProp
  272.     then begin
  273.          SeqNumber:=-1;
  274.          writeln('The object has the following properties:');
  275.  
  276.          While ScanProperty({in}  objName,objType,'*',
  277.                             {i/o} SeqNumber,
  278.                             {out} propName,propFlags,propSecurity,
  279.                                   propHasValue,moreProperties)
  280.          do begin
  281.             write('  ',propName);
  282.  
  283.             if HiNibble(propFlags)=0
  284.              then write ('  (Static')   { 0 }
  285.              else write ('  (Dynamic');  { 1 }
  286.  
  287.             Case LoNibble(propFlags) of
  288.              BF_ITEM:writeln(' Item-Property)');
  289.              BF_SET :writeln(' Set-Property)');
  290.              else writeln(' property), Property type=  ',LoNibble(propFlags),' (Unknown, not Item or Set)');
  291.             end; {case}
  292.  
  293.             write('    Security: Read: ');WriteReadSecurity(propSecurity);
  294.             write(' /Write: ');WriteWriteSecurity(propSecurity); writeln;
  295.  
  296.           { show value of properties: }
  297.             if propHasValue
  298.              then begin
  299.                   if LoNibble(propFlags)=BF_SET
  300.                    then begin
  301.                         SegNbr:=1;
  302.  
  303.                         While ReadPropertyValue(objName,objType,propName,SegNbr,
  304.                                                 propValue,moreSeg,propFlags)
  305.                          do begin
  306.                             ShowSet(propValue);
  307.                             inc(SegNbr);
  308.                             end;
  309.                         If nwBindry.Result<>$EC { no such segment }
  310.                          then writeln('Error Reading Property Values: $',
  311.                                        HexStr(nwBindry.Result,2));
  312.                         end
  313.                    else begin { item property }
  314.                         if propName='IDENTIFICATION'
  315.                          then begin
  316.                               getRealUserName(objName,tempString);
  317.                               writeln('    *',tempString)
  318.                               end
  319.                         else if propname='Q_DIRECTORY'
  320.                          then begin
  321.                               { asciiz string in 1st seg }
  322.                               SegNbr:=1;
  323.                               IF ReadPropertyValue(objName,objType,propName,SegNbr,
  324.                                                    propValue,moreSeg,propFlags)
  325.                               then begin
  326.                                    ZStrCopy(tempString,propValue,127);
  327.                                    writeln('    *',tempString);
  328.                                    end
  329.                               end
  330.                         else if propname='ACCOUNT_BALANCE'
  331.                          then begin
  332.                               { conversion of 1st 4 bytes to longint }
  333.                               SegNbr:=1;
  334.                               IF ReadPropertyValue(objName,objType,propName,SegNbr,
  335.                                                    propValue,moreSeg,propFlags)
  336.                               then writeln('    *',makeLong((propvalue[1] *256 +propvalue[2]),
  337.                                                             (propvalue[3] *256 +propvalue[4] )))
  338.                               end
  339.                          else begin { structure not known, dump it }
  340.                               SegNbr:=1;
  341.                               While ReadPropertyValue(objName,objType,propName,SegNbr,
  342.                                                       propValue,moreSeg,propFlags)
  343.                                do begin
  344.                                   inc(segNbr);
  345.                                   DumpPropVal(moreSeg,propValue);
  346.                                   end;
  347.  
  348.                               If nwBindry.Result<>$EC { no such segment }
  349.                                 then writeln('Error Reading Property Values: $',
  350.                                              HexStr(nwBindry.Result,2));
  351.                               end
  352.  
  353.                         end;
  354.                   end {if propHasValue then }
  355.              else begin { prop has NO value }
  356.                   writeln('    *<property has no value>');
  357.                   end;
  358.             end; { While scanProperty do }
  359.  
  360.          If nwBindry.Result<>$FB { no such property }
  361.           then writeln('Error Scanning Properties: $',HexStr(nwBindry.Result,2));
  362.          end { if objHasProp then }
  363.     else begin { object has NO properties }
  364.          writeln('  <object has no properties>');
  365.          end;
  366.  
  367.    writeln;
  368.    end;  { While scanObject }
  369. if nwBindry.Result<>$FC { no such object }
  370.  then writeln('Error Scanning Objects: $',HexStr(nwBindry.Result,2));
  371. end.