home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / NWTP04 / XBINDRY / TSTBIND.PAS < prev   
Pascal/Delphi Source File  |  1993-12-29  |  7KB  |  195 lines
  1. {$X+,B-,V-}
  2. Program TSTBin;
  3.  
  4. { Testprogram for the nwBindry unit / NwTP 0.4 API. (c) 1994, R.Spronk }
  5.  
  6. Uses nwMisc,nwBindry;
  7.  
  8. Procedure Warning(mess:string);
  9. begin
  10. writeln(' ERROR:',mess);
  11. writeln(' ERROR#: $',hexstr(result,2),'  (',result,')');
  12. end;
  13.  
  14.  
  15. Function ExistsProperty(objName:string;objType:word;propertyName:String):boolean;
  16.  
  17. Var propName:string;
  18.     pf,ps   :byte;
  19.     phv,mp  :boolean;
  20.     seqNbr  :LongInt;
  21. begin
  22. seqNbr:=-1;
  23. ExistsProperty:=ScanProperty(objName,objType,propertyname,
  24.                              seqNbr,propName,pf,ps,phv,mp);
  25. end;
  26.  
  27.  
  28. Var myObjId:longInt;
  29.     BindSeq:Byte;
  30.  
  31.     ObjId    :longint;
  32.     usrName,TrueName:string;
  33.     pTrueName:propertyType;
  34.  
  35.     replyUsrName:string;
  36.     replyObjType:word;
  37.  
  38.     t:byte;
  39.     s:string;
  40.  
  41. begin
  42. writeln('BINTEST Test program for the nwBindry unit of the NwTP package.');
  43. writeln('-Assumes there is a group ''EVERYONE''');
  44. writeln('-Non destructive to the bindery. ');
  45. writeln(' (unless you already have a user named ''USR_OINK'')');
  46. writeln;
  47. writeln('type SET ALLOW UNENCRYPTED PASSWORDS=ON at the console--');
  48. writeln('currently tests unencrypted calls only!');
  49. { need supervisor privileges to run this test }
  50. GetBinderyAccessLevel(BindSeq,myObjId);
  51. if bindSeq<>(BS_SUPER_WRITE OR BS_SUPER_READ) { $33}
  52.  then begin
  53.       writeln('you need to be supervisor equivalent to run this test program.');
  54.       halt(1);
  55.       end;
  56.  
  57. { you are reminded that the bindery functions turn all object names, property
  58.   names and passwords to upcase. Returned strings are also upcase. }
  59.  
  60. usrName:='UsR_OiNk';
  61. TrueName:='Miss Piggy';
  62.  
  63. writeln('Creating Bindery object :',usrName);
  64. IF NOT CreateBinderyObject(usrName,OT_USER,
  65.                            BF_ITEM,BS_ANY_READ OR BS_ANY_WRITE)
  66.  then Warning('couldn''t create a bindery object.');
  67.  
  68. IF NOT GetBinderyObjectID(usrName,OT_USER,objID)
  69.  then Warning('couldn''t find the created user object');
  70.  
  71. writeln('Changing object security.');
  72. IF NOT ChangeBinderyObjectSecurity(usrName,OT_USER,BS_LOGGED_READ OR BS_SUPER_WRITE)
  73.  then warning('Couldn''t change object security.');
  74.  
  75. { this program assumes there is a group called everyone. }
  76. writeln('Making ',usrName,' a member of the group EVERYONE.');
  77. IF IsBinderyObjectInSet(usrName,OT_USER,
  78.                         'GROUP_MEMBERS','EVERYONE',OT_USER_GROUP)
  79.  then writeln('??: object already is a member of everyone (group)');
  80.  
  81. IF NOT AddBinderyObjectToSet('EVERYONE',OT_USER_GROUP,'GROUP_MEMBERS',
  82.                               usrName,OT_USER)
  83.  then Warning('couldn''t make user a member of everyone');
  84.  
  85. IF NOT IsBinderyObjectInSet('EVERYONE',OT_USER_GROUP,'GROUP_MEMBERS',
  86.                         usrName,OT_USER)
  87.  then writeln('??: user is NOT a member of everyone.');
  88.  
  89.  
  90. { ------------AND NOW: the property test.
  91.   create a static property with default security... }
  92. writeln;
  93. writeln('Creating a property IDENTIFICATION associated withe the ',usrName,' object.');
  94. IF NOT CreateProperty(usrName,OT_USER,
  95.                       'IDENTIFICATION',BF_ITEM,BS_ANY_WRITE OR BS_ANY_READ)
  96.  then writeln('Couldn''t create property.');
  97.  
  98. IF NOT ChangePropertySecurity(usrName,OT_USER,'IDENTIFICATION',
  99.                               BS_LOGGED_READ or BS_SUPER_WRITE)
  100.  then writeln('Couldn''t change property security.');
  101.  
  102. writeln('Writing the property value: ',trueName);
  103. FillChar(pTrueName[1],SizeOf(pTrueName),#0);
  104. for t:=1 to ord(truename[0]) do pTrueName[t]:=ord(TrueName[t]);
  105.  
  106. IF NOT WritePropertyValue(usrName,OT_USER,'IDENTIFICATION',1,pTrueName,FALSE)
  107.  then Warning('Couldn''t write the property value.');
  108.  
  109. { The next calls were tested before, so they are not tested again.
  110.   They create the minimal properties needed to login as the new object. }
  111.  
  112. CreateProperty(usrName,OT_USER,'GROUPS_I''M_IN',
  113.                BF_SET,BS_SUPER_WRITE OR BS_LOGGED_READ);
  114.  
  115. AddBinderyObjectToSet(usrName,OT_USER,'GROUPS_I''M_IN',
  116.                       'EVERYONE',OT_USER_GROUP);
  117.  
  118. CreateProperty(usrName,OT_USER,'SECURITY_EQUALS',
  119.                BF_SET,BS_SUPER_WRITE OR BS_LOGGED_READ);
  120.  
  121. AddBinderyObjectToSet(usrName,OT_USER,'SECURITY_EQUALS',
  122.                       'EVERYONE',OT_USER_GROUP);
  123.  
  124. {------------- Renaming the object. }
  125. writeln;
  126. writeln('Renaming the object.');
  127. UpString(usrName); { make usrName upstring for comparison with found name.}
  128.  
  129. GetBinderyObjectName(objId,replyUsrName,replyObjType);
  130. IF (nwBindry.result>0) or (replyUsrName<>usrName) or (replyObjType<>OT_USER)
  131.  then Warning('Something very wrong here.');
  132. writeln(' Object name was   :',replyUsrName);
  133.  
  134. IF NOT RenameBinderyObject(usrName,'THE_DIVA',OT_USER)
  135.  then Warning('Couldn''t rename the object.');
  136.  
  137. usrName:='THE_DIVA'; {that's what it should be now}
  138.  
  139. GetBinderyObjectName(objId,replyUsrName,replyObjType);
  140. IF (nwBindry.result<>0) or (replyUsrName<>usrName) or (replyObjType<>OT_USER)
  141.  then Warning('Object was NOT renamed.');
  142. writeln(' Object name now is:',replyUsrName);
  143.  
  144. {------------ Change and verify bindery object password. }
  145.  
  146. { create a password property ? }
  147.  
  148. {! as long as the calls in the unit nwBindry do not support encrypted passwords,
  149.  ! remember to type 'set allow uncrypted passwords = ON' on the console,
  150.  ! otherwise these calls will allways fail. }
  151.  
  152. writeln;
  153. writeln('Changing Object Password.');
  154. IF ChangeBinderyObjectPassword(usrName,OT_USER,#0,'KERMIT')
  155.  then writeln('Password successfully changed.')
  156.  else Warning('Couldn''t change password.');
  157.  
  158. writeln('Verifying new password.');
  159. IF VerifyBinderyObjectPassword(usrName,OT_USER,'wrong password')
  160.  then Warning('A wrong password was verified as being OK.');
  161.  
  162. IF NOT VerifyBinderyObjectPassword(usrName,OT_USER,'KERMIT')
  163.  then Warning('The correct Password was NOT verified.');
  164.  
  165. { If you stop execution of this program AT THIS POINT, you will
  166.   have added a user THE_DIVA with password KERMIT, member of the
  167.   group EVERYONE to your bindery. }
  168.  
  169. { halt(0); }
  170.  
  171. {------------ Deleting  properties and objects }
  172. writeln;
  173. writeln('Deleting a property.');
  174. IF NOT DeleteProperty(usrName,OT_USER,'IDENTIFICATION')
  175.  then writeln('Couldn''t delete property.');
  176.  
  177. IF ExistsProperty(usrName,OT_USER,'IDENTIFICATION')
  178.  then writeln('??:Property wasn''t deleted.');
  179.  
  180. writeln('Removing the user object from the group EVERYONE.');
  181. DeleteBinderyObjectFromSet(usrName,OT_USER,
  182.                            'GROUP_MEMBERS','EVERYONE',OT_USER_GROUP);
  183.  
  184. IF IsBinderyObjectInSet(usrName,OT_USER,
  185.                         'GROUP_MEMBERS','EVERYONE',OT_USER_GROUP)
  186.  then writeln('Couldn''t throw '+usrName+' out of everyone (group)');
  187.  
  188. writeln('Deleting the ',usrName,' object and all related properties.');
  189. IF NOT DeleteBinderyObject(usrName,OT_USER)
  190.  then writeln('Couldn''t delete object.');
  191.  
  192. IF GetBinderyObjectID(usrName,OT_USER,objID)
  193.  then writeln('??: deleted object still exists.');
  194.  
  195. end.