TIP: Click on subject to list as thread! ANSI
echo: foxpro
to: GERRY DANEN
from: DAVID POWELL
date: 1997-02-07 22:34:00
subject: Hiding passwords and FPW26

Here it is:
*:*********************************************************************
*: Procedure file: PassCard
*:      Copyright: (c) 1994, David Powell
*:                 Data-Train Microcomputing
*:                 2824 Ironwood Drive
*:                 Grand Prairie, TX  75052-4218
*:                 (972) 988-3227
*:                 All rights reserved, but released to public, no
*:                 charge.  Just keep my name on it, please, and
*:                 let me know of any improvements you suggest.
*:  Last modified: 09/10/94
*:        Purpose: An animated "passcard" for password identification.
*:       Platform: DOS only
*:          Notes: Recommend changing the name of the Security files
*:                 to discourage tampering.  This is a _DOS procedure
*:                 because of the high-ASCII characters and FILL TO
*:                 commands.
*:          Calls: CtrGet()
*:               : GetMsg()
*:               : PassWord
*:           Uses: Secure.DBF    which it will create, but you will
*:      CDX files: Secure.CDX    have to populate it.  Make a screen.
*:*********************************************************************
PROC PassCard
PUBL gcId, gcPw, gcFull
PRIV ALL LIKE j*
 
DEFI WIND wGetMsg FROM 23,00 TO 23,79 NONE
DEFI WIND wPass   FROM 00,00 TO 16,21 NONE
STOR "" TO gcId, gcPw, gcFull
jcConf = SET("CONFIRM")
jcCurs = SET("CURSOR")
jcEsc  = SET("ESCAPE")
jcTalk = SET("TALK")
jnSel  = SELE()
 
IF ! FILE("Secure.DBF")              && Here's the structure
   CREATE TABLE Secure ;
      ( name C(5), password C(9), salute C(10), ;
        fullname C(30), rights C(250) )
   INDE ON name TAG name
ENDI
IF USED("Secure")
   SELE Secure
ELSE
   SELE 0
   USE Secure
ENDI
SET ORDE TO name
SET TALK OFF
SET ESCA ON
SET CURS ON
SET CONF ON
ON ESCA QUIT                         && Don't want to play?  Get out.
 
DIME acard[7]                        && Passcard display array
acard[1] = " "+CHR(213)+REPL(CHR(205),12)+CHR(184)+" "
acard[2] = " "+CHR(179)+"  "+DTOC(DATE())+"  "+CHR(179)+" "
acard[3] = " "+CHR(179)+"  "+TIME()      +"  "+CHR(179)+" "
acard[4] = " "+CHR(195)+REPL(CHR(196),12)+CHR(180)+" "
acard[5] = " "+CHR(179)+"  Your ID?  "+CHR(179)+" "
acard[6] = " "+CHR(179)+"            "+CHR(179)+" "
acard[7] = " "+CHR(212)+REPL(CHR(205),12)+CHR(190)+" "
 
ACTI WIND wPass
MOVE WIND wPass TO 03,30 CENTER      && FP2.0 didn't have CENTER
FOR j = 1 TO 7
   @ j,02 SAY REPL(CHR(219),16)
NEXT
FOR j = 8 TO 15
   @ j,00 SAY REPL(CHR(219),20)
NEXT
@ 08,20 SAY CHR(220)
FOR j = 9 TO 15
   @ j,20 SAY CHR(219)
NEXT
@ 16,01 SAY REPL(CHR(223),20)
@ 08,00 FILL TO 15,19 COLO BR/B      && FPW ignores FILL TO
FOR i = 1 TO 7
   @ i,02 SAY acard[i] COLO B/W
NEXT
FOR i = 8 TO 16
   @ i,20 FILL TO i,20 COLO N/B
NEXT
@ 16,01 FILL TO 16,20  COLO N/B
 
DO WHIL .T.
   FOR i = 1 TO 3
      isHere = .F.
      STOR "" TO gcId, gcFull, lcGotIt
      @ 08,01 SAY SPAC(18) COLO N/BG
      @ 06,04 SAY SPAC(12) COLO N/W
      =CtrGet(@gcId,06,04,12)
      gcId   = UPPE(gcId)
      isHere = SEEK(gcId,"Secure")
      IF isHere
         lcGotIt  = Secure.password
         gcFull   = ALLT(Secure.fullname)
         EXIT
      ENDI
      @ 08,01 SAY " I don't know you " COLO N/BG
      =INKE(.5)
   NEXT
   SET ESCA OFF
   aCard[6] = PADC(gcId,16)
   FOR j = 1 TO 7
      @ j,02 SAY SPAC(16) COLO W/B
      FOR i = 1 TO 7 - j
         @ j+i,02 SAY aCard[i] COLO B/W
      NEXT
      =INKE(.05)
   NEXT
   ACTI SCRE
   =GetMsg("Input your password now")
   SET ESCA OFF
   ACTI WIND wPass
   @ 10,03 TO 12,16 COLO BG+/BR
   @ 11,05 SAY SPAC(10)
   gcPw = ""
   DO password WITH gcPw, 10
   DEAC WIND wGetMsg
   IF ALLT(UPPE(gcPw)) = ALLT(UPPE(lcGotIt))
      EXIT
   ELSE
      @ 08,01 SAY " Please try again " COLO N/BG
      =INKE(.05)
      gcPw = ""
      aCard[6] = " "+CHR(179)+"            "+CHR(179)+" "
      FOR i = 10 TO 12
         @ i,03 SAY SPAC(14) COLO BG+/BR
      NEXT
      FOR j = 8 TO 1 STEP -1
         FOR i = 8 - j TO 1 STEP -1
            @ j+i-1,02 SAY aCard[i] COLO B/W
         NEXT
         =INKE(.05)
      NEXT
   ENDI
