Stars of Shareware: DFÜ und Kommunikation

home *** CD-ROM | disk | FTP | other *** search

/ Stars of Shareware: DFÜ und Kommunikation / SOS-DFUE.ISO / programm / dos / terminal / ca_29 / bbmaint1.cmd < prev next >

Wrap

Text File | 1992-03-24 | 19.5 KB | 759 lines

;**** TRACE ON ; Debugging ; ; ----- COM-AND BBS UserID maintenance script (User file) ; Commenced: 11/90 R.McG ; ----------------------------------------------------------------------- ; Purpose: ; The script, named BBMAINT1.CMD, produces the main window for ; UserID functions of BBMAINT, and implements its functions. It ; is not directly callable itself. ; ----------------------------------------------------------------------- ; Usage: ; N99 -> Text attribute value (setup by BBMAINT.CMD) ; N98 -> BBMAINT Mainline cursor position ; N97 -> BBMAINT Mainline cursor position ; N96 -> our mainline cursor position ; N95 -> our mainline cursor position ; ----------------------------------------------------------------------- ; ; This script is intended ONLY to be used for FCALL ; IF NOT FCALLED WOPEN 10,10,13,70 (cont) NOUSEsc ATSAY 10,12 (cont) " BBS Users " ATSAY 11,12 (cont) " The script: "*"_SCRIPT" ATSAY 12,12 (cont) " is not used by itself... it is called through BBMAINT" ATSAY 13,26 (cont) " Press any key to continue " KEYGET S0 ; Wait for any key WCLOSE ; Close open window EXIT ; Terminate right here ENDIF GOSUB UserFile ; Invoke function FRETURN ; Return to caller ; ----------------------------------------------------------------------- ; ----- NoUser: Inform that there's no USER ID file to modify ; NoUser: WOPEN 10,10,13,70 (cont) NOUSEsc ATSAY 10,12 (cont) " BBS User " ATSAY 11,12 (cont) " The file: "*S22&"\BBS-User" ATSAY 12,12 (cont) " does not exist. Please create subdirectories first." ATSAY 13,26 (cont) " Press any key to continue " ; ; Wait a keypress ; KEYGET S0 ; Wait for any key WCLOSE NOUSEsc: RETURN ; ----------------------------------------------------------------------- ; ----- Subroutine: UserFile -> Update user ID directory ; UserFile: GOSUB NewUser ; Create if not there IF NOT ISFILE S22&"\BBS-USER" GOSUB NoUser ; Inform there's no file RETURN ; .. so we can't continue ENDIF ; ; Open a window ; WOPEN 0,0 23,79 (defa) User_Esc ATSAY 0,2 (defa) " BBS Users " ATSAY 23,25 (defa) " Press ESC to cancel BBMAINT " ; ; Paint the menu ; USFI100: CLEAR ; Clear window LOCATE 2,2 MESS " 1) Add an ID" MESS " 2) Delete an ID" MESS " 3) Modify an ID's values" MESS " 4) Print User list" MESS " 5) View list of IDs" MESS "──────────────────────────────────── " MESS "Note: Alt-Q to edit a file" MESS " Alt-F for a directory search" MESS " Alt-F10 to shell to DOS" MESS " " MESS "──────────────────────────────────── " MESS " " MESS "Select item (carriage return = previous): " CURSOR N96,N95 ; Read current cursor ; ; Wait for entry, and interpret ; USFI200: LOCATE N96 N95 ; Reposition cursor KEYGET S0 ; Wait for it SWITCH S0 ; Act according to keyget CASE "1" GOSUB AddID ENDCASE CASE "2" GOSUB DelID ENDCASE CASE "3" GOSUB ModID ENDCASE CASE "4" GOSUB PrnID ENDCASE CASE "5" GOSUB ViewID GOTO USFI100 ; Repaint after this ENDCASE CASE "0d" ; c/r alone is exit WCLOSE ; Close window... RETURN ; and return to caller ENDCASE CASE "_NULL" ; ESC -> Null WCLOSE ; Close window... RETURN ; Leave Main routine ENDCASE CASE "2100" ; Alt-F MANUAL "0x2100" ; Perform Dir cmd ENDCASE CASE "1000" ; Alt-Q MANUAL "0x1000" ; Edit a file ENDCASE CASE "7100" ; Alt-F10 SHELL DWINDOW 1,2,22,78; Reset dwindow after shell LEGEND "_LEGEND" ; Redo the legend ENDCASE DEFAULT ; None of the above SOUND 100,100 ; Bronx cheer ENDCASE ENDSWITCH GOTO USFI200 ; Repaint screen and ask again ; ; End of Users procedure ; User_Esc: S0 = "" ; Fake a nulll entry RETURN ; Leave users routine ; ----------------------------------------------------------------------- ; ----- AddID: Add an ID to the User file ; AddID: SET FLAG(0) OFF ; Flag for ESCAPE WOPEN 10,10,15,70 (cont) ADIDEsc ATSAY 10,12 (cont) " BBS User Add " ATSAY 11,12 (cont) "Enter the ID to be added: " ATSAY 15,26 (cont) " Press ESC to cancel " ; ; Wait a keypress ; LOCATE 11,38 GET S0 8 ; get ID IF FLAG(0) GOTO ADIDEnd ; Exit if ESC hit LJ S0 ; Left justify UPPER S0 ; ... and upper case IF NULL S0 GOTO ADIDEnd ; get out on empty entry GOSUB LkpID ; Lookup ID in User file IF FOUND ; If its there we can't add it WCLOSE ; Close open window GOTO ModID_Add ; Skip if ID found ENDIF S10 = S0 ; Save ID GOTO ADID100 ; And branch around parallel code ; ; Entry from ModID... Nothing to modify ; AddID_Mod: WOPEN 10,10,15,70 (cont) ADIDEsc ATSAY 10,12 (cont) " BBS User Add " ATSAY 11,12 (cont) "Enter the ID to be added: " ATSAY 11,38 (cont) S0 ATSAY 15,26 (cont) " Press ESC to cancel " S10 = S0 ; Copy it for remainder ; ; Ask for a password ; ADID100: ATSAY 12,12 (cont) "Enter the password: " LOCATE 12,38 GET S0 8 ; get resp IF FLAG(0) GOTO ADIDEnd ; Exit if ESC hit LJ S0 ; Left justify UPPER S0 ; ... and upper case IF NULL S0 ; Password MUST be filled in SOUND 100,100 ; Indicate displeasure GOTO ADID100 ; Try again ENDIF S10(8:15) = S0 ; Save password ; ; Ask for privileged flag ; ADID200: ATSAY 13,12 (cont) "Priveleged access (y/n): " LOCATE 13,38 GET S0 1 ; get resp IF FLAG(0) GOTO ADIDEnd ; Exit if ESC hit IF NULL S0 or NOT FIND "YN" S0(0) SOUND 100,100 ; Indicate displeasure GOTO ADID200 ; Try again ENDIF IF FIND "Y" S0(0) S10(16:16) = "P" ; Save priveleged access ; ; Ask for one more look ; ADID300: ATSAY 14,12 (cont) "OK to add this record?: " LOCATE 14,38 GET S0 1 ; get resp IF FLAG(0) GOTO ADIDEnd ; Exit if ESC hit IF NULL S0 or NOT FIND "YN" S0(0) SOUND 100,100 ; Indicate displeasure GOTO ADID300 ; Try again ENDIF IF FIND "N" S0(0) WCLOSE ; Close window GOTO AddID ; And try again ENDIF ; ; Add comments and write the record ; S10(17:70) = "* Added "*"_DATE"*", at "*"_TIME" GOSUB AddUser ; Write to User file ; ; End of add procedure ; ADIDEnd: WCLOSE ADIDEsc: SET FLAG(0) ON RETURN ; ; ----- AddUser: Add a record to the user file... ; .. S10 passes the record to be written ; AddUser: FOPENO S22&"\BBS-User" TEXT APPEND IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S22&"\BBS-User" GOSUB Error ; Report RETURN ; And we're done ENDIF PRESERVE S10 ; Preserve ^'s and !'s WRITE S10 ; Write the record WRITE "!^Z" ; And finish it FCLOSEO RETURN ; ----------------------------------------------------------------------- ; ----- LkpID: Lookup an ID in the BBS-User file ; .. S0 passes the ID to be tested ; .. S10 returns the record read ; LkpID: FOPENI S22&"\BBS-User" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S22&"\BBS-User" GOSUB Error ; Report SET FOUND OFF ; Not found RETURN ; And we're done ENDIF ; ; Read loop ; LOID100: READ S10 80 N0 ; Read a record IF EOF GOTO LOID200 ; Skip on EOF IF STRCMP S10(0:0) "<" GOTO LOID110 IF STRCMP S10(0:7) S0(0:7) GOTO LOID300 ; ; Record longer than 80 chars ; LOID110: IF N0 LT 80 GOTO LOID100; If exactly 80 rtnd, c/r wasn't read READ S10 80 N0 ; Read remainder of rec GOTO LOID110 ; Read until less than 80 ; ; We have end-of-file - not found ; LOID200: SET FOUND OFF ; Indicate not found GOTO LOIDEnd ; ; We have a hit - return found ; LOID300: SET FOUND ON ; Indicate found ; ; And exit ; LOIDEnd: FCLOSEI RETURN ; ----------------------------------------------------------------------- ; ----- DelID: Delete an ID from User file ; DelID: SET FLAG(0) OFF ; Flag for ESCAPE WOPEN 10,10,15,70 (cont) DEIDEsc ATSAY 10,12 (cont) " BBS User Delete " ATSAY 11,12 (cont) "Enter the ID to be deleted: " ATSAY 15,26 (cont) " Press ESC to cancel " ; ; Wait a keypress ; LOCATE 11,40 GET S0 8 ; get ID IF FLAG(0) GOTO DEIDEnd ; Exit if ESC hit LJ S0 ; Left justify UPPER S0 ; ... and upper case IF NULL S0 GOTO DEIDEnd ; get out on empty entry ; ; Open the User file and a temp copy file ; GOSUB DelUser ; Try to delete IF FLAG(1) GOTO DEIDEnd ; Skip if record deleted ATSAY 12,12 (cont) "ID could not be found... " ATSAY 13,12 (cont) "Press any key to continue..." KEYGET S0 ; ; End of add procedure ; DEIDEnd: WCLOSE DEIDEsc: SET FLAG(0) ON RETURN ; ----------------------------------------------------------------------- ; ----- DelUser: Delete a record from the user file... ; .. S0 passes the user-id ; .. S1 destroyed in the process ; .. FLAG(1) if rtn'd set, indicates record was FOUND ; DelUser: ; ; Open the User file and a temp copy file ; SET FLAG(1) OFF ; Initialize for found flag FOPENI S22&"\BBS-User" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S22&"\BBS-User" GOSUB Error ; Report GOTO DEUSEnd ; And we're done ENDIF FOPENO S22&"\TempUser" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S22&"\TempUser" GOSUB Error ; Report GOTO DEUSEnd ; And we're done ENDIF N10 = 0 ; Count recs output for file delete ; ; Read records (40 chars at a time to allow PRESERVE) ; DEUS100: READ S1 40 N0 ; Read 1st 40 chars IF EOF GOTO DEUS300 ; Skip on EOF IF ZERO N0 GOTO DEUS100 ; Don't copy blank lines IF STRCMP S1(0:7) S0(0:7) GOTO DEUS200 INC N10 ; Count rec written ; ; Copy the record read to the output file ; DEUS110: PRESERVE S1 ; Save !'s and ^'s WRITE S1 ; Write text IF N0 LT 40 ; If we wrote end of record WRITE "!" ; Finish w/cr/lf GOTO DEUS100 ; And continue copying ENDIF READ S1 40 N0 ; Read remainder of rec IF NOT EOF GOTO DEUS110 ; Skip if not eof WRITE "!" ; Finish record GOTO DEUS300 ; End of file ; ; We have a hit ; DEUS200: SET FLAG(1) ON ; Flag we deleted item IF N0 LT 40 GOTO DEUS100 READ S1 40 N0 ; Read remainder of rec IF NOT EOF GOTO DEUS200 ; Skip if not found ; ; We hit EOF - may or may not have found the target rec ; DEUS300: IF NOT FLAG(1) GOTO DEUS400 ; skip if not found WRITE "^Z" ; Finish ASCII file FCLOSEO ; Close output FCLOSEI ; Close input DELETE S22&"\BBS-User" ; Delete original RENAME S22&"\TempUser" S22&"\BBS-User" IF ZERO N10 DELETE S22&"\BBS-User" ; Delete empty file GOTO DEUSEnd ; ; We hit EOF - we did not find the record ; DEUS400: FCLOSEO ; Close output FCLOSEI ; Close input DELETE S22&"\TempUser" ; Delete copy file ; ; End of procedure... ; DEUSEnd: RETURN ; ----------------------------------------------------------------------- ; ----- ModID: Modify an ID in the User file ; ModID: SET FLAG(0) OFF ; Flag for ESCAPE WOPEN 10,10,15,70 (cont) MOIDEsc ATSAY 10,12 (cont) " BBS User Modify " ATSAY 11,12 (cont) "Enter the ID to change: " ATSAY 15,26 (cont) " Press ESC to cancel " ; ; Wait a keypress ; LOCATE 11,38 GET S0 8 ; get ID IF FLAG(0) GOTO MOIDEnd ; Exit if ESC hit LJ S0 ; Left justify UPPER S0 ; ... and upper case IF NULL S0 GOTO MOIDEnd ; get out on empty entry GOSUB LkpID ; Lookup ID in User file IF NOT FOUND ; If its there we can't add it WCLOSE ; Close open window GOTO AddID_Mod ; Skip if ID NOT found ENDIF GOTO MOID100 ; And branch around parallel code ; ; Entry from AddID... We have a rec in S10 - needs adding ; ModID_Add: WOPEN 10,10,15,70 (cont) MOIDEsc ATSAY 10,12 (cont) " BBS User Modify " ATSAY 11,12 (cont) "Enter the ID to change: " ATSAY 11,38 (cont) S0 ATSAY 15,26 (cont) " Press ESC to cancel " ; ; Display the original values (rtnd in S10 by LkpID) ; MOID100: ATSAY 10,49 (cont) " Old vals " ATSAY 11,50 (cont) S10(0:7) ATSAY 12,50 (cont) S10(8:15) IF NOT NULL S10(16:16) ATSAY 13,50 (cont) "y" ELSE ATSAY 13,50 (cont) "n" ENDIF ; ; Ask for a password ; ATSAY 12,12 (cont) "Enter the password: " LOCATE 12,38 GET S0 8 ; get password IF FLAG(0) GOTO MOIDEnd ; Exit if ESC hit LJ S0 ; Left justify UPPER S0 ; ... and upper case IF NULL S0 ; Password c/r simly copies previous ATSAY 12,38 (cont) S10(8:15) GOTO MOID200 ; No update ENDIF S10(8:15) = S0 ; Save password ; ; Ask for privileged flag ; MOID200: ATSAY 13,12 (cont) "Priveleged access (y/n): " LOCATE 13,38 GET S0 1 ; get resp IF FLAG(0) GOTO MOIDEnd ; Exit if ESC hit IF NULL S0 ATSCR 13,50 1 S0 ; Read back previous value IF NOT FIND "YN" S0(0) ; If not y/n SOUND 100,100 ; Indicate displeasure GOTO MOID200 ; Try again ENDIF S10(16:16) = " " ; Default no priv IF FIND "Y" S0(0) ; If privilege 'y' S10(16:16) = "P" ; Set priveleged access ENDIF ; ; Ask for one more look ; MOID300: ATSAY 14,12 (cont) "OK to add this record?: " LOCATE 14,38 GET S0 1 ; get resp IF FLAG(0) GOTO MOIDEnd ; Exit if ESC hit IF NULL S0 or NOT FIND "YN" S0(0) SOUND 100,100 ; Indicate displeasure GOTO MOID300 ; Try again ENDIF IF FIND "N" S0(0) WCLOSE ; Close window GOTO ModID ; And try again ENDIF ; ; Add comments Delete the previous value... and add the new ; S10(17:70) = "* Modified "*"_DATE"*", at "*"_TIME" S0 = S10(0:7) ; Setup ID key GOSUB DelUser ; Delete the previous key IF NOT FLAG(1) ; If not deleted S0 = "Error modifying record for: "*S0 GOSUB Error ; Report GOTO MOIDEnd ; And we're done ENDIF GOSUB AddUser ; And add the new record ; ; End of add procedure ; MOIDEnd: WCLOSE MOIDEsc: SET FLAG(0) ON RETURN ; ----------------------------------------------------------------------- ; ----- PrnID: Print a list of IDs ; PrnID: FOPENI S22&"\BBS-User" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S22&"\BBS-User" GOSUB Error ; Report RETURN ; And we're done ENDIF ; ; Initialize a counter ; N10 = 0 ; # Lines printed N11 = 1 ; Page number ; ; Read loop ; PRID100: READ S10 80 N0 ; Read a record IF EOF GOTO PRID200 ; Skip on EOF IF STRCMP S10(0:0) "<" GOTO PRID120 ; skip comments IF ZERO N0 GOTO PRID100 ; skip blank lines ; ; Print a heading... ; IF N10 GT 0 and N10 LE 50 GOTO PRID110 PRINT "COM-AND Scripted BBS User list as of "*"_DATE"*", "*"_TIME"*" Page "*N11*"^M^J" PRINT "From: "*"_IFILE"*"^M^J" PRINT "----------------------------------------------------------------------^M^J" PRINT "ID Priv Comments^M^J" PRINT "-------- ---- --------------------------------------------------------^M^J" N10 = 0 INC N11 ; ; Build a record and print it ; PRID110: S0 = S10(0:7) ; ID Field IF NOT NULL S10(16:16) S0(10:12) = "yes" S0(14:79) = S10(17:79) ; Comment field PRESERVE S0 PRINT S0 PRINT "^M^J" ; FInish line INC N10 ; COunt lines printed ; ; Handle record longer than 80 chars ; PRID120: IF N0 LT 80 GOTO PRID100; If exactly 80 rtnd, c/r wasn't read READ S10 80 N0 ; Read remainder of rec GOTO PRID120 ; Read until less than 80 ; ; We have end-of-file ; PRID200: PRINT "^L" ; Do a final top-of-form ; ; And exit ; PRIDEnd: FCLOSEI RETURN ; ----------------------------------------------------------------------- ; ----- ViewID: View a list of IDs ; ViewID: FOPENI S22&"\BBS-User" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S22&"\BBS-User" GOSUB Error ; Report RETURN ; And we're done ENDIF ; ; Initialize a counter ; N10 = 0 ; # Lines printed N11 = 0 ; Page number SET FLAG(0) OFF ; Initialize esc flag S11 = "_ONESC" ON ESCAPE GOSUB VIIDESC ; ; Print a heading... ; VIID100: IF N10 GT 0 GOTO VIID110 CLEAR ; Clear the window ATSAY 1,2 (defa) "ID Priv Comments" ATSAY 2,2 (defa) "-------- ---- ----------------------------------------------------" N10 = 3 ; Set starting line no INC N11 ; Set next page ; ; Save the file position for the start of this page ; FSAVEI IF NOT SUCCESS FSAVEI SHIFT ; Save last 20 pos'ns FSAVEI ENDIF ; ; Read loop ; VIID110: READ S10 80 N0 ; Read a record IF EOF GOTO VIID200 ; Skip on EOF IF STRCMP S10(0:0) "<" GOTO VIID120 ; skip comments IF ZERO N0 GOTO VIID110 ; skip blank lines ; ; Build a record and print it ; S0 = S10(0:7) ; ID Field IF NOT NULL S10(16:16) S0(10:12) = "yes" S0(14:75) = S10(17:79) ; Comment field PRESERVE S0 ATSAY N10,2 (defa) S0 INC N10 ; COunt lines printed ; ; Handle record longer than 80 chars ; VIID120: IF N0 LT 80 GOTO VIID200; If exactly 80 rtnd, c/r wasn't read READ S10 80 N0 ; Read remainder of rec GOTO VIID120 ; Read until less than 80 ; ; Look for end of screen/end of file ; VIID200: IF (NOT EOF) and N10 LT 21 GOTO VIID100 IF EOF ATSAY 22,2 (defa) "End of file; Home (top), PgDn (forward), PgUp (back)" ELSE ATSAY 22,2 (defa) "Page "*N11*"; Home (top), PgDn (forward), PgUp (back)" ENDIF ; ; Read a key and interpret ; VIID210: IF FLAG(0) RETURN ; End of routine when flag set KEYGET S1 IF FLAG(0) RETURN ; End of routine when flag set SWITCH S1 CASE "4900" ; Pgup GOTO PgUp ENDCASE CASE "5100" ; PgDn GOTO PgDn ENDCASE CASE "4700" ; Home GOTO Home ENDCASE CASE "0D" ; C/r IF EOF GOTO VIIDEnd GOTO PgDn ENDCASE CASE "2100" ; Alt-F MANUAL "0x2100" ; Perform Dir cmd ENDCASE CASE "1000" ; Alt-Q MANUAL "0x1000" ; Edit a file ENDCASE CASE "7100" ; Alt-F10 SHELL DWINDOW 1,2,22,78 ; Reset dwindow after shell LEGEND "_LEGEND" ; Redo the legend ENDCASE DEFAULT MESS S1 SOUND 100,100 ENDCASE ENDSWITCH GOTO VIID210 ; ; Page up (go backwards) ; PgUp: N10 = 0 ; Clear line ctr FRESTOREI ; Backup current pg N11 = N11-1 ; Reset Page # for redisplay FRESTOREI ; Backup one more IF NOT SUCCESS SOUND 200,100 ; Indicate problem GOTO Home ENDIF N11 = N11-1 ; Reset Page # for redisplay GOTO VIID100 ; ; Home (go to top) ; Home: N10 = 0 ; Clear line ctr N11 = 0 ; Set new pg number FSAVEI CLEAR ; Clear saved pages REWIND ; Rewind input GOTO VIID100 ; ; Page down (go forwards) ; PgDn: IF EOF GOTO Home ; Wrap to home at EOF N10 = 0 ; Clear line ctr GOTO VIID100 ; ; And exit ; VIIDEnd: FCLOSEI RETURN ; ; Escape entered ; VIIDESC: SET FLAG(0) ON ON ESCAPE GOSUB S11 ; Restore previous ON ESC RETURN ;-------------------------------------------------------------------------- ; ----- Subroutine: NewUser -> Create a new BBS-User file ; NewUser: IF ISFILE S22&"\BBS-User" RETURN FOPENO S22&"\BBS-User" TEXT IF NOT SUCCESS RETURN ; Open failed WRITE "!^Z" ; Make it empty FCLOSEO ; Done with it RETURN ; ----------------------------------------------------------------------- ; ----- Error: Open a window, display a message, and wait for keypress ; S0 passes the error message ; Error: WOPEN 10,10,12,70 (cont) Err_Esc ATSAY 10,12 (cont) " Error " ATSAY 11,12 (cont) S0(0:55); Max msg width 55 chars ATSAY 12,26 (cont) " Press any key to continue " ; ; Wait a keypress ; KEYGET S0 ; Wait for any key WCLOSE Err_Esc: RETURN