Addition of Two Numbers Using Function in Turbo Pascal

A very simple program that I wrote that will ask the user to give two numbers and then our program will compute the sum of the two numbers using function in Turbo Pascal.

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

Program Addition;

Uses Crt;

Var A,B  : Integer;

    Ch   : Char;

Function Add(Var C,D : Integer) : integer;

Begin

 Add := C + D;

End;

Begin

 Repeat

 Clrscr;

 Write('Enter the First Value :');

 Readln(A);

 Write('Enter the First Value :');

 Readln(B);

 Writeln;

 Write('The sum of two values is',' ',Add(A,B));

 Writeln;

 Writeln;

 Repeat

 Write('Do You Want To Continue y/n ? ');

 Ch := Upcase(Readkey);

 Until Ch in ['Y','N'];

 Clrscr;

 Until Ch = 'N';

 Exit;

 Readln;

End.

Add Record in Clipper Summer '87

A simple program that I wrote using Nantucket Clipper Summer '87 a very long time ago while I am working as a freelance database developer using DOS environment.

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

********************************

** Payroll System

** Add Employees Record Routine

** Add.Prg

** Author : Jake R. Pomperada

** Language : Clipper Summer '87

** Date : March 07,2001

********************************

Set Talk Off

Set Echo Off

* Set Escape Off

Set Scoreboard Off

Set Procedure To Kes

Set Procedure To Sys

Set Procedure To Pass

Set Cursor On

Set Wrap On

Set Century On

Set Safety Off

Set Confirm Off

Set Delimiters On

Set Delimiters to "[]"

Set Cursor On

Set Decimal to 2

Set Message to 24

Clear Typeahead

Clear Memory

Clear Screen

@ 1,3 Clear To 23,79

@ 1,3 To 23,79 Double

Set Color To W/N

@ 2,12 Clear to 3,65

XTitle1 = Chr(5) + " ADD EMPLOYEES RECORD ROUTINE " + Chr(5)

Set Color To W+/N

@ 2,8 Say xTitle1

Set Color To

@ 3,4 Say Replicate("=",75)

Set Color To GR+/N

@ 2,62 Say "Date: " + Dtoc(Date())

Set Color To

@ 04,6 Clear To 22,77

Set color To Bg+/N

@ 4,52 Say "ESC -> Return To Main Menu"

Set Color To

Do While .T.

Use Pay

Index on ChapaNo to Xchapa

Reindex

Store 0 To XChapaNo

Store 0.00 To XSalaryRate

Store 0.00 To XTaxUnits

Store 0.00 To XST

Store 0.00 To XROT

Store 0.00 To XPOT

Store 0.00 To XEMERALLOW

Store 0.00 To ST2

Store 0.00 To ROT2

Store 0.00 To POT2

Store 0.00 To XWithTax

Store 0.00 To XPagibig

Store 0.00 To XPH

Store 0.00 To XSSS

Store 0.00 To XEMPLOYACC

Store 0.00 To XPhilH

Store 0.00 To XGross

Store 0.00 To XGrossTotal

Store 0.00 To XTotalNetPay

Store 0.00 To XTotalDeduc

Store 0.00 To XTotalDeduction

Store 0.00 To XYRTDGross

Store 0.00 To XYRTDWTax

Store Ctod(" / / ") To XDate

Store Space(25) to XLname

Store Space(20) to XFname

@ 04,8 Say "CHAPA NO.............þ " Get XChapaNo Pict "9999999999"

Read

If readkey() = 12

Return

*do kes

endif

XFind = XChapaNo

Seek XFind

if empty(XChapaNo)

    Tone(200,2)

    Tone(341,2)

    Set Cursor Off

    Set Color To N/W

    @ 10,11 Clear To 12,53

    @ 10,11 To 12,53

    @ 11,16 say 'SORRY CHAPA NO. CANNOT BE EMPTY.'

    Set Color To

    Xdelay=inkey(2)

    Set Cursor On

    @ 10,11 Clear To 12,53

    Loop

 endif

 If Found()

    Tone(200,2)

    Tone(341,2)

    Set Cursor Off

    Set Color To N/W

    @ 13,14 Clear To 15,57

    @ 13,14 To 15,57

    @ 14,16 say 'SORRY DUPLICATE RECORDS IS NOT ALLLOWED.'

    Set Color To

    Xdelay=inkey(2)

    Set Cursor On

    @ 13,14 Clear To 15,57

    Loop

  endif

If .NOT. Found()

@ 05,8 Say "PAY ENDING...........þ " Get XDate  Pict "99/99/9999"

