home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rexxne.zip / USRMAINT.CMD < prev   
OS/2 REXX Batch file  |  1993-09-13  |  25KB  |  1,097 lines
  1. /*
  2.     USERMAINT.CMD User Maintenance Functions
  3.  
  4.     Supports the following User Functions
  5.     ADDUSER -   Add a User
  6.     DELUSER -   Del a User
  7.  
  8.     Written: Steven Elliott, August 1993
  9.  
  10.     Requires REXXNET.DLL
  11. */
  12.  
  13. /*
  14. **********************************************************************
  15.   GLOBAL VARIABLES
  16. */
  17.  
  18. version = 1.3
  19. tab = D2C(9)
  20. cr = D2C(13)
  21.  
  22. Server = ''
  23. Alias.All = 7
  24. Alias.File = 1
  25. Alias.Print = 2
  26. App.Public = 2
  27. App.All = 7
  28. App.Private = 2
  29.  
  30. Drives.Num = 8     /* Drives M to T */
  31. Drives.First = 'M'
  32.  
  33. Ports.Num = 4     /* LPT1 to LPT4 */
  34.  
  35. App.Excel = 'APMEXCEL'
  36. App.PMWord = 'APMWORD'
  37.  
  38. Location.HomeDirs = 'F:\HomeDirs'
  39. Location.Sections = 'G:\Sections'
  40. Location.HomeServer = 'HOMEFS'
  41. Location.SectionServer = 'FSHOME'
  42.  
  43. /********************************************
  44.   Standard Logon Connections
  45. */
  46. StdLogonAsn.Entries = 4
  47. StdLogonAsn.0.Device = 'H'
  48. StdLogonAsn.0.Alias = 'H'
  49. StdLogonAsn.0.Type = Alias.File
  50. StdLogonAsn.1.Device = 'W'
  51. StdLogonAsn.1.Alias = 'UDOSAPPS'
  52. StdLogonAsn.1.Type = Alias.File
  53. StdLogonAsn.2.Device = 'X'
  54. StdLogonAsn.2.Alias = 'USYSTEM'
  55. StdLogonAsn.2.Type = Alias.File
  56. StdLogonAsn.3.Device = 'Y'
  57. StdLogonAsn.3.Alias = 'UCOMMON'
  58. StdLogonAsn.3.Type = Alias.File
  59.  
  60. Globals = 'StdLogonAsn. LogonAsn. Drives. Ports. Server App. Alias. UserID Tab UserInfo. Location.'
  61.  
  62. /*********************************************/
  63.  
  64. call rxfuncadd SysLoadFuncs, "RexxUtil", SysLoadFuncs
  65. call SysLoadFuncs
  66. call rxfuncadd NetLoadFuncs, "RexxNet", NetLoadFuncs
  67. call NetLoadFuncs
  68. signal on syntax
  69. signal on halt
  70. call main
  71.  
  72.  
  73. done:
  74. say ""
  75. say "Thankyou for using UsrMaint"
  76. call NetDropFuncs
  77. exit
  78.  
  79. halt:
  80. say "UsrMaint interrupted"
  81. call NetDropFuncs
  82. exit
  83.  
  84. syntax:
  85. say ""
  86. say "Sorry, I've got a headache,"
  87. say "I don't think I can help you at the moment"
  88. say ""
  89. say "Line:" sigl " Error:" rc ':' errortext(rc)
  90. signal done
  91.  
  92. /*************************************************************
  93.      MAIN
  94. */
  95.  
  96. main:
  97. UserID = ''
  98. Server = ''
  99. retc = NetWkstaGetInfo('', 10, Wksta)
  100. if retc \= 0 then do
  101.   call error retc
  102.   return
  103. end
  104. retc = NetGetDCName('', Wksta.Logon_Domain, 'Server')
  105. if retc \= 0 then do
  106.   call error retc
  107.   return
  108. end
  109. do forever
  110.   call SysCls
  111.   say "UserMaint - Version" version
  112.   say ""
  113.   say "Domain :" Wksta.Logon_Domain
  114.   say "PDC    :" Substr(Server, 3)
  115.   say ""
  116.   say "Please select one of the following:"
  117.   say ""
  118.   say "  N)   New User"
  119.   say "  M)   Modify/Delete User"
  120.   say "  R)   Reset Users Password"
  121.   say "  Z)   Zap User (Delete)"
  122.   say ""
  123.   say "  V)   View User Setup"
  124.   say "  L)   List All Users"
  125.   say ""
  126.   say "  P)   Change Printer Connections"
  127.   say "  D)   Change Drive Connections"
  128.   say "  A)   Change Applications"
  129.   say ""
  130.   say "  X)   Exit"
  131.   say ""
  132.   call charout '', "Enter your selection --> "
  133.   parse upper pull func
  134.  
  135.   if func = 'C' then
  136.     leave
  137.  
  138.   if func = 'X' then
  139.     leave
  140.  
  141.   if func = 'L' then do
  142.     call listUser
  143.     iterate
  144.   end
  145.   say ""
  146.   call charout '', "Enter UserID "
  147.   if UserID \= '' then
  148.     call charout '', "(or ENTER for '"||UserID||"')"
  149.   call charout '', " --> "
  150.   parse upper pull newID
  151.   if newID \= '' then
  152.     UserID = newID
  153.   retc = NetUserGetInfo(Server, UserID, 10, UserInfo)
  154.   select
  155.     when retc = 0 then
  156.       nop
  157.  
  158.     when retc = 2221 then
  159.       if func \= 'N' then do
  160.     say "User does not exist"
  161.     call pause
  162.     iterate
  163.       end
  164.  
  165.     otherwise do
  166.       call error retc
  167.       iterate
  168.     end
  169.   end
  170.  
  171.   call SysCls
  172.   select
  173.     when func = 'V' then
  174.       call viewUser
  175.  
  176.     when func = 'M' then
  177.       call modUser
  178.  
  179.     when func = 'N' then
  180.       if retc \= 2221 then do
  181.     say "User Already Exists"
  182.     say ""
  183.     call viewUser
  184.       end
  185.       else
  186.     call newUser
  187.  
  188.     when func = 'R' then
  189.       call ResetPWD
  190.  
  191.     when func = 'Z' then
  192.       call DelUser
  193.  
  194.     when func = 'P' then
  195.       call PrintCon
  196.  
  197.     when func = 'A' then
  198.       call AppSel
  199.  
  200.     when func = 'D' then
  201.       call Drives
  202.  
  203.     otherwise
  204.       iterate
  205.   end
  206.   call pause
  207. end /* forever */
  208. return
  209.  
  210. pause:
  211.   parse arg extra
  212.   say ""
  213.   if extra \= '' then
  214.     say extra
  215.   call charout '', "Hit ENTER to continue "
  216.   parse pull operation
  217.   return
  218.  
  219. /*************************************************************
  220.      APPSEL
  221.  
  222.     Allows changes to a user Public Applications
  223. */
  224.  
  225. AppSel:
  226. changed = 0
  227. retc = NetUserGetAppSel(Server, UserID, 1, App.All, AppSel)
  228. if retc \= 0 then do
  229.     call error retc
  230.     return
  231. end
  232. do forever
  233. say ""
  234. say "Current Applications for" UserInfo.usr_Comment '('UserInfo.Name')'
  235. say ""
  236. do i = 0 to AppSel.Entries - 1
  237.     say AppSel.i.AppName
  238. end
  239. say ""
  240. say "Enter A)dd to add entry,"
  241. say "      D)elete to remove entry,"
  242. say "      L)ist to show available,"
  243. say "      S)ave current changes,"
  244. say "      C)ancel all changes"
  245. say ""
  246. call charout '', "Enter Option --> "
  247. parse upper pull option
  248. select
  249.   when option = 'L' then do
  250.     retc = NetAppEnum(Server, UserId, 1, App.All, Apps)
  251.     if retc \= 0 then do
  252.       call error retc
  253.       return
  254.     end
  255.     say ""
  256.     j = 0
  257.     do i = 0 to Apps.Entries - 1
  258.       say Left(Apps.i.Name, 16, ' ') Apps.i.Remark
  259.       j = j + 1
  260.       if j = 23 then do
  261.     call charout "", "Hit ENTER to contine "
  262.     parse pull quit
  263.     if quit \= '' then
  264.       leave
  265.     say ""
  266.     j = 0
  267.       end
  268.     end
  269.     call charout '', "Hit ENTER to continue "
  270.     parse pull quit
  271.   end
  272.  
  273.   when option = 'A' then do
  274.     call charout '', "Enter Application Name --> "
  275.     parse upper pull newapp
  276.     if newapp \= '' then do
  277.       i = AppSel.Entries
  278.       AppSel.i.AppName = newapp
  279.       AppSel.i.AppType = App.Public
  280.       AppSel.Entries = i + 1
  281.       retc = NetGroupAddUser(Server, newapp, UserID)
  282.       changed = 1
  283.     end
  284.   end
  285.  
  286.   when option = 'D' then do
  287.     call charout '', "Enter Application Name --> "
  288.     parse upper pull delapp
  289.     do i = 0 to AppSel.Entries - 1
  290.       if AppSel.i.AppName = DelApp then do
  291.     do j = i to AppSel.Entries - 2
  292.       k = j + 1
  293.       AppSel.j.AppName = AppSel.k.AppName
  294.       AppSel.j.AppType = AppSel.k.AppType
  295.     end
  296.     AppSel.Entries = AppSel.Entries - 1
  297.     changed = 1
  298.     retc = NetGroupDelUser(Server, DelApp, UserID)
  299.     leave
  300.       end
  301.     end
  302.   end
  303.  
  304.   when option = 'C' then
  305.     return
  306.  
  307.   otherwise
  308.     leave
  309. end /* select */
  310. end /* forever loop */
  311.  
  312. if changed = 0 then
  313.     return
  314. say "Updating User Application List..."
  315. retc = NetUserSetAppSel(Server, UserID, 1, AppSel)
  316. if retc \= 0 then do
  317.   call error retc
  318.   return
  319. end
  320. call ViewUser
  321. return
  322.  
  323.  
  324. /*************************************************************
  325.      DRIVES
  326.  
  327.     Allow changes to a user's Drive Links
  328. */
  329.  
  330. Drives: procedure expose (Globals)
  331. parse arg new
  332. if new \= '' then do
  333.   say "Logon Assignments"
  334.   signal skipdrives
  335. end
  336. say ""
  337. say "Current Drive Connections for" UserInfo.usr_Comment '('UserInfo.Name')'
  338. say ""
  339. retc = NetUserGetLogonAsn(Server, UserID, 1, Alias.All, LogonAsn)
  340. if retc \= 0 then do
  341.     call error retc
  342.     return
  343. end
  344. call StemSort 'LogonAsn' 'Device' 'Alias' 'Type'
  345. do i = 0 to LogonAsn.Entries - 1
  346.   if LogonAsn.i.Type \= Alias.File then
  347.     iterate
  348.   if LogonAsn.i.Device = StdLogonAsn.0.Device then
  349.     leave
  350.   say LogonAsn.i.Device||":" tab LogonAsn.i.Alias
  351. end
  352. say ""
  353. skipdrives:
  354. changed = 0
  355. say ""
  356. say "Enter 'D' to remove entry,"
  357. say "      'L' to list available,"
  358. say "      'S' to save current changes,"
  359. say "      'C' to cancel changes,"
  360. say "      ENTER to skip,"
  361. say "   or Alias to use"
  362. say ""
  363. do drive = 0 to Drives.Num - 1
  364.   cdrive = D2C(drive + C2D(Drives.First))
  365.   call charout '', "Enter new Alias for" cdrive||": --> "
  366.   parse upper pull newalias
  367.   if newalias = '' then
  368.     iterate
  369.   select
  370.   when newalias = 'C' then do
  371.     say "Changes Cancelled"
  372.     return
  373.   end
  374.  
  375.   when newalias = 'S' then
  376.     leave
  377.  
  378.   when newalias = 'L' then do
  379.     say ""
  380.     say "Drive Aliases"
  381.     say ""
  382.     retc = NetAliasEnum(Server, 1, Alias.File, Connects)
  383.     if retc \= 0 then do
  384.       call error retc
  385.       return
  386.     end
  387.     j = 0
  388.     say ""
  389. /* TOO SLOW -- call StemSort 'Connects' 'Alias' */
  390.     do i = 0 to Connects.Entries - 1
  391.       if Left(Connects.i.Alias, 1) = 'F' then do
  392.     say Left(Connects.i.Alias, 16, ' ') Connects.i.Remark
  393.     j = j + 1
  394.     if j = 23 then do
  395.       call charout "", "Hit ENTER to contine "
  396.       parse pull quit
  397.       if quit \= '' then
  398.         leave
  399.       say ""
  400.       j = 0
  401.     end
  402.       end
  403.     end
  404.     say ""
  405.     drive = drive - 1
  406.     end
  407.   otherwise do
  408.     if newalias \= 'D' & NetAliasGetInfo(Server, newalias, 0, Test) \= 0 then do
  409.       call pause "Alias does not exist"
  410.       drive = drive - 1
  411.       iterate
  412.     end
  413.     do i = 0 to LogonAsn.Entries - 1
  414.       if cdrive = LogonAsn.i.Device then do
  415.     if newalias = 'D' then do
  416.       do j = i to LogonAsn.Entries - 2
  417.         k = j + 1
  418.         LogonAsn.j.Device = LogonAsn.k.Device
  419.         LogonAsn.j.Type = LogonAsn.k.Type
  420.         LogonAsn.j.Alias = LogonAsn.k.Alias
  421.       end
  422.       LogonAsn.Entries = LogonAsn.Entries - 1
  423.       changed = 1
  424.       retc = NetGroupDelUser(Server, newalias, UserID)
  425.       leave
  426.     end
  427.     LogonAsn.i.Alias = newalias
  428.     changed = 1
  429.     leave
  430.       end
  431.     end
  432.     if (i = LogonAsn.Entries) & (newalias \= 'D') then do
  433.       LogonAsn.i.Device = cdrive
  434.       LogonAsn.i.Type = Alias.File
  435.       LogonAsn.i.Alias = newalias
  436.       LogonAsn.Entries = LogonAsn.Entries + 1
  437.       retc = NetGroupAddUser(Server, newalias, UserID)
  438.       changed = 1
  439.     end
  440.   end
  441.   end /* select */
  442. end
  443. if new \= '' then
  444.     return
  445. if changed \= 0 then do
  446.   say "Updating User's Drive Connections ..."
  447.   retc = NetUserSetLogonAsn(Server, UserID, 1, LogonAsn)
  448.   if retc \= 0 then do
  449.     call error retc
  450.     return
  451.   end
  452.   call ViewUser
  453. end
  454. return
  455.  
  456. /*************************************************************
  457.      PRINTCON
  458.  
  459.     Allow changes to a user's Printer Connections
  460. */
  461.  
  462. PrintCon: procedure expose (Globals)
  463. parse arg new
  464. if new \= '' then do
  465.   say ""
  466.   say "Printer Assignments"
  467.   signal skipPrint
  468. end
  469. say ""
  470. say "Current Print Connections for" UserInfo.usr_Comment '('UserInfo.Name')'
  471. say ""
  472. retc = NetUserGetLogonAsn(Server, UserID, 1, Alias.All, LogonAsn)
  473. if retc \= 0 then do
  474.     call error retc
  475.     return
  476. end
  477. call StemSort 'LogonAsn' 'Device' 'Alias' 'Type'
  478. do i = 0 to LogonAsn.Entries - 1
  479.   if LogonAsn.i.Type = Alias.Print then
  480.     say LogonAsn.i.Device tab LogonAsn.i.Alias
  481. end
  482. say ""
  483. skipPrint:
  484. changed = 0
  485. say ""
  486. say "Enter 'D' to remove entry,"
  487. say "      'L' to list available,"
  488. say "      'S' to save current changes,"
  489. say "      'C' to cancel changes,"
  490. say "      ENTER to skip,"
  491. say "   or Alias to use"
  492. say ""
  493. do port = 1 to Ports.Num
  494.   cport = D2C(port + C2D('0'))
  495.   call charout '', "Enter new Alias for LPT"||cport " --> "
  496.   parse upper pull newalias
  497.   if newalias = '' then
  498.     iterate
  499.   select
  500.   when newalias = 'C' then do
  501.     say "Changes Cancelled"
  502.     return
  503.   end
  504.  
  505.   when newalias = 'S' then
  506.     leave
  507.  
  508.   when newalias = 'L' then do
  509.     say ""
  510.     say "Printer Aliases"
  511.     say ""
  512.     retc = NetAliasEnum(Server, 1, Alias.Print, Queues)
  513.     if retc \= 0 then do
  514.       call error retc
  515.       return
  516.     end
  517.     call StemSort 'Queues' 'Alias' 'Remark'
  518.     j = 0
  519.     do i = 0 to Queues.Entries - 1
  520.       say Queues.i.Alias tab Queues.i.Remark tab
  521.       j = j + 1
  522.       if j = 23 then do
  523.     call charout "", "Hit ENTER to contine "
  524.     parse pull quit
  525.     if quit \= '' then
  526.       leave
  527.     say ""
  528.     j = 0
  529.       end
  530.     end
  531.     say ""
  532.     port = port - 1
  533.   end
  534.  
  535.   otherwise do
  536.     if newalias \= 'D' & NetAliasGetInfo(Server, newalias, 0, Test) \= 0 then do
  537.       say "Alias does not exist"
  538.       port = port - 1
  539.       iterate
  540.     end
  541.     do i = 0 to LogonAsn.Entries - 1
  542.       if "LPT"||cport = LogonAsn.i.Device then do
  543.     if newalias = 'D' then do
  544.       do j = i to LogonAsn.Entries - 2
  545.         k = j + 1
  546.         LogonAsn.j.Device = LogonAsn.k.Device
  547.         LogonAsn.j.Type = LogonAsn.k.Type
  548.         LogonAsn.j.Alias = LogonAsn.k.Alias
  549.       end
  550.       LogonAsn.Entries = LogonAsn.Entries - 1
  551.       changed = 1
  552.       retc = NetGroupDelUser(Server, newalias, UserID)
  553.       leave
  554.     end
  555.     LogonAsn.i.Alias = newalias
  556.     changed = 1
  557.     leave
  558.       end
  559.     end
  560.     if (i = LogonAsn.Entries) & (newalias \= 'D') then do
  561.       LogonAsn.i.Device = "LPT"||cport
  562.       LogonAsn.i.Type = Print_Alias
  563.       LogonAsn.i.Alias = newalias
  564.       LogonAsn.Entries = LogonAsn.Entries + 1
  565.       retc = NetGroupAddUser(Server, newalias, UserID)
  566.       changed = 1
  567.     end
  568.   end
  569.   end /* select */
  570. end
  571. if new \= '' then
  572.     return
  573. if changed \= 0 then do
  574.   say "Updating User's Print Connections ..."
  575.   retc = NetUserSetLogonAsn(Server, UserID, 1, LogonAsn)
  576.   if retc \= 0 then do
  577.     call error retc
  578.     return
  579.   end
  580.   call ViewUser
  581. end
  582. return
  583.  
  584.  
  585. /*************************************************************
  586.      RESETPASSWORD
  587.  
  588.     Reset Users Password
  589. */
  590.  
  591. ResetPWD:
  592. say ""
  593. say "Reset User's Password"
  594. say ""
  595. say "UserID:    " UserID
  596. say "User Name: " UserInfo.usr_comment
  597. say ""
  598. call charout '', "Hit ENTER to Reset Password, any other key to skip "
  599. parse upper pull confirm
  600. if confirm = '' then do
  601.   say ""
  602.   say "Resetting '"||UserInfo.Usr_Comment||"'s Password to '"||UserID||"'"
  603.   retc = NetUserSetInfo(Server, UserId, 2, UserID, 3)
  604.   if retc \= 0 then do
  605.     call error retc
  606.     return
  607.   end
  608.   /* The following re-enables the account incase it has been disabled */
  609.   retc = NetUserSetInfo(Server, UserId, 2, 1, 8)
  610. end
  611. call error retc
  612. return
  613.  
  614. /*************************************************************
  615.      MODUSER
  616.  
  617.     Modify User
  618. */
  619.  
  620. ModUser:
  621. say ""
  622. say "Modify User"
  623. say ""
  624. say "UserID:    " UserID
  625. say "User Name: " UserInfo.usr_comment
  626. say "Comment 1: " UserInfo.comment
  627. say "Comment 2: " UserInfo.full_name
  628. say ""
  629. call charout '', "Enter new User Name --> "
  630. parse pull name
  631. call charout '', "Enter new Comment 1 --> "
  632. parse pull comment
  633. call charout '', "Enter new Comment 2 --> "
  634. parse pull comment2
  635. say ""
  636. if name = '' & comment = '' & comment2 = '' then
  637.   return
  638. say "Updating User ..."
  639. if name \= '' then do
  640.   retc = NetUserSetInfo(Server, UserId, 2, name, 12)
  641.   if retc \= 0 then do
  642.     call error retc
  643.     return
  644.   end
  645. end
  646. if comment \= '' then do
  647.   retc = NetUserSetInfo(Server, UserId, 2, comment, 7)
  648.   if retc \= 0 then do
  649.     call error retc
  650.     return
  651.   end
  652. end
  653. if comment2 \= '' then do
  654.   retc = NetUserSetInfo(Server, UserId, 2, comment2, 11)
  655.   if retc \= 0 then do
  656.     call error retc
  657.     return
  658.   end
  659. end
  660. call ViewUser
  661. return
  662.  
  663.  
  664. /*************************************************************
  665.      DELUSER
  666. */
  667.  
  668. DelUser:
  669. say ""
  670. say "Delete User"
  671. say ""
  672. call ViewUser
  673. say ""
  674. call charout '', "Enter Y to delete, any other key to continue "
  675. parse upper pull confirm
  676. if confirm \= 'Y' then do
  677.   say "Delete Cancelled"
  678.   return
  679. end
  680. retc = NetUserDel(Server, UserID)
  681. if retc \= 0 then
  682.   call error retc
  683. retc = NetAliasDel(Server, 'H'UserID)
  684. if retc \= 0 then
  685.   call error retc
  686. say "User Deleted Successfully"
  687. say ""
  688. say "NOTE: The Users Alias has been removed, but their files still exist"
  689. say ""
  690. return
  691.  
  692. /*************************************************************
  693.      NEWUSER
  694. */
  695.  
  696. newUser:
  697. say ""
  698. say "New User"
  699. say ""
  700. UserInfo.Name = UserID
  701. UserInfo.Password = UserID
  702. UserInfo.Priv = 1
  703. UserInfo.Flags = 1
  704. UserInfo.Auth_Flags = 0
  705. UserInfo.Max_Storage = -1
  706. UserInfo.acct_expires = -1
  707. UserInfo.Code_Page = 437
  708. UserInfo.Country_Code = 062
  709. say "UserID: " UserID
  710. call charout '', "Enter User Name --> "
  711. parse pull UserInfo.Usr_Comment
  712. call charout '', "Enter Comment 1 --> "
  713. parse pull UserInfo.Comment
  714. call charout '', "Enter Comment 2 --> "
  715. parse pull UserInfo.Full_Name
  716. if UserInfo.Comment = '' then
  717.   UserInfo.Comment = ' '
  718. if UserInfo.Full_Name = '' then
  719.   UserInfo.Full_Name = ' '
  720.  
  721. do i = 0 to StdLogonAsn.Entries - 1
  722.   LogonAsn.i.Device = StdLogonAsn.i.Device
  723.   LogonAsn.i.Alias = StdLogonAsn.i.Alias
  724.   LogonAsn.i.Type = StdLogonAsn.i.Type
  725. end
  726. LogonAsn.Entries = StdLogonAsn.Entries
  727. LogonAsn.0.Alias = 'H'UserID
  728.  
  729. call Drives New
  730. call PrintCon New
  731.  
  732. AppEntries = 0
  733. call charout '', "Does user require PM Word Access (Y/n) --> "
  734. parse upper pull confirm
  735. if (confirm = 'Y') | (confirm = '') then do
  736.   Apps.AppEntries.Appname = App.PMWord
  737.   Apps.AppEntries.AppType = App.Public
  738.   AppEntries = AppEntries + 1
  739. end
  740. call charout '', "Does user require PM Excel Access (Y/n) --> "
  741. parse upper pull confirm
  742. if (confirm = 'Y') | (confirm = '') then do
  743.   Apps.AppEntries.Appname = App.Excel
  744.   Apps.AppEntries.AppType = App.Public
  745.   AppEntries = AppEntries + 1
  746. end
  747.  
  748. do while 1
  749.   call charout '', "Enter any other Application Names --> "
  750.   parse upper pull Apps.AppEntries.Appname
  751.   if Apps.AppEntries.Appname = '' then
  752.     leave
  753.   if NetAppGetInfo(Server, '', Apps.AppEntries.Appname, 0, Test) \= 0 then do
  754.     say "Application does not exist"
  755.     iterate
  756.   end
  757.   Apps.AppEntries.AppType = App.Public
  758.   AppEntries = AppEntries + 1
  759. end
  760.  
  761. say ""
  762. say "Adding User ..."
  763. say ""
  764. retc = NetUserAdd(Server, 2, UserInfo)
  765. if retc \= 0 then do
  766.   call error retc
  767.   return
  768. end
  769.  
  770. say "Initializing DCDB"
  771. retc = NetUserDCDBInit(Server, UserID)
  772. if retc \= 0 then do
  773.   call error retc
  774.   retc = NetUserDel(Server, UserID)
  775.   return
  776. end
  777.  
  778.  
  779. say "Creating Home Directory ..."
  780. retc = NetAliasGetInfo(Server, 'OHOMEDIR', 2, aInfo)
  781. if retc \= 0 then do
  782.   call error retc
  783.   retc = NetUserDel(Server, UserID)
  784.   return
  785. end
  786. uInfo.Local = 'Z:'
  787. uInfo.Remote = aInfo.Server'\'aInfo.NetName
  788. uInfo.Asg_Type = 0
  789. retc = NetUseDel('', 'Z:', 2)
  790. retc = NetUseAdd('', 1, uInfo)
  791. if retc \= 0 then do
  792.   call error retc
  793.   retc = NetUserDel(Server, UserID)
  794.   return
  795. end
  796. retc = SysMkDir('Z:\'UserId)
  797. if (retc \= 0) & (retc \= 5) then do
  798.   call error retc
  799.   retc = NetUserDel(Server, UserID)
  800.   return
  801. end
  802. aInfo.Alias = 'H'UserID
  803. aInfo.NetName = 'H'UserID
  804. aInfo.Max_Users = 2
  805. aInfo.Path = Location.HomeDirs'\'UserID
  806. aInfo.Remark = 'Home Dir -' UserInfo.Usr_Comment '('Location.HomeServer')'
  807. retc = NetAliasAdd(Server, 2, aInfo)
  808. if (retc \= 0) & (retc \= 2782) then do
  809.   call error retc
  810.   retc = NetUserDel(Server, UserID)
  811.   return
  812. end
  813. /*
  814.     Now create the Sharename that the Alias points to
  815. */
  816. sInfo.NetName = aInfo.NetName
  817. sInfo.Type = 0
  818. sInfo.Remark = aInfo.Remark
  819. sInfo.Max_Users = aInfo.Max_Users
  820. sInfo.Path = aInfo.Path
  821. sInfo.Passwd = ''
  822. retc = NetShareAdd(aInfo.Server, 2, sInfo)
  823. if (retc \= 0) & (retc \= 2118) then do
  824.   call error retc
  825.   retc = NetUserDel(Server, UserID)
  826.   return
  827. end
  828.  
  829. /*
  830.     Wait for UserID to arrive at Home server
  831. */
  832. call charout '', "Waiting for Account Replication."
  833. do forever
  834.   retc = NetUserGetInfo(aInfo.Server, UserID, 0, 'Temp')
  835.   if retc = 0 then
  836.     leave
  837.   if retc \= 2221 then do
  838.     call error retc
  839.     return
  840.   end
  841.   call charout '', '.'
  842.   call SysSleep 5
  843. end
  844. say ""
  845. acInfo.resource_name = 'Z:\'UserID
  846. acInfo.attr = 0
  847. acInfo.count = 1
  848. acInfo.access_list.0.ugname = UserID
  849. acInfo.access_list.0.access = 127
  850. retc = NetAccessDel('', acInfo.resource_name)
  851. retc = NetAccessAdd('', 1, acInfo)
  852. if retc \= 0 then do
  853.   say "Could not set Access Permissions for User Home Directory"
  854.   call error retc
  855. end
  856. say "Copying Standard User Files"
  857. '@XCOPY X:\NewUser Z:\'UserID '/S/E >NUL'
  858. if rc \= 0 then do
  859.   say "Could not copy New User Files to users Home Directory"
  860. end
  861. retc = NetUseDel('', 'Z:', 2)
  862.  
  863. say "Setting Logon Assignments ..."
  864. retc = NetUserSetLogonAsn(Server, UserID, 1, LogonAsn)
  865. if retc \= 0 then do
  866.   call error retc
  867.   retc = NetUserDel(Server, UserID)
  868.   return
  869. end
  870.  
  871. say "Setting Public Applications ..."
  872. Apps.Entries = AppEntries
  873. retc = NetUserSetAppSel(Server, UserID, 1, Apps)
  874. if retc \= 0 then do
  875.   call error retc
  876.   retc = NetUserDel(Server, UserID)
  877.   return
  878. end
  879.  
  880. say "Adding user to Groups"
  881. retc = NetGroupEnum(Server, 0, gInfo)
  882. if retc \= 0 then do
  883.   call error retc
  884.   gInfo.Entries = 0
  885. end
  886.  
  887. do i = 0 to LogonAsn.Entries - 1
  888.   do j = 0 to gInfo.Entries - 1
  889.     if LogonAsn.i.Alias = gInfo.j.Name then
  890.       leave
  891.   end
  892.   if j \= gInfo.Entries then do
  893.     retc = NetGroupAddUser(Server, gInfo.j.Name, UserID)
  894.     if retc \= 0 then do
  895.     say "Group:" gInfo.j.Name UserID
  896.     call error retc
  897.     end
  898.   end
  899. end
  900. do i = 0 to Apps.Entries - 1
  901.   do j = 0 to gInfo.Entries - 1
  902.     if Apps.i.AppName = gInfo.j.Name then
  903.       leave
  904.   end
  905.   if j \= gInfo.Entries then do
  906.     retc = NetGroupAddUser(Server, gInfo.j.Name, UserID)
  907.     if retc \= 0 then do
  908.     say "Group:" gInfo.j.Name UserID
  909.     call error retc
  910.     end
  911.   end
  912. end
  913.  
  914. say ""
  915. call ViewUser
  916. return
  917.  
  918.  
  919. /*************************************************************
  920.      VIEWUSER
  921. */
  922.  
  923. ViewUser:
  924.   retc = NetUserGetInfo(Server, UserID, 10, 'UserInfo')
  925.   if retc \= 0 then do
  926.     call error retc
  927.     return
  928.   end
  929.   say ""
  930.   say "UserID   : " UserID
  931.   say "User Name: " UserInfo.Usr_Comment
  932.   say "Comment 1: " UserInfo.comment
  933.   say "Comment 2: " UserInfo.full_name
  934.   say ""
  935.   say "Logon Assignments"
  936.   say ""
  937.   retc = NetUserGetLogonAsn(Server, UserID, 1, Alias.All, LogonAsn)
  938.   if retc \= 0 then do
  939.     call error retc
  940.     return
  941.   end
  942.   call StemSort 'LogonAsn' 'Device' 'Alias' 'Type'
  943.   do i = 0 to LogonAsn.Entries - 1
  944.     if LogonAsn.i.Type \= Alias.File then
  945.     iterate
  946.     if LogonAsn.i.Device = StdLogonAsn.0.Device then
  947.     leave
  948.     say Left(LogonAsn.i.Device||":", 8, ' ') LogonAsn.i.Alias
  949.   end
  950.   say ""
  951.   do i = 0 to LogonAsn.Entries - 1
  952.     if LogonAsn.i.Type = Alias.Print then
  953.       say Left(LogonAsn.i.Device||":", 8, ' ') LogonAsn.i.Alias
  954.   end
  955.   say ""
  956.   say "Applications"
  957.   say ""
  958.   retc = NetUserGetAppSel(Server, UserID, 1, App.All, AppSel)
  959.   if retc \= 0 then do
  960.     call error retc
  961.     return
  962.   end
  963.   call StemSort 'AppSel' 'AppName'
  964.   do i = 0 to AppSel.Entries - 1
  965.     say AppSel.i.AppName
  966.   end
  967. return
  968.  
  969. /*************************************************************
  970.      LISTUSER
  971. */
  972.  
  973. listuser:
  974.   say ""
  975.   say "Retrieving and Sorting User List"
  976.   say ""
  977.   retc = NetUserEnum(Server, 10, ListInfo)
  978.   do j = 0 to ListInfo.Entries - 1
  979.     next = 'ZZZZZZZ'
  980.     do i = 0 to ListInfo.Entries - 1
  981.       if Listinfo.i.Name < next then do
  982.     next = ListInfo.i.Name
  983.     entry = i
  984.       end
  985.     end
  986.     if next = 'ZZZZZZZ' then
  987.        leave
  988.     say "  " Left(next, 10) ListInfo.entry.Usr_Comment
  989.     ListInfo.entry.Name = 'ZZZZZZZ'
  990.     if j - (j % 23) * 23 = 22 then do
  991.       say ""
  992.       call charout '', "Hit RETURN to continue, Z to quit, or letter to jump to --> "
  993.       parse upper pull quit
  994.       select
  995.     when quit = 'Z' then
  996.       leave
  997.     when quit = '' then
  998.       nop
  999.     otherwise
  1000.       do k = 0 to ListInfo.Entries - 1
  1001.         if ListInfo.k.Name < quit then
  1002.           ListInfo.k.Name = 'ZZZZZZZ'
  1003.       end
  1004.       end
  1005.       call SysCls
  1006.     end
  1007.   end
  1008.   if j < 23 then do
  1009.     say ""
  1010.     call charout '', "Hit RETURN to continue "
  1011.     parse pull quit
  1012.   return
  1013.  
  1014. /*************************************************************
  1015.      ERROR
  1016. */
  1017.  
  1018. error:
  1019. parse arg retc
  1020. if retc \= 0 then do
  1021.     if retc < 2100 then
  1022.     say NetGetMessage(retc)
  1023.     else
  1024.     say NetGetMessage(retc, "NET.MSG")
  1025. end
  1026. else
  1027.     say "Completed Successfully"
  1028. say ""
  1029. call pause
  1030. return
  1031.  
  1032.  
  1033. /*************************************************************
  1034.      SHOW
  1035. */
  1036.  
  1037. show:
  1038.   parse arg Stem level newapi enum
  1039.   interpret 'call Net'||newapi||'Info level, Names.'
  1040.  
  1041.   if enum = 1 then do
  1042.     interpret 'range =' Stem||'.Entries'
  1043.     say range
  1044.     do j = 0 to range - 1
  1045.     interpret 'call showline' Stem||'.'||j
  1046.     onscreen = 24 % Names.0
  1047.     if j - (j % onscreen) * onscreen = onscreen - 1 then do
  1048.         call charout '', "Pause.."
  1049.         parse pull quit
  1050.         if quit \= '' then
  1051.         leave
  1052.     end
  1053.     end
  1054.   end
  1055.   else
  1056.     call showline Stem
  1057.   return
  1058.  
  1059. showline:
  1060.   parse arg nstem
  1061.   do i = 1 to Names.0
  1062.     interpret 'say Names.i' nstem||'.'||Names.i
  1063.   end
  1064.   return
  1065.  
  1066.  
  1067. /*************************************************************
  1068.      STEMSORT
  1069. */
  1070.  
  1071. StemSort:
  1072.   parse arg stem field1 field2 field3
  1073.   total = Value(stem||".Entries") - 1
  1074.   do c1 = 0 to total
  1075.     interpret "this =" stem||".c1."||field1
  1076.     do c2 = c1 + 1 to total
  1077.       interpret "next =" stem||".c2."||field1
  1078.       if next < this then do
  1079.     interpret stem||".c2."||field1 "= this"
  1080.     if field2 \= '' then do
  1081.       interpret "hold = " stem||".c2."||field2
  1082.       interpret stem||".c2."||field2 "=" stem||".c1."||field2
  1083.       interpret stem||".c1."||field2 "= hold"
  1084.       if field3 \= '' then do
  1085.         interpret "hold = " stem||".c2."||field3
  1086.         interpret stem||".c2."||field3 "=" stem||".c1."||field3
  1087.         interpret stem||".c1."||field3 "= hold"
  1088.       end
  1089.     end
  1090.     this = next
  1091.       end
  1092.     end
  1093.     interpret stem||".c1."||field1 "= this"
  1094.   end
  1095.   return
  1096.  
  1097.