sub read_dirs( string dir_loc, string new_dir( ) ) ! Written by Michael W. Wheeler (mww@tntech.bitnet) ! VAX Basic V3.1 ! Copyright (c) by Michael W. Wheeler, September 1987 ! This program is intended for Public Domain, and may not be sold or ! marketed in any form without the permision and written consent ! from the author Michael W. Wheeler. I retain all copyrights to ! this program, in either the original or modified forms, and no ! violation, deletion, or change of the copyright notice is ! allowed. Futhermore, I will have no liability or responsibilty ! to any user with respect to loss or damage caused directly or ! indirectly by this program. ! Labels ! none. ! Constants %include "$rmsdef" %from %library "sys$library:basic$starlet.tlb" external long constant msg_nodir declare long constant maxdirs = 2000% ! Types ! none. ! Variables declare long return_status, context, top_level declare word dir_count, r_braket declare string dir_file, dir_spec common (flags) byte dir, prompt, help, log_qual common (io_w) word chan, max_dir, cursor_len, start_row, start_col ! Procedures ! none. ! Functions external long function lib$find_file r_braket = instr(1%, dir_loc, "]") if r_braket = 0% then dir_spec = "*.dir" else dir_spec = mid(dir_loc, 1%, r_braket) + "*.dir" end if dir_count = 0 return_status = rms$_normal while ( (return_status = rms$_normal) and (dir_count < maxdirs) ) return_status = lib$find_file( dir_spec, dir_file, context ) if instr(0%, new_dir(dir_count), "[000000]") then ! Don't display this directory since setting your default to it ! leaves you in the same place. dir_count = dir_count - 1% end if dir_count = dir_count + 1 dir_file = mid(dir_file, 0%, instr(0%, dir_file, ";") - 5%) + "]" mid(dir_file, instr(0%, dir_file, "]"), 1%) = "." ! Strip off leading zeros if at the top most level of the disk directory. top_level = instr(0%, dir_file, "[000000.") if top_level then dir_file = mid(dir_file, 1%, top_level) + mid(dir_file, top_level + 8%, len(dir_file)) end if new_dir(dir_count) = dir_file next ! Set global to the number of directories read. max_dir = dir_count - 1% if max_dir = 0% and dir = FALSE then call lib$signal( msg_nodir by value ) call sys$exit( 1% by value ) end if subend