@ 06,8 Say "LASTNAME.............þ " Get XLName Pict "@!"

@ 07,8 Say "FIRSTNAME............þ " Get XFName Pict "@!"

@ 08,8 Say "SALARY RATE..........þ " Get XSalaryRate Pict "99999999.99"

@ 09,8 Say "TAX UNITS............þ " Get XTaxUnits Pict "99999999"

SetColor("W+/N")

@ 10,25 Say "GROSS PAY"

Set Color To

@ 11,8 Say "STRAIGHT TIME........þ " Get XST Pict "9999999.99"

@ 12,8 Say "REGULAR O/T..........þ " Get XROT Pict "9999999.99"

@ 13,8 Say "PAID O/T.............þ " Get XPOT Pict "999999999.99"

@ 14,8 Say "PAID HOLIDAY.........þ " Get XPH Pict "999999999.99"

@ 15,8 Say "EMERGENCY ALLOWANCE..þ " Get XEMERALLOW Pict "999999999.99"

Read

If readkey() = 12

Return

*do kes

endif

ST2  =  XSt  * XSalaryRate / 8

ROT2 =  XRot * XSalaryRate / 8 * 1.25

POT2 =  XPot * XSalaryRate / 8 * 1.30

@ 16,8 Say "STRAIGHT TIME........þ " + ' '+Str(ST2,10,2)

@ 17,8 Say "REGULAR O/TIME.......þ " + ' '+Str(ROT2,10,2)

@ 18,8 Say "PAID O/TIME..........þ " + ' '+Str(POT2,10,2)

@ 19,8 Say "PAID HOLIDAY.........þ " + ' '+Str(XPH,10,2)

@ 20,8 Say "EMERGENCY ALLOWANCE..þ " + ' '+Str(XEMERALLOW,10,2)

XTOTALGross = ST2+ROT2+POT2+XPH+XEMERALLOW

Set Color TO W+/N

@ 22,8 Say "TOTAL GROSS..........þ " + ' '+Str(XTOTALGROSS,10,2)

Set Color To

XTotalNetPay = XTotalGross - XTotalDeduc

if xTotalNetPay <= 3000

 xphilh = 37.50

 endif

if xTotalNetPay >= 3500

 xphilh = 43.75

 endif

if xTotalNetPay >= 4000

 xphilh = 50.00

 endif

if xTotalNetPay >= 4500

 xphilh = 56.25

 endif

if xTotalNetPay >= 5000

 xphilh = 62.50

 endif

if xTotalNetPay >= 5500

 xphilh = 68.75

 endif

if xTotalNetPay >= 6000

 xphilh = 75.00

 endif

if xTotalNetPay >= 6500

 xphilh = 81.25

 endif

if xTotalNetPay >= 7000

 xphilh = 87.50

 endif

if xTotalNetPay >= 7500 .or. xTotalNetPay >= 30000

 xphilh =93.75

 endif

Set Color TO W+/N

@ 09,55 Say "DEDUCTIONS"

Set Color To

@ 10,47 Say "WHOLDING TAX.....þ" Get XWithTax Pict "9999999.99"

@ 11,47 Say "SSS PREMIUM......þ" Get XSSS Pict "9999999.99"

@ 12,47 Say "PAG-IBIG.........þ" Get XPAGIBIG Pict "9999999.99"

@ 13,47 Say  "EMPLOYEE ACCT....þ" Get XEMPLOYACC Pict "9999999.99"

@ 14,47 Say "PHILHEALTH.......þ" + ' ' +Str(XPhilh,10,2)

* Get XPHILH Pict "9999999.99"

Read

Set Color To W+/N

XTotalDeduc = XWithTax+XSSS+XPAGIBIG+XEMPLOYACC+XPHILH

XTotalNetPay = XTotalGross - XTotalDeduc

@ 16,47 Say "TOTAL DEDUCTION..þ " + ' ' +Str(XTotalDeduc,10,2)

@ 17,47 Say "TOTAL NET PAY....þ " + ' ' +Str(XTotalNetPay,10,2)

Set Color To

@ 19,47 Say "YR.TO DATE GROSS.þ" Get XYRTDGROSS Pict "9999999.99"

@ 20,47 Say "YR.TO DATE W/TAX.þ" Get XYRTDWTAX Pict "9999999.99"

Read

If readkey() = 12

Return

*do kes

endif

endif

Mess1 = "    SAVING EMPLOYEES RECORD IN DATABASE FILE."

Mess2 = "    CHANGE OR UPDATE THE EMPLOYEES RECORD."

