home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 5
/
ctrom5b.zip
/
ctrom5b
/
PROGRAM
/
PASCAL
/
NWTP06
/
SCANBIND.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-03-01
|
13KB
|
382 lines
{$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.