ENDD
FOR i = 10 TO 12
   @ i,03 SAY SPAC(14) COLO N/BR
NEXT
@ 11,06 SAY "Welcome!" COLO BG+/RB
gcWhen = IIF(LEFT(TIME(),2)<"12","Morning", ;
         IIF(LEFT(TIME(),2)<"18","Afternoon","Evening"))
@ 13,03 SAY PADC("Good "+gcWhen,14) COLO BG+/RB
@ 14,03 SAY PADC(ALLT(salute),14)   COLO BG+/RB
=INKE(2)                             && Adjust delay, if needed
RELE WIND wPass                      && Let's return the environment
SET TALK &jcTalk
SET ESCA &jcEsc
SET CONF &jcConf
SET CURS &jcCurs
SELE (jnSel)
RELE ALL LIKE j*
=SYS(12)                             && Free up some memory
RETU                                 && EOP: PassCard
 
*!*********************************************************************
*!  Function: CtrGet()
*! Called by: PassCard.PRG                      
*!   Purpose: Centers the user's input on the designated coordinates
*!*********************************************************************
FUNC CtrGet
PARA lcRetVal, lnRow, lnCol, lnWid
PRIV lcRetVal, lnKey, lnRow, lnCol, lnWid, lnC
 
PUSH KEY CLEA
lnKey = 32                            && Seed lnKey for loop
lnC   = lnCol + INT(lnWid/2) -1
 
DO WHIL lnKey != 13 AND lnKey != 27   && Accept until ENTER is pressed
   lnKey = INKE(0)
   DO CASE
      CASE lnKey = 27
         QUIT                         && Escape?!  OK, fine.
      CASE ISAL(CHR(lnKey)) OR (lnKey >= 32 AND lnKey <= 126)
         lcRetVal = lcRetVal + CHR(lnKey)
      CASE lnKey = 19 OR lnKey = 127 OR lnKey = 7
         lcRetVal = SUBS(lcRetVal,1,LEN(lcRetVal)-1)
   ENDC
   IF LEN(lcRetVal) >= lnWid
      lnKey = 13
   ENDI
   @ lnRow,lnCol SAY PADC(lcRetVal,lnWid) COLO R/W
ENDD
 
POP KEY
RETU lcRetVal                     && EOF: CtrGet()
 
*!***********************************************************************
*! Procedure: PassWord
*! Called by: PassCard
*!***********************************************************************
PROC PassWord
PARA gcPw, lnWid
PRIV lnWid, lnKey
 
SET ESCA ON
PUSH KEY CLEA
 
IF PARA() < 2                        && If no width passed,
   lnWid = 9                         && use password length of 9
ENDI
 
lnKey = 0
@ 11,05 SAY ""
 
DO WHIL lnKey != 13 AND lnKey != 27  && Accept until ENTER or ESC
   lnKey = INKE(0)
   DO CASE
   CASE lnKey = 27
      QUIT
   CASE ISAL(CHR(lnKey)) OR (lnKey >= 32 AND lnKey <= 126)
      gcPw = gcPw + CHR(lnKey)
   CASE lnKey = 19 OR lnKey = 127 OR lnKey = 7
      gcPw = SUBS(gcPw,1,LEN(gcPw)-1)
   ENDC
   
   IF LEN(gcPw) >= lnWid
      lnKey = 13
   ENDI
   @ 11,05 SAY PADC(REPL(CHR(02),LEN(gcPw)),10)
ENDD
 
POP KEY
RETU gcPw                            && EOP: PassWord
 
*!*********************************************************************
*! Function: GetMsg
*!   Author: David Powell, 26-May-1994
*!  Purpose: Replacement for MESS clause of GET in order to 
*!           standardize the colors and placement of the text
*!*********************************************************************
FUNC GetMsg
PARA lcMsg
 
IF ! WEXI("wGetMsg")
   DEFI WIND wGetMsg FROM 23,00 TO 23,79 NONE
ENDI
IF ! EMPT(lcMsg)
   ACTI WIND wGetMsg
   @ 00,00 SAY PADC(lcMsg,80) COLO N/BG
ENDI
RETU .T.                             && EOF: GetMsg()
-------------------------------------------------------------------
I admit, it could be better commented.  But, you get the idea, right?
David in Dallas.
--- Maximus/2 3.01
---------------
* Origin: * MacSavvy OS/2 BBS * Dallas, Texas * 972-250-4479 * (1:124/1208)

SOURCE: echomail via exec-pc

Email questions or comments to sysop@ipingthereforeiam.com
All parts of this website painstakingly hand-crafted in the U.S.A.!
IPTIA BBS/MUD/Terminal/Game Server List, © 2025 IPTIA Consulting™.