C-------------------------------------------------------------------C C GetLd: Get all the file information into the Common array 'LD' C C RealN - The real name of the "THIS" directory C C ErExit - Set to one if I couldn't open 'REALN' C C-------------------------------------------------------------------C Subroutine GetLd(RealN, ErExit) Implicit Integer*4 (A - Z) Character*17 Strg Character*1 C Character*5 file_size Character*9 UicHold Character*3 Hold3 Character*21 St21 Character*128 RealN Character*56 file_info integer name_size, first_blank, i !RTG external str$match_wild, str$_nomatch !RTG integer*4 str$match_wild, str$_nomatch, nomatch_value, STAT !RTG Include 'common.include' C WILDCARD IS A 20 CHAR STRING FROM THE /WILD/ COMMON BLOCK C-------------------------------------------------------------------C name_size = 78 NumFiles = 0 NumDirs = 0 ErExit = 0 Open(Unit=1, File=RealN, Status='OLD', READONLY,ERR=40) Goto 50 40 Print *, epage,'Cannot open directory file: ',RealN Print *, ' ****Type any key to continue****' Pur = 1 ! Purge type ahead buffer when return to main too Call Get1Char(C, 1) ErExit = 1 ! Tell caller I had trouble Goto 1100 ! Early exit 50 Continue Call Mess('Reading Directory '//RealN(1:78)) Ld(1)(1:40) = + ' ' Ld(1)(41:80)= + ' ' Do I = 2, 8 Ld(I) = Ld(1) End Do Ld(1)(1:26) = ' This Directory: ' Ld(3)(1:32) = ' Directories: Total of ' Ld(5)(1:32) = ' Files: Total of ' Ld(1)(80:80) = Char(0) Gx = Lib$Matchc('[000000.000000', Dname) If (Gx .NE. 0) then Dname(1:8) = '[000000]' Do I = 9, 80 Dname(I:I) = ' ' End Do End If DisName(1 : 10) = 'Directory ' Do I = 11, 80 DisName(I:I) = DName(I-10:I-10) End Do Do I = 27, 80 Ld(1)(I:I) = DName(I-26:I-26) End Do FirstUsed = 0 ! Index of 1st element used (0, 5, or 7) NextDir = 4 FileLine = 5 LastLine = 5 Total_Blks = 0 nomatch_value = %loc( str$_nomatch) first_blank = lib$matchc (' ', wildcard) do 10 i = 1, first_blank if (wildcard(i:i) .ge. 'a') then wildcard(i:i) = - char( ichar( wildcard(i:i)) - ichar( ' ')) end if 10 continue call writel (' ', 20,1) C C UNTIL MATCH BETWEEN WILDCARD AND FILE NAME C 100 Read(1,200,End=900,Err=40)RecSize,Size,BigRec(1:RecSize-4) 200 Format(Q, 3X, A1, A) ! Read Variable sized rec from dir file STAT = STR$MATCH_WILD( BIGREC(1:size), WILDCARD(1:first_blank-1)) c print *, stat, ' ', bigrec(1:size), c - '+++',wildcard(1:first_blank-1), '==' c print *, nomatch_value, ' no match' c call get1char(cmd) IF (STAT .EQ. nomatch_value) GOTO 100 C C END UNTIL WILDCARD MATCH C NHold(1:40) = ' ' NHold(41:80) = ' ' NHold(1 : Size) = BigRec(1 : Size) Semi = Size + 1 NHold(Semi : Semi) = ';' ! Put in semicolon T = Size + 1 ! Point to 1st version number T = (T/2)*2 + 1 ! Ensure it is an odd number 300 Continue ! Encode version number into string Temp = IChar(BigRec(T:T)) + 256 * IChar(BigRec(T+1:T+1)) Encode (6, 400, NHold( size + 2 : size + 6)) Temp 400 Format(I6) c print *, size, " == " , temp c call get1char (cmd) 500 I = Lib$Matchc('; ',NHold) ! Take out the blanks If (I .NE. 0) then Do J = I + 1, 79 NHold(J:J) = NHold(J+1:J+1) End Do End If If (I .NE. 0) Goto 500 C-----------------------------------------------------------------C C Got the name in 'NHold' - now put it in the Ld array C C-----------------------------------------------------------------C LdHold = NHold ! Save Nhold for ! passing to make_file_prot_string LastLine = LastLine + 1 ! Bump lastline If (LastLine .GT. 1000) Goto 900 ! Exit--array is full Do I = name_size,1,-1 ! Scoot the name over 5 chars. 25 changed to 78 LdHold(I + 5 : I + 5) = LdHold(I:I) !RTG 4/10/85 End Do LdHold(1:5) = ' ' ! Make the 1st 5 chars blank C----------------------------------------------------------------- C for displaying all the info C----------------------------------------------------------------- If (Fast .EQ. 0) then call make_file_prot_string ( file_info ) End If !FAST = 0 I = Lib$Matchc('.DIR',LdHold) If (I .EQ. 0) then ! Was it a dir? ldattributes(lastline) = file_info ! RTG Ld(LastLine) = LdHold ! No-Put it last If (FirstUsed .EQ. 0) FirstUsed = Lastline NumFiles = NumFiles + 1 Else Do I = LastLine,NextDir+1,-1 ! Yes it was a DIRECTORY ldattributes(i) = ldattributes(i - 1) Ld(I) = Ld(I - 1) ! Scoot array down End Do Ld(NextDir) = LdHold ! Put it with the dirs ldattributes(nextdir) = file_info If ((FirstUsed .EQ. 0) .OR. (NextDir .LT. FirstUsed)) then FirstUsed = NextDir End IF NextDir = NextDir + 1 NumDirs = NumDirs + 1 FileLine = FileLine + 1 End If T = T + 8 ! Version #'s are 8 apart If (T .LT. RecSize - 4) goto 300 !Done all versions? Goto 100 ! YES-get next record C-------------------------------------------------------------------C C Array Ld has all the names of files and directories. C C-------------------------------------------------------------------C 900 Continue Close(1) ! Close the directory file Do I = LastLine + 1, LastLine + 25 Ld(I)(1:40) = ' ' Ld(I)(41:80) = ' ' End Do 1100 Continue c Call Writel(Dull, 80, 35) Encode (6, 400, Ld(3)(33 : 33 + 6)) NumDirs Encode (6, 400, Ld(FileLine)(33 : 33 + 6)) NumFiles If (FirstUsed .EQ. 0) FirstUsed = 7 !dir empty-point at spaces Do I = 1, IncluCount ! start main loop to copy file Ld(IncluLines(I))(2:2) = '*' ! Put asterik where it belongs. End Do Return End