home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3980 < prev    next >
Encoding:
Internet Message Format  |  1991-09-09  |  14.8 KB
  1. Path: wupost!uunet!europa.asd.contel.com!darwin.sura.net!noc.sura.net!haven.umd.edu!mimsy!nrlvx1.nrl.navy.mil!koffley
  2. From: koffley@nrlvx1.nrl.navy.mil
  3. Newsgroups: alt.sources
  4. Subject: VMS UAF PROFILE part 7 of 18
  5. Message-ID: <1991Sep5.074402.551@nrlvx1.nrl.navy.mil>
  6. Date: 5 Sep 91 11:44:02 GMT
  7. Organization: NRL SPACE SYSTEMS DIVISION
  8. Lines: 415
  9.  
  10. -+-+-+-+-+-+-+-+ START OF PART 7 -+-+-+-+-+-+-+-+
  11. X              call str$upcase ( dummy_string, dummy_string )
  12. X              call reconvert_time ( dummy_string, 'exprdate' )
  13. X              if (success) then    ! date was translated correctly
  14. X                 exprdate = dummy_string
  15. X              else                 ! date was not translated correctly
  16. X                 call board ( owner, tables, defcli, defdev,
  17. X     .            defdir, lgicmd )
  18. X                 call smg$repaint_line ( pasteboard, cur_row )
  19. X                 call smg$set_cursor_abs ( main, cur_row, cur_column )
  20. X                 go to 10
  21. X              endif
  22. X           endif
  23. XC
  24. XC String at 11-13 is PWD_LENGTH
  25. XC
  26. X           if (cur_row.eq.11.and.cur_column.eq.13)  then
  27. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  28. X     .          pwd_length )
  29. X              call ots$cvt_l_ti ( pwd_length, pwd_length_string )
  30. X           endif
  31. XC
  32. XC String at 11-48 is PWD_LIFETIME
  33. XC
  34. X           if (cur_row.eq.11.and.cur_column.eq.48) then
  35. X              call reconvert_time ( dummy_string, 'pwdlife' )
  36. X              if (success) then              ! date was translated correctly
  37. X                 pwd_lifetime = dummy_string
  38. X              else                           ! date was not translated
  39. X                 call board ( owner, tables, defcli, defdev,
  40. X     .            defdir, lgicmd )
  41. X                 call smg$repaint_line ( pasteboard, cur_row )
  42. X                 call smg$set_cursor_abs ( main, cur_row, cur_column )
  43. X                 go to 10
  44. X              endif
  45. X           endif
  46. XC
  47. XC String at 13-16 is MAXJOBS
  48. XC
  49. X           if (cur_row.eq.13.and.cur_column.eq.16) then
  50. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  51. X     .         maxjobs )
  52. X              call ots$cvt_l_ti ( maxjobs, maxjobs_string )
  53. X           endif
  54. XC
  55. XC String at 13-35 is FILLM
  56. XC
  57. X           if (cur_row.eq.13.and.cur_column.eq.35) then
  58. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  59. X     .         fillm )
  60. X              call ots$cvt_l_ti ( fillm, fillm_string )
  61. X           endif
  62. XC
  63. XC String at 13-56 is BYTLM
  64. XC
  65. X           if (cur_row.eq.13.and.cur_column.eq.56) then
  66. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  67. X     .         bytlm )
  68. X              call ots$cvt_l_ti ( bytlm, bytlm_string )
  69. X           endif
  70. XC
  71. XC String at 14-16 is MAXACCTJOBS
  72. XC
  73. X           if (cur_row.eq.14.and.cur_column.eq.16) then
  74. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  75. X     .         maxacctjobs )
  76. X              call ots$cvt_l_ti ( maxacctjobs, maxacctjobs_string )
  77. X           endif
  78. XC
  79. XC String at 14-35 is SHRFILLM
  80. XC
  81. X           if (cur_row.eq.14.and.cur_column.eq.35) then
  82. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  83. X     .         shrfillm )
  84. X              call ots$cvt_l_ti ( shrfillm, shrfillm_string )
  85. X           endif
  86. XC
  87. XC String at 14-56 is PBYTLM
  88. XC
  89. X           if (cur_row.eq.14.and.cur_column.eq.56) then
  90. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  91. X     .         pbytlm )
  92. X              call ots$cvt_l_ti ( pbytlm, pbytlm_string )
  93. X           endif
  94. XC
  95. XC String at 15-16 is MAXDETACH
  96. XC
  97. X           if (cur_row.eq.15.and.cur_column.eq.16) then
  98. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  99. X     .         maxdetach )
  100. X              call ots$cvt_l_ti ( maxdetach, maxdetach_string )
  101. X           endif
  102. XC
  103. XC String at 15-35 is BIOLM
  104. XC
  105. X           if (cur_row.eq.15.and.cur_column.eq.35) then
  106. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  107. X     .         biolm )
  108. X              call ots$cvt_l_ti ( biolm, biolm_string )
  109. X           endif
  110. XC
  111. XC String at 15-56 is JTQUOTA
  112. XC
  113. X           if (cur_row.eq.15.and.cur_column.eq.56) then
  114. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  115. X     .         jtquota )
  116. X              call ots$cvt_l_ti ( jtquota, jtquota_string )
  117. X           endif
  118. XC
  119. XC String at 16-16 is PRCLM
  120. XC
  121. X           if (cur_row.eq.16.and.cur_column.eq.16) then
  122. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  123. X     .         prclm )
  124. X              call ots$cvt_l_ti ( prclm, prclm_string )
  125. X           endif
  126. XC
  127. XC String at 16-35 is DIOLM
  128. XC
  129. X           if (cur_row.eq.16.and.cur_column.eq.35) then
  130. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  131. X     .         diolm )
  132. X              call ots$cvt_l_ti ( diolm, diolm_string )
  133. X           endif
  134. XC
  135. XC String at 16-56 is WSDEF
  136. XC
  137. X           if (cur_row.eq.16.and.cur_column.eq.56) then
  138. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  139. X     .         wsdef )
  140. X              call ots$cvt_l_ti ( wsdef, wsdef_string )
  141. X           endif
  142. XC
  143. XC String at 17-16 is PRIO
  144. XC
  145. X           if (cur_row.eq.17.and.cur_column.eq.16) then
  146. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  147. X     .         prio )
  148. X              call ots$cvt_l_ti ( prio, prio_string )
  149. X           endif
  150. XC
  151. XC String at 17-35 is ASTLM
  152. XC
  153. X           if (cur_row.eq.17.and.cur_column.eq.35) then
  154. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  155. X     .         astlm )
  156. X              call ots$cvt_l_ti ( astlm, astlm_string )
  157. X           endif
  158. XC
  159. XC String at 17-56 is WSQUO
  160. XC
  161. X           if (cur_row.eq.17.and.cur_column.eq.56) then
  162. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  163. X     .         wsquo )
  164. X              call ots$cvt_l_ti ( wsquo, wsquo_string )
  165. X           endif
  166. XC
  167. XC String at 18-16 is QUEPRIO
  168. XC
  169. X           if (cur_row.eq.18.and.cur_column.eq.16) then
  170. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  171. X     .         queprio )
  172. X              call ots$cvt_l_ti ( queprio, queprio_string )
  173. X           endif
  174. XC
  175. XC String at 18-35 is TQELM
  176. XC
  177. X           if (cur_row.eq.18.and.cur_column.eq.35) then
  178. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  179. X     .         tqelm )
  180. X              call ots$cvt_l_ti ( tqelm, tqelm_string )
  181. X           endif
  182. XC
  183. XC String at 18-56 is WSEXTENT
  184. XC
  185. X           if (cur_row.eq.18.and.cur_column.eq.56) then
  186. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  187. X     .         wsextent )
  188. X              call ots$cvt_l_ti ( wsextent, wsextent_string )
  189. X           endif
  190. XC
  191. XC String at 19-12 is CPU
  192. XC
  193. X           if (cur_row.eq.19.and.cur_column.eq.12) then
  194. X              call reconvert_time ( dummy_string, 'cputime' )
  195. X              if (success) then
  196. X                 cpu_string = dummy_string
  197. X              else
  198. X                 call board ( owner, tables, defcli, defdev,
  199. X     .            defdir, lgicmd )
  200. X                 call smg$repaint_line ( pasteboard, cur_row )
  201. X                 call smg$set_cursor_abs ( main, cur_row, cur_column )
  202. X                 go to 10
  203. X              endif
  204. X           endif
  205. XC
  206. XC String at 19-35 is ENQLM
  207. XC
  208. X           if (cur_row.eq.19.and.cur_column.eq.35) then
  209. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  210. X     .         enqlm )
  211. X              call ots$cvt_l_ti ( enqlm, enqlm_string )
  212. X           endif
  213. XC
  214. XC String at 19-56 is PGFLQUO
  215. XC
  216. X           if (cur_row.eq.19.and.cur_column.eq.56) then
  217. X              call ots$cvt_ti_l ( dummy_string(1:dummy_string_length),
  218. X     .         pgflquo )
  219. X              call ots$cvt_l_ti ( pgflquo, pgflquo_string )
  220. X           endif
  221. XC
  222. XC Call the main board again
  223. XC
  224. X           call board ( owner, tables, defcli, defdev,
  225. X     .      defdir, lgicmd )
  226. X           call smg$repaint_line ( pasteboard, cur_row )
  227. X           call smg$set_cursor_abs ( main, cur_row, cur_column )
  228. X        endif
  229. X
  230. X        go to 10
  231. X
  232. X        end
  233. X
  234. XC************************************************************************
  235. X
  236. X        Subroutine RECONVERT_TIME ( asctime, string )
  237. XC
  238. XC The purpose of this subroutine is to convert the time string
  239. XC to binary time and back to ascii time so that the display will
  240. XC be correct. Another purpose of this subroutine is to create
  241. XC values to be set by $SETUAI when changes are to be saved.
  242. XC
  243. X        Include '($ssdef)'
  244. X        Include 'uaf.cmn'
  245. X        Include '($smgdef)'
  246. X        Integer*4 istat
  247. X        Integer*2 bintim(4)
  248. X        Character*2 dummy
  249. X        Character*(*) asctime, string
  250. XC
  251. XC Make the call to SYS$BINTIM to translate the ascii time.
  252. XC
  253. X        if (string(1:4).eq.'expr') then
  254. X`09   if (index(asctime,'NONE') .ne. 0) then
  255. X`09      call repeat (asctime, ' ')
  256. X`09      asctime = '0 00:00:00'
  257. X`09   endif
  258. X
  259. X           istat = sys$bintim ( asctime, expir )
  260. X
  261. X        elseif (string(1:4).eq.'pwdl') then
  262. X
  263. X`09   if (index(asctime,'NONE') .ne. 0) then
  264. X`09      call repeat (asctime, ' ')
  265. X`09      asctime = '0 00:00:00'
  266. X`09   endif
  267. X
  268. X           istat = sys$bintim ( asctime, pwd_life )
  269. X
  270. X        elseif (string(1:3).eq.'cpu') then
  271. X`09   if (index(asctime,'NONE') .ne. 0) then
  272. X`09      call repeat (asctime, ' ')
  273. X`09      asctime = '0 00:00:00'
  274. X`09   endif
  275. X           istat = sys$bintim ( asctime, bintim )
  276. X
  277. X        else
  278. X           istat = sys$bintim ( asctime, bintim )
  279. X        endif
  280. XC
  281. XC If in incorrect value is entered, display the error message and
  282. XC return to the calling program
  283. XC
  284. X        if (istat.gt.1) then
  285. X           call smg$flush_buffer ( pasteboard )
  286. X           call smg$erase_display ( error_message,,,,)
  287. X           if (string(1:4).eq.'expr') then
  288. X              call smg$put_chars ( error_message,
  289. X     .         'Invalid time: use format DD-MMM-YYYY  or NONE ', 1, 2 )
  290. X           else
  291. X              call smg$put_chars ( error_message,
  292. X     .         'Invalid time: use format 0 00:00:00.00 or NONE', 1, 2 )
  293. X           endif
  294. X           call smg$erase_chars ( error_message,49,2,2)
  295. X           call smg$put_chars ( error_message,
  296. X     .         '       (hit any key to continue)              ', 2, 2 )
  297. X           call smg$paste_virtual_display ( error_message,
  298. X     .      pasteboard, 10, 20 )
  299. X           call smg$read_keystroke ( keyboard, term )
  300. X           call smg$unpaste_virtual_display ( error_message,
  301. X     .      pasteboard )
  302. X           success = .false.
  303. X           return
  304. X        endif
  305. XC
  306. XC If the correct value was entered, translate to ascii time using
  307. XC SYS$ASCTIM.
  308. XC
  309. X        if (string(1:4).eq.'expr') then
  310. X           call sys$asctim ( , asctime, expir, 0 )
  311. X        elseif (string(1:4).eq.'pwdl') then
  312. X           call sys$asctim ( , asctime, pwd_life, 0 )
  313. X        else
  314. X           call sys$asctim ( , asctime, bintim, 0 )
  315. X        endif
  316. X        if (asctime(1:6).eq.'17-NOV') asctime = '    (none)'
  317. X        success = .true.
  318. XC
  319. XC If the time converted was cputime, set the new value for cputime
  320. XC to be used by $SETUAI
  321. XC
  322. X        if (string(1:3).eq.'cpu') then
  323. X           if (asctime.ne.'    (none)') then
  324. X              dummy = asctime(3:4)
  325. X              call ots$cvt_ti_l ( dummy, days )
  326. X              dummy = asctime(6:7)
  327. X              call ots$cvt_ti_l ( dummy, hours )
  328. X              dummy = asctime(9:10)
  329. X              call ots$cvt_ti_l ( dummy, minutes )
  330. X              dummy = asctime(12:13)
  331. X              call ots$cvt_ti_l ( dummy, seconds )
  332. X              cpu = (days*360000) *24
  333. X              cpu = cpu + (hours*360000)
  334. X              cpu = cpu + (minutes*6000)
  335. X              cpu = cpu + (seconds*100)
  336. X           endif
  337. X        endif
  338. X
  339. X        end
  340. X
  341. XC************************************************************************
  342. X
  343. X        Subroutine SHOW_ACCESS ( owner, tables, defcli, defdev,
  344. X     .   defdir, lgicmd )
  345. XC
  346. XC The purpose of this subroutine is to display the hourly access times
  347. XC for the user. The select key, or keypad period (.) key, toggles edit
  348. XC mode. The PF keys select an alternate screen. The arrow keys move the
  349. XC cursor through the various fields. The return key moves the cursor in
  350. XC a downward direction. The plus (+) key, or Insert Here key, allows
  351. XC complete access to a login type. A minus (-) key, or Remove key,
  352. XC removes access to the field. CtrlW repaints the screen. CtrlZ exits
  353. XC to the main screen.
  354. XC
  355. X        Include 'uaf.cmn'
  356. X        Include '($smgdef)'
  357. X        Integer*4 line, col
  358. X        Character*80 access_descr1, access_descr2
  359. X        Character*10 access_flag
  360. X        Character*(*) owner, tables, defcli, defdev, defdir, lgicmd
  361. X
  362. X        bogus_key = .true.
  363. X        line = 3
  364. X        access_descr1 =
  365. X     .'Primary   000000000011111111112222
  366. X     .  Secondary 000000000011111111112222'
  367. X        access_descr2 =
  368. X     .'Day Hours 012345678901234567890123
  369. X     .  Day Hours 012345678901234567890123'
  370. XC
  371. XC Put the descriptive strings to the display
  372. XC
  373. X        call smg$begin_pasteboard_update ( pasteboard )
  374. X        call smg$erase_display ( message )
  375. X        call smg$put_chars ( access_board, ' Access Restrictions: ',
  376. X     .   1, 29 ,, smg$m_bold )
  377. X
  378. X        call smg$put_chars ( access_board, access_descr1, line, 1 )
  379. X        call smg$put_chars ( access_board, access_descr2, line+1, 1 )
  380. X
  381. X        call smg$put_chars ( access_board, '(#) = access is allowed
  382. X     .   (-) = access is not allowed', 13, 1 )
  383. X
  384. X        line = 5
  385. XC
  386. XC Find out access times (using the subroutine FIND_ACCESS) and put them
  387. XC to the display
  388. XC
  389. X        access_flag = 'Network:'
  390. X        call find_access ( access_flag, line, network_p, network_s )
  391. X        line = line + 1
  392. X        access_flag = 'Batch:'
  393. X        call find_access ( access_flag, line, batch_p, batch_s )
  394. X        line = line + 1
  395. X        access_flag = 'Local:'
  396. X        call find_access ( access_flag, line, local_p, local_s )
  397. X        line = line + 1
  398. X        access_flag = 'Dialup:'
  399. X        call find_access ( access_flag, line, dialup_p, dialup_s )
  400. X        line = line + 1
  401. X        access_flag = 'Remote:'
  402. X        call find_access ( access_flag, line, remote_p, remote_s )
  403. XC
  404. XC Reset the values for line and column.
  405. XC
  406. X        line = 5
  407. X        col = 11
  408. XC
  409. XC Paste the finished display to the board
  410. XC
  411. X        call smg$put_chars ( message,
  412. X     .   'Use arrow keys to move to desired field and position.', 1, 2 )
  413. X        call smg$put_chars ( message,
  414. X     .   'Hit SELECT or PERIOD to enter change mode.', 2, 2 )
  415. X        call smg$put_chars ( message,
  416. X     .   '(+) to allow all access, (-) to disallow all access.',
  417. X     .   3, 2 )
  418. +-+-+-+-+-+-+-+-  END  OF PART 7 +-+-+-+-+-+-+-+-
  419. -- 
  420. \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  421. < Joe Koffley                        KOFFLEY@NRLVAX.NRL.NAVY.MIL             >
  422. < Naval Research Laboratory          KOFFLEY@CCF.NRL.NAVY.MIL                >
  423. < Space Systems Division             AT&T  :  202-767-0894                   >
  424. \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  425.