Password Security in Clipper Summer '87

Here is another password security program that I wrote a very long time using Nantucket Clipper Summer '87 to protect the database from intruders.

My email address are the following jakerpomperada@gmail.com and jakerpomperada@yahoo.com.

My mobile number here in the Philippines is 09173084360.

My telephone number at home here in Bacolod City, Negros Occidental is (034) 4335675.

Program Listing

* Password.Prg
* Clipper Summer '87
* Author : Jake R. Pomperada
* Date : January 14, 2001

Set Talk Off
Set Echo Off
Set Scoreboard Off
Set Safety Off
Set Escape Off
Set Procedure To Shadow
Set Procedure To Sha_Attr
Clear Typeahead
Clear screen
@ 01,01 To 23,80 double
Set Color To
@ 02,02,22,78 Box Replicate(Chr(177),80)
Set Color To
Set Color to W/BG
@ 03,16 Clear To 09,65
@ 03,16 To 09,65
Shadow(03,16,09,65)
Title1 = "General Manager :  James Smith"
Title2 = "WEST BAR AND RESTAURANT PAYROLL SYSTEM"
Title3 = "Bacolod City"
Title4 = "Developed By: SERVO Software Unlimited."
DateNow = CMonth(date()) + Chr(32) + Str(day(date()),2) +;
          ',' +Chr(32) + Str(Year(Date()), 4)
Set Color to GR+/BG
@ 4,Int(80-Len(Title2))/2 Say Title2
Set Color To
Set Color To W+/BG
@ 5,Int(80-Len(Title3))/2 Say Title3
Set Color To G+/Bg
@ 6,Int(80-Len(Title1))/2 Say Title1
Set Color To W+/Bg
@ 7,Int(80-Len(DateNow))/2 Say DateNow
Set Color To
Set Color To GR/Bg
@ 8,Int(80-Len(Title4))/2 Say Title4
Set Color To
Set Color To W/N
@ 13,20 Clear To 15,60
@ 13,20,15,60 Box "°°°°°°"
Shadow(13,20,15,60)
Set Color To
I = 0
Do While .T.
Set Color To W+/N
@ 14,22 Say Space(38)
@ 14,22 Say "Enter Password :::::"
xxx = Password("JAKE",Chr(237))
if i = 3
For X = 1 To 25
 Scroll(00,00,24,40,1)
 Scroll(00,41,24,79,-1)
 inkey(.1)
Next X
Set Cursor Off
 Warning1 = "SORRY YOU CANNOT ACCESS THE SYSTEM. ASK FOR THE CORRECT"
 Warning2 = "PASSWORD AND TRY AGAIN. GOOD LUCK !!!"
 Title3   = "SERVO Software Unlimited 2001"
Set Color To W/Bg+
 @ 1,1 Clear To 5,75
 @ 1,1 To 5,75 Double
 Set Color To
 Set Color to GR+/Bg
 @ 2,Int(80-Len(Warning1))/2 Say Warning1
 @ 3,Int(80-Len(Warning2))/2 Say Warning2
 Set Color To
   Tone(440,1)
   Tone(392,2)
   Tone(349,1)
   Tone(626,1)
   Tone(209,1)
   Tone(102,1)
 Set Color to G+*/BG+
 @ 4,Int(80-Len(Title3))/2 Say Title3
 Set Color To
 @ 7,1 Say " "
Set Cursor On
  Quit
endif
if !xxx
   i = i + 1
   Set Cursor Off
   Setcolor("W/BG")
   @ 18,08 Clear To 20,75
   @ 18,08 To 20,75
   Shadow(18,08,20,75)
   Set Color To R+/Bg
   Title1 = "  WARNING !!! INTRUDER DETECTED IN THE SYSTEM.  ACCESS DENIED."
   @ 19,int(80-LEN(Title1))/2 Say Title1
   Set Color To
   Tone(261,2)
   Tone(349,1)
   Tone(493,2)
   Tone(440,1)
   Tone(392,2)
   Tone(349,1)
   Tone(329,1)
   Tone(311,2)
   delay=inkey(1)
   Set Color To
   @ 18,07 Say Replicate(Chr(177),71)
   @ 19,07 Say Replicate(Chr(177),71)
    @ 20,07 Say Replicate(Chr(177),71)
    @ 21,07 Say Replicate(Chr(177),71)
  Set Color To
     SEt Cursor On
   loop
  else
  Set Color To
   clear
 *  do menu
   @ 00,00 Say "Okey!!!"
  quit
   endif
   enddo

   Function Password
   Para str1,charrepl
   private dummy,ch,row,col,len
   col = col()
   row = row()
   dummy = ""
   len = len(str1)
   do while .T.
   ch = inkey(0)
   do case
    case ch = 8 .or. ch = 19
     if (len(dummy) > 0)
      dummy = substr(dummy,1,len(dummy)-1)
      endif
      case Isalpha(chr(ch))
       if (len(dummy) < len)
       dummy = dummy + chr(ch)
       else
       dummy = stuff(dummy,len(dummy),len(dummy),chr(ch))
       endif
       case ch = 13
       exit
       case ch = 27
       exit
       Endcase
        @ row,col Say space(len)
       @ row,col say Replicate(charrepl,len(dummy))
       enddo
       if upper(dummy) = str1
       return .t.
       else
       return .f.
       endif

      Procedure Shadow
      para t,l,b,r
      Private black,White,DR_gray,;
      Col_Shadow_Attribute,BW_Shadow_Attribute,;
      Shadow_Attribute
      Black   = 1
      White   = 7
      DR_Gray = 8
      Col_Shadow_Attribute = (DR_Gray) + (Black)
      BW_Shadow_Attribute =  (White) + (Black)
      if IsColor()
         Shadow_Attribute = Col_Shadow_Attribute
      Else
      Shadow_Attribute = BW_Shadow_Attribute
       endif
      Sha_Attr(b+1,l+2,b+1,r+2,shadow_Attribute)
      Sha_Attr(t+1,r+1,b+1,r+2,shadow_Attribute)
return

Procedure Sha_Attr
Para t,l,b,r,new_attr
private old_scr_area, new_scr_area,i
old_scr_area = SaveScreen(t,l,b,r)
new_scr_area = ""
For I = 1 to Len(Old_scr_area) Step 2
   new_scr_area = New_scr_area + Substr(old_scr_area,i,1)+;
   chr(new_attr)
   next
   RestScreen(t,l,b,r,new_scr_area)
   return