From:	SMTP%"RELAY-INFO-VAX@CRVAX.SRI.COM"  1-JUN-1993 18:22:25.18
To:	EVERHART
CC:	
Subj:	Re: Some more VAX Fortran questions...

Date: Tue, 01 Jun 1993 20:02:37 +0100
From: Arne Vajhøj <ARNE@kopc.hhs.dk>
Subject: Re: Some more VAX Fortran questions...
To: 9118187@UL.IE, INFO-VAX@SRI.COM
Message-id: <01GYVJYW7D429GV9RX@kopc.hhs.dk>
X-VMS-To: KOPC::IN%"9118187@UL.IE"
X-VMS-Cc: IN::"INFO-VAX@SRI.COM"
MIME-version: 1.0
Content-type: TEXT/PLAIN; CHARSET=ISO-8859-1
Content-transfer-encoding: 8BIT

> A special thanks to all those who replied to my last posting concerning
> Fortran login problems. I have a few more VAX Fortran questions though;
> 
> 1. What is the VAX Fortran equivalent for SHOW QUOTA?
> 2. How can I get a return value from SYS$GETUAI which gives all the information
>    about a specific user eg. real life identity, login time, etc...?
> 3. How do you read a text data file which doesn't have apostrophies(') at the
>    beginning and end of each line?

I think you will find the following small FORTRAN program interesting:

      PROGRAM Z
      INTEGER*4 USAGE,PERM,OVER
      INTEGER*2 LOWN,SL
      CHARACTER*80 OWN,S
      CALL SHOW_QUOTA(USAGE,PERM,OVER)
      WRITE(*,*) 'USAGE=',USAGE,',PERM=',PERM,',OVER=',OVER
      CALL GET_OWNER(OWN,LOWN)
      WRITE(*,*) 'I AM ',OWN(1:LOWN)
      WRITE(*,'(1X,A,$)') 'ENTER LINE: '
      READ(*,'(Q,A)') SL,S
      WRITE(*,*) '>>',S(1:SL),'<<'
      END
C
      SUBROUTINE SHOW_QUOTA(USAGE,PERM,OVER)
      INTEGER*4 USAGE,PERM,OVER
      INCLUDE '($JPIDEF)'
      INCLUDE '($IODEF)'
      INCLUDE '($FIBDEF)'
      STRUCTURE /MYFIB/
        UNION
          MAP
            RECORD /FIBDEF/FULL
          ENDMAP
          MAP
            RECORD /FIBDEF1/BRIEF
          ENDMAP
        ENDUNION
      ENDSTRUCTURE
      INTEGER*4 STAT,UIC,IOSB(2),QUOBLCK(8)
      INTEGER*2 CHAN,DUMMY
      RECORD /MYFIB/FIBBLCK
      INTEGER*4 QDESC(2)
      INTEGER*4 FIBDESC(2)
      INTEGER*4 LIB$GETJPI,SYS$ASSIGN,SYS$QIOW,SYS$IDTOASC,SYS$DASSGN
      STAT=LIB$GETJPI(JPI$_UIC,,,UIC,,)
      QDESC(1)=32
      QDESC(2)=%LOC(QUOBLCK)
      FIBDESC(1)=FIB$C_LENGTH
      FIBDESC(2)=%LOC(FIBBLCK)
      STAT=SYS$ASSIGN('SYS$DISK',CHAN,,)
      FIBBLCK.BRIEF.FIB$W_CNTRLFUNC=FIB$C_EXA_QUOTA
      QUOBLCK(2)=UIC
      STAT=SYS$QIOW(,%VAL(CHAN),%VAL(IO$_ACPCONTROL),IOSB,,,
     +              FIBDESC,QDESC,DUMMY,QDESC,,)

      STAT=SYS$DASSGN(%VAL(CHAN))
      USAGE=QUOBLCK(3)
      PERM=QUOBLCK(4)
      OVER=QUOBLCK(5)
      RETURN
      END
C
      SUBROUTINE GET_OWNER(OWN,LOWN)
      CHARACTER*(*) OWN
      INTEGER*2 LOWN
      INCLUDE '($JPIDEF)'
      INCLUDE '($UAIDEF)'
      STRUCTURE /ITEMLIST/
        INTEGER*2 BUFLEN,CODE
        INTEGER*4 BUFADR,RETLENADR
      ENDSTRUCTURE
      INTEGER*4 STAT
      INTEGER*2 UNL,SL
      CHARACTER*12 UN
      CHARACTER*32 S
      RECORD /ITEMLIST/UAILIST(2)
      INTEGER*4 LIB$GETJPI,SYS$GETUAI
      STAT=LIB$GETJPI(JPI$_USERNAME,,,,UN,UNL)
      UNL=INDEX(UN,' ')
      IF(UNL.EQ.0) UNL=12
      UAILIST(1).BUFLEN=LEN(S)
      UAILIST(1).CODE=UAI$_OWNER
      UAILIST(1).BUFADR=%LOC(S)
      UAILIST(1).RETLENADR=%LOC(SL)
      UAILIST(2).BUFLEN=0
      UAILIST(2).CODE=0
      UAILIST(2).BUFADR=0
      UAILIST(2).RETLENADR=0
      STAT=SYS$GETUAI(,,UN(1:UNL),UAILIST,,,)
      LOWN=SL-1
      OWN(1:LOWN)=S(2:SL)
      RETURN
      END

Hope it helps !

                                                          Arne

Arne Vajhøj                             local DECNET:  KO::ARNE
Computer Department                     PSI:           PSI%238310013040::ARNE
Business School of Southern Denmark     Internet:      ARNE@KO.HHS.DK


