Piper's Pit BBS/FTP: ibm 0020 - 0029/ibm0020-0029/ibm0028.tar/ibm0028/SBTAR4.ZIP/ARPASS.PRG

Text File | 1990-06-04 | 11.5 KB | 368 lines

********************** ' MultiNet Source Code ' ***********************
** '                       SBT Corporation                         ' **
** '         One Harbor Drive, Sausalito, California 94965         ' **
** '                   Telephone [phone]                    ' **
***********************************************************************
** '   (c) Copyright 1984, Revisions 1985 - 1990 SBT Corporation   ' **
** '            All Rights Reserved by SBT Corporation             ' **
** '                                                               ' **
***********************************************************************
** ' 06/04/90 = Last Update  **  ARPASS.PRG  **    Version 6.35.00 ' **
***********************************************************************
* ' Password File Maintenance - called by ARSYST
*
CLOSE DATABASES
SELECT a
STORE .f. TO mdel
IF .NOT. FILE('&m0passf..ndx')
  USE &m0passf
  INDEX ON password TO &m0passf..ndx
  STORE .t. TO mdel
ELSE
  USE &m0passf INDEX &m0passf..ndx
ENDIF
STORE .t. TO merase
DO WHILE .t.
  IF merase
    CLEAR
    @ 1,1 SAY DTOC(m0date)
    @ 1,40 - INT(LEN(m0system)/2) SAY m0system
    @ 1,73 SAY SUBSTR(m0company,79,6)
    @ 2,1 SAY SUBSTR(m0company,1,78)
    @ 3,28 SAY 'Password File Maintenance'
    STORE .f. TO merase
  ENDIF
  STORE .f. TO m0new
  STORE SPACE(10) TO mpass
  @ 6,0
  @ 6,1 SAY 'Enter Password, "?" to List, or <Enter> to Quit ' + ;
  SUBSTR(m0border,179,7) GET mpass PICTURE '!!!!!!!!!!'
  READ
  CLEAR GETS
  IF SUBSTR(mpass,1,1) = ' '
    @ 7,0 CLEAR
    STORE 'Y' TO mans
    @ 8,1 SAY 'Finished ? (Y/N) ' + SUBSTR(m0border,179,7) ;
    GET mans PICTURE 'Y'
    READ
    IF mans = 'N'
      @ 8,0
      LOOP
    ENDIF
    USE
    IF mdel
      DELETE FILE &m0passf..ndx
    ENDIF
    CLEAR
    @ 9,14 SAY '*****  Returning to Setup Information Menu  *****'
    RETURN
  ENDIF
  SET EXACT ON
  SEEK mpass
  SET EXACT OFF
  IF EOF()
    STORE 'Password' TO mtitle
    STORE 'Password ' TO mheading
    STORE TRIM(mpass) TO m0key
    STORE 'password' TO m0field
    STORE 'ARPASS' TO m0file
    * ' Call procedure to list on screen
    DO syslist WITH m0field, m0key, m0file, 4
    SEEK mpass
    IF .NOT. m0new .AND. EOF()
      STORE .f. TO merase
      LOOP
    ENDIF
    @ 4,0 CLEAR
  ENDIF && EOF()
  STORE SPACE(10) TO mxpass
  CLEAR
  STORE SUBSTR(m0border,7,1) TO medge
  @ 1,0 SAY SUBSTR(m0border,1,1) + SUBSTR(m0border,10,24)  + ;
  '  Password File Maintenance  ' + SUBSTR(m0border,10,24) + ;
  SUBSTR(m0border,3,1)
  @ 2,0 SAY medge
  @ 2,78 SAY medge
  @ 3,0 SAY medge + '  Password  ' + SUBSTR(m0border,181, 5)
  @ 3,78 SAY medge
  @ 4,0 SAY medge
  @ 4,78 SAY medge
  @ 5,0 SAY medge + '  This password allows access to the following:'
  @ 5,78 SAY medge
  @ 6,0 SAY medge
  @ 6,78 SAY medge
  @ 7,0 SAY medge + '  Enter Invoices                             ' + ;
  SUBSTR(m0border,182,4)
  @ 7,62 SAY '(Y/N)'
  @ 7,78 SAY medge
  @ 8,0 SAY medge + '  Enter Cash Receipts & Credit Memos         ' + ;
  SUBSTR(m0border,182,4)
  @ 8,78 SAY medge
  @ 9,0 SAY medge + '  Cancel Invoices/Credit Memos               ' + ;
  SUBSTR(m0border,182,4)
  @ 9,78 SAY medge
  @ 10,0 SAY medge + '  Access File Maintenance Menu               ' + ;
  SUBSTR(m0border,182,4)
  @ 10,78 SAY medge
  @ 11,0 SAY medge + '  Compute Finance Charges                    ' + ;
  SUBSTR(m0border,182,4)
  @ 11,78 SAY medge
  @ 12,0 SAY medge + '  Print and Display Reports                  ' + ;
  SUBSTR(m0border,182,4)
  @ 12,78 SAY medge
  @ 13,0 SAY medge + '  Print Labels                               ' + ;
  SUBSTR(m0border,182,4)
  @ 13,78 SAY medge
  @ 14,0 SAY medge + '  Print Invoices and Statements              ' + ;
  SUBSTR(m0border,182,4)
  @ 14,78 SAY medge
  @ 15,0 SAY medge + '  Close Period & Process Recurring Billings  ' + ;
  SUBSTR(m0border,182,4)
  @ 15,78 SAY medge
  @ 16,0 SAY medge + '  Change Setup/Reindex/Business Status       ' + ;
  SUBSTR(m0border,182,4)
  @ 16,78 SAY medge
  @ 17,0 SAY medge + '  Maintain Passwords & Delete Company        ' + ;
  SUBSTR(m0border,182,4)
  @ 17,78 SAY medge
  IF SUBSTR(m0link,1,1) = 'Y'
    @ 18,0 SAY medge + '  Release Information to General Ledger      ' + ;
    SUBSTR(m0border,182,4)
  ELSE
    @ 18,0 SAY medge
  ENDIF
  @ 18,78 SAY medge
  @ 19,0 SAY medge
  @ 19,78 SAY medge
  @ 20,0 SAY SUBSTR(m0border,4,1) + SUBSTR(m0border,10,77) + ;
  SUBSTR(m0border,6,1)
  STORE ' ' TO mans
  DO WHILE .t.
    SET ESCAPE ON
    IF m0new
      IF mans = ' '
        STORE 'N' TO maccess1, maccess2, maccess3, maccess4, maccess5, ;
        maccess6, maccess7, maccess8, maccess9, maccess10, maccess11, ;
        maccess12
      ENDIF
    ELSE
      IF EOF() .OR. BOF()
        ?? CHR(7)
        STORE ' ' TO mans
        IF EOF()
          @ 22,2 SAY 'End of File.  Press any key to continue...' GET mans
          GO BOTTOM
        ELSE
          @ 22,2 SAY 'Top of File.  Press any key to continue...' GET mans
          GO TOP
        ENDIF
        READ
        @ 22,0
      ENDIF
      IF mans <> 'E'
        STORE a->password TO mpass, mxpass
        STORE a->access1 TO maccess1
        STORE a->access2 TO maccess2
        STORE a->access3 TO maccess3
        STORE a->access4 TO maccess4
        STORE a->access5 TO maccess5
        STORE a->access6 TO maccess6
        STORE a->access7 TO maccess7
        STORE a->access8 TO maccess8
        STORE a->access9 TO maccess9
        STORE a->access10 TO maccess10
        STORE a->access11 TO maccess11
        STORE a->access12 TO maccess12
        STORE access1 + access2 + access3 + access4 + access5 + access6 + ;
        access7 + access8 + access9 + access10 + access11 + access12 + ;
        access13 + access14 + access15 TO maccess0
      ENDIF && mans <> 'E'
    ENDIF && m0new
    IF (SUBSTR(m0pass,1,10) = mxpass .AND. mans = 'E') .OR. m0new
      @ 3,20 SAY mpass PICTURE '!!!!!!!!!!'
    ELSE
      @ 3,20 GET mpass PICTURE '!!!!!!!!!!'
    ENDIF
    @ 7,55 GET maccess1 PICTURE 'Y'
    @ 8,55 GET maccess2 PICTURE 'Y'
    @ 9,55 GET maccess3 PICTURE 'Y'
    @ 10,55 GET maccess4 PICTURE 'Y'
    @ 11,55 GET maccess5 PICTURE 'Y'
    @ 12,55 GET maccess6 PICTURE 'Y'
    @ 13,55 GET maccess7 PICTURE 'Y'
    @ 14,55 GET maccess8 PICTURE 'Y'
    @ 15,55 GET maccess9 PICTURE 'Y'
    @ 16,55 GET maccess10 PICTURE 'Y'
    IF SUBSTR(m0pass,1,10) = mxpass .AND. (m0new .OR. mans = 'E')
      @ 17,55 SAY maccess11 PICTURE 'Y'
    ELSE
      @ 17,55 GET maccess11 PICTURE 'Y'
    ENDIF
    IF SUBSTR(m0link,1,1) = 'Y'
      @ 18,55 GET maccess12 PICTURE 'Y'
    ENDIF
    IF m0new .OR. mans = 'E'
      READ
    ENDIF
    CLEAR GETS
    DO CASE
      CASE DELETED() .AND. .NOT. m0new
        STORE 'R' TO mans
        ?? CHR(7)
        @ 21,3 SAY '***  Password Deleted  ***'
        STORE 'Enter Choice (Recall/Fwd/Back/Quit) ' TO msg
        STORE 'RFBQ' TO moptns
      CASE mans = 'E' .OR. m0new
        STORE 'S' TO mans
        IF m0new
          STORE 'Save New Password ? (Save/Edit again/Cancel) ' TO msg
        ELSE
          STORE 'Save Changes to this Password ? (Save/Edit again/Cancel) ' ;
          TO msg
        ENDIF
        STORE 'SEC' TO moptns
      CASE SUBSTR(m0pass,1,10) = mxpass
        STORE 'E' TO mans
        STORE 'Enter Choice (Edit/Fwd/Back/Quit) ' TO msg
        STORE 'EFBQ' TO moptns
      OTHERWISE
        STORE 'E' TO mans
        STORE 'Enter Choice (Edit/Delete/Fwd/Back/Quit) ' TO msg
        STORE 'EDFBQ' TO moptns
    ENDCASE
    @ 22,3 SAY msg + SUBSTR(m0border,179,7) GET mans PICTURE '!'
    READ SAVE
    DO WHILE .NOT. mans $ moptns
      ?? CHR(7)
      READ SAVE
    ENDDO
    @ 21,0 CLEAR
    CLEAR GETS
    DO CASE
      CASE mans = 'E'
        LOOP
      CASE mans = 'F'
        IF .NOT. EOF()
          SKIP
        ENDIF
        LOOP
      CASE mans = 'B'
        IF .NOT. BOF()
          SKIP -1
        ENDIF
        LOOP
      CASE mans = 'R'
        DO p0rlockd
        IF .NOT. lockedr
          LOOP
        ENDIF
        RECALL
        UNLOCK
        LOOP
      CASE mans $ 'QC'
        EXIT
      CASE mans = 'S'
        SET ESCAPE OFF
        IF m0new
          DO p0flockd
          IF .NOT. lockedf
            LOOP
          ENDIF
          APPEND BLANK
        ELSE
          DO p0flockd
          IF .NOT. lockedf
            LOOP
          ENDIF
          SEEK mpass
          DO WHILE mpass <> mxpass .AND. .NOT. EOF()
            UNLOCK
            ?? CHR(7)
            @ 22,3 SAY 'Password is already in use.  Please reenter ' + ;
            'or blank to cancel...'
            @ 3,20 GET mpass PICTURE '!!!!!!!!!!'
            READ
            @ 22,0
            DO p0flockd
            IF mpass = SPACE(10) .OR. .NOT. lockedf
              STORE SPACE(10) TO mpass
              EXIT
            ENDIF
            SEEK mpass
          ENDDO
          IF mpass = SPACE(10)
            UNLOCK
            LOOP
          ENDIF
          SEEK mxpass
          IF access1 + access2 + access3 + access4 + access5 + access6 + ;
            access7 + access8 + access9 + access10 + access11 + access12 + ;
            access13 + access14 + access15 <> maccess0 .OR. DELETED()
            UNLOCK
            STORE ' ' TO ans
            @ 22,3 SAY 'Password has been changed by another user. ' + ;
            'Unable to update. Press any key...' GET ans
            READ
            LOOP
          ENDIF
        ENDIF
        @ 22,3 SAY '*****  Updating Password File  *****'
        REPLACE password WITH mpass, access1 WITH maccess1, access2 WITH ;
        maccess2, access3 WITH maccess3, access4 WITH maccess4, access5 ;
        WITH maccess5, access6 WITH maccess6, access7 WITH maccess7
        REPLACE access8 WITH maccess8, access9 WITH maccess9, access10 ;
        WITH maccess10, access11 WITH maccess11, access12 WITH maccess12
        IF SUBSTR(m0pass,1,10) = mpass
          STORE password + access1 + access2 + access3 + access4 + access5 + ;
          access6 + access7 + access8 + access9 + access10 + access11 + ;
          access12 + access13 + access14 + access15 TO m0pass
        ENDIF
        UNLOCK
        SET ESCAPE ON
        @ 21,0
        IF m0new
          STORE .f. TO m0new
          EXIT
        ENDIF
      CASE mans = 'D'
        ?? CHR(7)
        STORE 'N' TO mans
        @ 22,3 SAY 'Delete this Password ? (Y/N) ' + ;
        SUBSTR(m0border,179,7) GET mans PICTURE 'Y'
        READ
        @ 22,0
        IF mans = 'Y'
          DO p0rlockd
          IF .NOT. lockedr
            LOOP
          ENDIF
          IF access1 + access2 + access3 + access4 + access5 + access6 + ;
            access7 + access8 + access9 + access10 + access11 + access12 + ;
            access13 + access14 + access15 <> maccess0 .OR. DELETED()
            UNLOCK
            STORE ' ' TO ans
            @ 22,3 SAY 'Password has been changed by another user. ' + ;
            'Unable to delete. Press any key...' GET ans
            READ
            LOOP
          ENDIF
          DELETE
          UNLOCK
          @ 22,3 SAY '*****  Delete Completed  *****'
        ELSE
          @ 22,3 SAY '*****  Delete Cancelled  *****'
        ENDIF
        @ 21,0 CLEAR
    ENDCASE
  ENDDO && WHILE .t.
  STORE .t. TO merase
ENDDO && WHILE .t.
RETURN
*
* ' $Revision:   1.10  $
* ' $Date:   25 May 1990 16:22:56  $
**********************
** '  ARPASS.PRG  ' **
** '  367 Lines   ' **
**********************