Password program

[oracle]

If you guys have seen the passwords and asterisks (*) topic you'll know what this is about... Create the best password program. It should display characters as stars. This will probably be too easy for most, so make it as graphically pleasing as you can. Use screen 12 etc, include the mouse for bonus points etc. If you think the code is too long then pm it to me.

[whitetiger0990]

like this?

Code:

CLS
DO
p$ = ""
DO WHILE p$ = ""
p$ = INKEY$
IF p$ = " " THEN b = 1
IF p$ = CHR$(13) THEN done = 1
IF p$ = CHR$(8) THEN
 IF LEN(pass$) <> 0 THEN
  MID$(pass$, LEN(pass$), 1) = " "
  MID$(a$, LEN(a$), 1) = " "
 END IF
 b = 1
 LOCATE 1, 1: PRINT a$;
END IF

LOOP
 pass$ = RTRIM$(pass$)
 a$ = RTRIM$(a$)
 IF done = 0 AND b = 0 THEN pass$ = pass$ + p$
 IF done = 0 AND b = 0 THEN a$ = a$ + "*"
 LOCATE 1, 1: PRINT a$;
 b = 0
LOOP UNTIL done = 1
PRINT
PRINT pass$

After typing hit enter
It then prints it out.
And click backspace to backspace.

[DrV]

I'll hack up a quick one with arrow key support... shouldn't be too hard...  the mouse might be more challenging.  I haven't done that since my FirstBasic days...

[oracle]

whitetiger is winning, but it is pretty poor really. No prompt, screen 0, no asterisk for space, accept the F keys as input, but it is functional. You get 5 challenge points.

Please do dig out your mouse commands. Or check the tutorials right here at qbnews for a mouse routine.

[toonski84]

We lose points for not using our own fonts in a graphical screen mode?

[Meg]

Code:

y% = CSRLIN
x% = POS(0)
accepted$ = " abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
p$ = ""
a$ = ""

DO
     LOCATE y%, x%
     PRINT "Enter Password: "; a$; " ";
     k$ = INPUT$(1)
     SELECT CASE k$
          CASE CHR$(8)
               IF LEN(p$) THEN
                    p$ = LEFT$(p$, LEN(p$) - 1)
                    a$ = LEFT$(a$, LEN(a$) - 1)
               END IF
          CASE CHR$(13)
               EXIT DO
          CASE ELSE
               IF POS(0) < 80 AND INSTR(accepted$, k$) THEN
                    p$ = p$ + k$
                    a$ = a$ + "*"
               END IF
     END SELECT
LOOP

[oracle]

In my scoring method you can't lose points, but you will gain them for something like your own fonts too (as long as they look good  :wink: )

Edit: Meg's program...

Better. Doesn't accept F keys, accepts backspace, prompt, accepts and displays star for space key. However screen 0 and uninviting. Meg gets 11 challenge points.

Please guys, when you send something, make a default password and check that the password is correct, then display some sort of message based on the password given.

----- SCORE TABLE -----
Meg - - - - - - - - - - - 11
whitetiger0990 - - - - 5

[Meg]

Here's a password program with a theme

Code:

TYPE BGType '*** BACKGROUND ARRAY ***
     YPos AS INTEGER
     cycl AS SINGLE
     chng AS SINGLE
     Speed AS INTEGER
     Blot AS INTEGER
END TYPE
DIM BG(1 TO 40) AS BGType

DECLARE SUB ShowMessage (Message$)
DECLARE SUB Background (BG() AS BGType)

SCREEN 13

FOR c% = 0 TO 63 '*** SET UP GREEN PALETTE ***
     OUT &H3C8, c%
     OUT &H3C9, 0
     OUT &H3C9, c%
     OUT &H3C9, 0
NEXT c%

accepted$ = " abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
p$ = ""
a$ = ""

