home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / CDOR0811.ZIP / SOURCE.ZIP / ALIAS.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-07-05  |  8.0 KB  |  190 lines
  1. ' $linesize:132
  2. ' $segment
  3. ' $title: 'Alias sub for Maple street version of RBBS'
  4. ' $INCLUDE: 'RBBS-VAR.BAS'
  5. '
  6. ' $SUBTITLE: 'AliasChk - Checks whether ALIAS exists'
  7. ' $PAGE
  8. '
  9. '  SUBROUTINE NAME    -- AliasChk
  10. '
  11. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  12. '                         WhoFind$                    ALIAS to find
  13. '
  14. '  OUTPUT PARAMETERS  --  WhoFound                    Whether ALIAS found
  15. '                         UserNumFound                Record # of User
  16. '
  17. '  SUBROUTINE PURPOSE --  Validate that ALIAS exists.  Get User Record
  18. '
  19. 2257 SUB AliasChk (WhoFind$,WhoFound,UserNumFound) STATIC         'Mpl-ALias
  20.      If WhoFound = Ztrue Then Exit Sub                            'Mpl-Alias2
  21.      CALL BreakFileName (ZMainUserFile$,Drive$,Prefix$,Ext$,ZTrue)    '
  22.      DgsTemp = INSTR(ZConfName$,SPACE$(1))                           ' DD021301
  23.      IF DgsTemp > 0 THEN _                                            '
  24.       DgsFileName$ = Drive$ + LEFT$(ZConfName$,DgsTemp-1) + "A.DEF" _ '
  25.      ELSE DgsFileName$ = Drive$ + ZConfName$ + "A.DEF"                '
  26.      CALL FindIt (DgsFileName$)                                       '
  27.      IF NOT ZOK THEN _                                                '
  28.         EXIT SUB                                                      '
  29. Call OpenWork (7,DgsFileName$)
  30.      WhoFound=ZFalse                       'Mpl-Alias2
  31.      DgsAlias$ = ""                                                   '
  32.      WHILE DgsAlias$ = "" AND NOT EOF(7)                              '
  33.         INPUT #7, DgsUserName$, DgsTempAlias$                         '
  34.         IF Instr(DgsTempAlias$,WhoFind$) > 0 THEN                  'Mpl-Alis2
  35.           ZSubParm = 1
  36.           ZOutTxt$ = "Send to "+ DgsTempAlias$ + ZYesPrompt$         ' DD091301
  37.           Call Tget                            
  38.            If ZSubParm = -1 Then _
  39.               Exit Sub
  40.            If ZWasQ=0 Then ZYes = ZTrue
  41.                If Zyes Then 
  42.                   WhoFound = ZTrue                     'Pe 04/04/92
  43.                   WhoFind$ = DgsTempAlias$
  44.                   DgsAlias$ = DgsUserName$ 
  45.                End If
  46.           END IF                                                       '
  47.      WEND                                                              '
  48.      CLOSE 7                                                           '
  49.    END SUB                                                             '
  50. 59750' $SUBTITLE: 'AliasDgs - Subroutine to Create/Update Alias Info file'
  51. ' $PAGE
  52. '
  53. '  SUBROUTINE NAME    -- DgsAlias
  54. '
  55. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  56. '                         ZConfName$                  CONFERENCE NAME
  57. '                         ZOrigUserNameDgs$           USERS - LOG ON NAME
  58. '                         DgsAlias$                   USERS - ALIAS NAME
  59. '                         DgsStl$                     NULL FIRST TIME IN
  60. '                                                     'STILL' IF ALIAS EXISTS
  61. '                                                        OR REAL NAME
  62. '                         DgsFileName$                CONFERENCE ALIAS FILE
  63. '
  64. '  OUTPUT PARAMETERS  --  ZConfName$ ZOrigUserNameDgs$ DgsAlias$ DgsStl$
  65. '                         DgsFileName$
  66. '
  67. '  SUBROUTINE PURPOSE --  TO Read ConfA.DEF and Get Users ALIAS or
  68. '                         Create One
  69. '
  70.      SUB AliasDgs (ZConfName$,ZOrigUserNameDgs$,DgsAlias$,DgsStl$,DgsFileName$) STATIC
  71. '
  72.      IF DgsStl$ = "" THEN
  73.         ConfADefFlag = 0
  74.         CALL BreakFileName (ZMainUserFile$,Drive$,Prefix$,Ext$,ZTrue)
  75.         DgsFileName$ = Drive$ + ZConfName$ + "A.DEF"
  76.         CALL FindIt (DgsFileName$)
  77.         IF ZOK THEN
  78.            ConfADefFlag = ZTrue
  79.         END IF
  80.         IF ConfADefFlag = ZTrue THEN
  81.          Call OpenWork (7,DgsFileName$)
  82.            DgsAlias$ = ""
  83.            WHILE DgsAlias$ = "" AND NOT EOF(7)
  84.               INPUT #7, DgsUserName$, DgsTempAlias$
  85.               DgsUnl = LEN(DgsUserName$)
  86.               IF DgsUserName$ = LEFT$(ZOrigUserNameDgs$,DgsUnl) THEN
  87.                  DgsAlias$ = DgsTempAlias$
  88.               END IF
  89.            WEND
  90.            CLOSE 7
  91.         ELSE
  92.            DgsAlias$ = "NO CONFA.DEF"
  93.            EXIT SUB
  94.         END IF
  95.      END IF
  96.      CALL GoodAls (ZConfName$,ZOrigUserNameDgs$,DgsAlias$,DgsStl$,DgsFileName$)
  97.      END SUB
  98. '
  99. '
  100. ' $SUBTITLE: 'GoodAls - Subroutine to Make Sure Alias Good'
  101. ' $PAGE
  102. '
  103. '  SUBROUTINE NAME    -- GoodAls
  104. '
  105. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  106. '                         ZConfName$                  CONFERENCE NAME
  107. '                         ZOrigUserNameDgs$           USERS - LOG ON NAME
  108. '                         DgsAlias$                   USERS - ALIAS NAME
  109. '                         DgsStl$                     NULL FIRST TIME IN
  110. '                                                      'STILL' IF ALIAS EXISTS
  111. '                                                         OR REAL NAME
  112. '                         DgsFileName$                CONFERENCE ALIAS FILE
  113. '
  114. '  OUTPUT PARAMETERS  --  ZConfName$ ZOrigUserNameDgs$ DgsAlias$ DgsStl$
  115. '                         DgsFileName$
  116. '
  117. '  SUBROUTINE PURPOSE --  To Read ConfA.DEF and see if Users ALIAS is
  118. '                         Aready in Use or a Real Name
  119. '
  120.      SUB GoodAls (ZConfName$,ZOrigUserNameDgs$,DgsAlias$,DgsStl$,DgsFileName$) STATIC
  121. '
  122.      IF DgsAlias$ = "" THEN
  123.         DgsSfnSln$ = ZSysopFirstName$+SPACE$(1)+ZSysopLastName$      ' DD021301
  124.         ZOutTxt$ = "Do you" +DgsStl$+ " want to use an Alias?" + ZNoPrompt$' DD091301
  125.         ZSubParm = 1
  126.         CALL TGet
  127.         IF ZYes THEN
  128.            ABFlg$ = ""
  129.            ZOutTxt$ = "Enter Alias (31 Char. Max.) "
  130.            ZSubParm = 1
  131.            CALL TGet
  132.            CALL AllCaps (ZUserIn$)
  133.            IF ZUserIn$ = "" OR INSTR(SPACE$(31),ZUserIn$) > 0 THEN
  134.               ZUserIn$ = ""
  135.               ABFlg$ = "Alias Must NOT be Blank"
  136.            END IF
  137.            IF LEN(ZUserIn$) > 31 THEN
  138.               ZUserIn$= ""
  139.               ABFlg$ = "Length Must NOT Exceed 31 Characters"
  140.            END IF
  141.            IF ZUserIn$ = "SYSOP" OR ZUserIn$ = DgsSfnSln$ THEN
  142.               CALL PutCom (ZBellRinger$ + ZBellRinger$)              ' DD070402
  143.               ZOutTxt$ = "Wrong Answer! Alias Request Denied!"       ' DD070402
  144.               ZOutTxt$ = ZOutTxt$ + ZCRLf$ + "Contact Sysop for Alias Retry" ' DD070402
  145.               CALL QuickTPut (ZOutTxt$,2)
  146.               DgsAlias$ = ZOrigUserNameDgs$+CHR$(250)
  147.               ZActiveUserName$ = ZOrigUserNameDgs$+CHR$(250)
  148.               ZFirstName$ = ZOrigUserNameDgs$+CHR$(250)
  149.            ELSE
  150.               Call OpenWork (7,DgsFileName$)
  151.               WHILE ABFlg$ = "" AND NOT EOF(7)
  152.               INPUT #7, DgsUserName$, DgsTempAlias$
  153.               IF ZUserIn$ = DgsUserName$ THEN
  154.                  ABFlg$ = " is a Real User"
  155.               ELSE
  156.                  IF ZUserIn$ = DgsTempAlias$ THEN
  157.                     ABFlg$ = " has Already been Used"
  158.                  END IF
  159.               END IF
  160.               WEND
  161.               CLOSE 7
  162.               IF ABFlg$="" THEN
  163.                  DgsAlias$ = ZUserIn$
  164.                  ZActiveUserName$ = ZUserIn$
  165.                  ZFirstName$ = ZUserIn$
  166.               ELSE
  167.                  ZOutTxt$="Sorry "+ZFirstName$+" but "+ZUserIn$+ABFlg$
  168.                  CALL QuickTPut (ZOutTxt$,1)
  169.                  DgsStl$ = " still"
  170.                  DgsAlias$ = ""
  171.               END IF
  172.           END IF
  173.         ELSE
  174.            DgsAlias$ = ZOrigUserNameDgs$
  175.         END IF
  176.         IF DgsAlias$ <> "" THEN
  177.            CLOSE 2
  178.            FOR I = 1 TO LEN(DgsAlias$)
  179.               IF MID$(DgsAlias$,I,1)=CHR$(34) THEN MID$(DgsAlias$,I,1)=CHR$(39)
  180.            NEXT I
  181.            Call OpenWorkA (2,DgsFileName$)                           ' DD040601
  182.            WRITE #2, ZOrigUserNameDgs$, DgsAlias$
  183.            CLOSE 2
  184.         END IF
  185.       ELSE
  186.         ZActiveUserName$ = DgsAlias$
  187.         ZFirstName$ = DgsAlias$
  188.       END IF
  189.       END SUB
  190.