Mess3 = "    ABORT OPERATION AND RETURN TO MAIN MENU."

Set Color To W+/n,W+*/W,W/N

@ 22,48 Prompt " SAVE "   Message Mess1

@ 22,57 Prompt " EDIT "   Message Mess2

@ 22,65 Prompt " CANCEL "  Message Mess3

Menu To XChoice

Do Case

 Case XChoice = 1

 Tone(345,2)

 Tone(145,2)

 Case XChoice = 2

 Tone(345,2)

 Tone(145,2)

 Case XChoice = 3

 Tone(345,2)

 Tone(145,2)

endcase

Set Color To

*sdelay=inkey(4)

* do kes

Return

enddo

Menu Program in Clipper Summer '87

A menu program that I wrote using Nantucket Clipper Summer '87 a very long time ago.

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

***************************

** MAIN.PRG

** MENU PROGRAM

** AUTHOR   : JAKE R. POMPERADA

** DATE     : MARCH 06,2001

** LANGUAGE : CLIPPER SUMMER '87

****************************

Set Talk Off

Set Echo Off

Set Scoreboard Off

Set Status Off

Set Safety Off

Set Escape Off

Set Wrap On

Set Procedure To Add

Set Procedure To Pass

Set Procedure To Sys

Set Message to 21 Center

Clear Memory

Clear Typeahead

Clear Screen

Do While .T.

@ 1,3 Clear To 24,79

@ 1,3 To 24,79 Double

@ 2,4,23,78 BOX Replicate(Chr(177),10)

Set Color To w+/N

@ 3,6 Clear To 17,27

@ 3,6 To 17,27 Double

Shadow(3,6,17,27)

Set Color To

Set Color TO B+/N

@ 20,10 Clear To 22,68

@ 20,10 TO 22,68

Set Color To

Set Color To W+/Bg

@ 3,32 Clear To 12,74

@ 3,32 To 12,74

Shadow(3,32,12,74)

Title1 = "XYZ CONSTRUCTION SERVICES"

Title2 = "Genovea Compound, C.V. Ramos Avenue"

Title3 = "Taculing Bacolod City 6100."

Title4 = "Mr. John Smith"

Title6 = "Owner / Manager"

DateNow = CMonth(date()) + Chr(32)+ Str(day(date()),2) +;

          ','+Chr(32) + Str(Year(Date()), 4)

TITLE5 = "Developed By: SERVO Software Unlimited."

SetColor("GR+/BG")

@ 04,34 Say Title1

SetColor("W+/Bg")

@ 05,36 Say Title2

@ 06,39 Say Title3

SetColor("B+/Bg")

@ 08,39 Say Title4

Set Color To

Set Color To R/Bg

@ 09,46 Say Title6

Set Color To

Set Color To GR+/Bg

@ 10,41 Say "Date: " + DateNow

Set Color To G+/BG

@ 11,34 Say Title5

Set Color To

Set Color To W+/Bg

@ 15,32 Clear To 18,68

@ 15,32 To 18,68

XGuide1 = "USE THE Up AND Down ARROW KEYS"

XGuide2 = "TO NAVIGATE THE MAIN MENU  "

Char = Chr(024)+ " "+ Chr(025)

Set Color To

Set Color To GR+/Bg

@ 16,34 Say XGuide1

@ 17,34 Say XGuide2

Set Color To G+*/Bg

@ 17, 60 Say Char

Set Color To

Mess1= "ADD EMPLOYEES TO DATABASE FILE"

Mess2= "CHANGE AND UPDATE EMPLOYEES RECORDS"

Mess3= "ERASE EMPLOYEES RECORDS IN DATABASE FILE"

Mess4= "GENERATE PRINTED REPORTS."

Mess5= "DATABASE FILE BACK-UP,REINDEX, ZAP RECORDS"

Mess6= "QUIT KES PAYROLL SYSTEM"

Set Color To GR+/N

@ 04,13 Say  "MAIN MENU "

Set Color To

@ 06,8 Prompt "A> DD EMPLOYEES    "  Message  Mess1

@ 08,8 Prompt "U> PDATE RECORDS   "  Message  Mess2

@ 10,8 Prompt "E> RASE RECORDS    "  Message  Mess3 

@ 12,8 Prompt "G> ENERATE REPORTS "  Message  Mess4

@ 14,8 Prompt "S> YSTEM UTILITY   "  Message  Mess5

@ 16,8 Prompt "Q> UIT PROGRAM     "  Message  Mess6

Menu To Choice