DO
     LOCATE 12, 7: COLOR 40: PRINT "Enter Password: "; a$; " ";
   
     DO
          CALL Background(BG()) '*** MOVE STREAKS ***
          k$ = INKEY$
     LOOP UNTIL k$ <> ""
   
     SELECT CASE k$
          CASE CHR$(8) '*** BACKSPACE ***
               IF LEN(p$) THEN
                    p$ = LEFT$(p$, LEN(p$) - 1)
                    a$ = LEFT$(a$, LEN(a$) - 1)
               END IF
          CASE CHR$(13) '*** ENTER ***
               EXIT DO
          CASE ELSE
               IF LEN(a$) < 9 AND INSTR(accepted$, k$) THEN
                    p$ = p$ + k$
                    a$ = a$ + "*"
               END IF
     END SELECT
LOOP

IF p$ = "matrix" THEN
     Message$ = " SECURITY ACCESS GRANTED "
ELSE
     Message$ = " WARNING: SYSTEM FAILURE "
END IF
CALL ShowMessage(Message$) '*** FLASH MESSAGE ***

SUB Background (BG() AS BGType)
     FOR column% = 1 TO 40
          IF BG(column%).YPos THEN '*** STREAK EXISTS ***
               LOCATE BG(column%).YPos, column%
               COLOR INT(BG(column%).cycl)
               IF (column% < 6 OR column% > 32) OR (BG(column%).YPos < 11 OR BG(column%).YPos > 13) THEN
                    IF BG(column%).Blot THEN '*** ERASING STREAK ***
                         PRINT " ";
                    ELSE
                         PRINT CHR$(INT(RND * 94) + 33); '*** DRAWING STREAK ***
                    END IF
               END IF
               IF INT(RND * BG(column%).Speed) = 0 THEN BG(column%).YPos = BG(column%).YPos + 1
               IF BG(column%).YPos = 24 THEN
                    IF BG(column%).Blot THEN '*** END ERASER ***
                         BG(column%).YPos = 0
                         BG(column%).Blot = 0
                    ELSE
                         BG(column%).YPos = 1 '*** START ERASER ***
                         BG(column%).Blot = 1
                    END IF
               ELSE
                    BG(column%).cycl = BG(column%).cycl + BG(column%).chng
                    IF BG(column%).cycl > 63 THEN '*** LOOP COLOR ***
                         BG(column%).cycl = 63
                         BG(column%).chng = -.1
                    END IF
                    IF BG(column%).cycl < 0 THEN '*** LOOP COLOR ***
                         BG(column%).cycl = 0
                         BG(column%).chng = .1
                    END IF
               END IF
          ELSE
               IF INT(RND * 550) = 0 THEN '*** CREATE STREAK ***
                    BG(column%).YPos = 1
                    BG(column%).cycl = INT(RND * 61) + 1
                    BG(column%).chng = .1 * (-1) ^ (INT(RND * 2))
                    BG(column%).Speed = (INT(RND * 10) + 1) * 5
               END IF
          END IF
     NEXT column%
END SUB

SUB ShowMessage (Message$)
     c% = 0
     ch% = 1
     DO
          c% = c% + ch%
          IF c% = 63 THEN ch% = -1
          IF c% = 0 THEN ch% = 1
          LOCATE 12, 7
          COLOR c%
          PRINT Message$
          FOR t = 1 TO 15000: NEXT t
     LOOP UNTIL INKEY$ <> ""
END SUB

correct password = "matrix"

*peace*

Meg.

[Meg]

**deleted post**

[oracle]

Excellent! That's what I'm posting about! Lets see some more of those!

Remember: Bonus points for mouse control.

Meg's new program: Has a theme, checks for correct entry and displays appropriate response, accepts proper keys (but not tidle). Your new total is 31 points, well done.

C'mon other would-be challengers: give Meg a hard time!

----- SCORE TABLE -----
Meg - - - - - - - - - - - 31
whitetiger0990 - - - - 5

[Meg]

title reiterated.

*peace*

Meg.