382 lines
13 KiB
Plaintext
382 lines
13 KiB
Plaintext
{$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.
|