Do Case

 Case Choice = 1 

 Tone(226,1)

 Tone(341,1)

 Add()

 Case Choice = 2

 Tone(152,1)

 Tone(341,1)

 Case Choice = 3

 Case Choice = 4 

 Case Choice = 5 

 Tone(452,1)

 Tone(741,1)

 Do Sys.Prg

 Case Choice = 6

 Tone(452,1)

 Tone(741,1)

 xExit()

EndCase

Set Color To

Enddo

Return

Procedure xExit

@ 20,8 Say Replicate(Chr(177),61)

@ 21,8 Say Replicate(Chr(177),61)

@ 22,8 Say Replicate(Chr(177),61)

@ 16,30 Say Replicate(Chr(177),6)

@ 17,30 Say Replicate(Chr(177),6)

@ 15,32 Say Replicate(Chr(177),8)

@ 18,30 Say Replicate(Chr(177),6)

Set Color To W+/Bg

@ 15,35 Clear To 18,75

@ 15,35 To 18,75 Double

Shadow(15,35,18,75)

Set Color To

Set Color To G/Bg+

@ 16,42 Say "QUIT PAYROLL SYSTEM PROGRAM ?"

Set Color To

Set Message to 21 Center

Set Color To B+/N

@ 20,10 Clear To 22,68

@ 20,10 TO 22,68

Set Color To

QTitle1 = "EXIT PAYROLL PROGRAM AND RETURN TO DOS"

QTitle2 = "RETURN TO PAYROLL PROGRAM SYSTEM MAIN MENU"

Set Color To N+*/Bg

@ 17,44 Prompt "  Y> ES  " Message QTitle1

@ 17,58 Prompt "  N> O   " Message QTitle2

Set Color To

Menu To XChoice

Do Case

Case XChoice = 1

For X = 1 To 25

 Scroll(00,00,24,40,1)

 Scroll(00,41,24,79,-1)

 inkey(.1)

Next X

Clear

Inkey(1)

Set Cursor Off

SetColor("W+/BG")

@ 1,1 Clear to 4,80

@ 1,1 To 4,80 Double

Set Color To

Set Color To G+/Bg

Set Color To

Set Color To G+/Bg

Fin1 = " KONSTRUCTION ENGINEERING SERVICES PAYROLL SYSTEM Version 1.0"

Fin2 = " Developed By: SERVO Software Unlimited 2001." + Chr(234)

Set Color To B+/Bg

@ 2,Int(80-Len(Fin1))/2 Say Fin1

Set Color To

Set Color To GR+*/Bg

@ 3,Int(80-Len(Fin2))/2 Say Fin2

Set Color TO

@ 5,1 Say " "

Set Cursor On

Do Jeopardy

Quit

Case XChoice = 2

Tone(201,3)

Tone(931,2)

Do Kes

EndCase

Set Color To

Return

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
    

Login Security in Clipper Summer 87

Here is a sample program that I wrote more than 20 years ago a login security program that I wrote using Clipper Summer '87 I hope you find my work useful.

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

login.prg

save screen to sPassword

clear

cUser = space(10)

cPwds = 'fctc      bacolod   ±'

nTrys = 0

@ 10,27 say 'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ '

@ 11,27 say '³ Login User :            ³Û'

@ 12,27 say '³ Password   :            ³Û'

@ 13,27 say 'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙÛ'

@ 14,27 say '  ßßßßßßßßßßßßßßßßßßßßßßßßßß'

do while .t.

    set color to w/n,w/n,,,w/n

    @ 11,42 get cUser valid .not. empty(cUser)

    read

    if lastkey() = 27

        lAccess = .f.

        exit

    endif

    set confirm on

    set color to x/x

    set cursor off

    set intensity off

    cKeys = space(10)

    @ 12,42 get cKeys picture '@S1' valid .not. chr(177) $ cKeys

    read

    set confirm off

    set color to

    set cursor on

    set intensity on

    nTrys = iif(lastkey()#27,nTrys+1,nTrys)

    do case

        case lastkey() = 27

            lAccess = .f.

            exit

        case cUser+cKeys $ cPwds

            select 100

            use users

            locate for user = cUser

            if .not. found()

                append blank

            endif

            replace user with cUser,;

                    date with date(),;

                    time with time()

            lAccess = .t.

            exit

        case nTrys > 2

            clear

            set color to w+

            @ 12,27 say 'A C C E S S  D E N I E D ...'

            set colo to

            tone(300,1)

            tone(499,5)

            tone(700,5)

            inkey(5)

            lAccess = .f.

            exit

    endcase

enddo

restore screen from sPassword

return

* --- EOF