Thanks a lot!
-Pete
Eliel Carrero
<elielc1@yahoo.com> to me 1:52am (5 hours ago)
Hello Pete. I'm Eliel Carrero, I am a student in college in
Allentown, PA. I am studying computer programming and it is difficult for
me. Can you give me a hand here with a program? I'm trying to build a
phonebook program with QB. So far, I got the program to create and open
files and so far I can add names, SS#,zipcodes, city,state and other
stuff but when I want to lookup the names, if I don't have a record in the
file it'll mark an error and for some occasions my program can't read
the record or freezes. The problem seems to be in the Lookup section or
in one of the subroutines of the lookup section. I attached my program
to this email(phonebk2.txt). I hope you can help me here. My teacher is
helping me but little. If you can't, just let me know. Thanks for taking
the time to read this email.
Code: Select all
CLS
'copyright 2004
clr = 9 'Sets color
row = 10 'Row Position
col = 30 'Column Position
COLOR clr 'Also sets color (unsure of it's purpose)
GOSUB O.employee 'Opens Employee files
GOSUB O.zip 'Opens Zip files
GOSUB O.name 'Opens name files
GOSUB O.ss 'Open SS files
'**************************** Main Menu Display Page ********************************************
' ----------------------
Main.menu: 'This is the Main Menu where user
CLS 'runs program. Here you add records,
LOCATE row, col 'edit records, lookup records, delete
PRINT "Eliels' Phone Book" 'or go to utility menu or quit.
LOCATE row + 1, col
GOSUB rec.no
PRINT "Number of Records "; numrec
LOCATE row - 3, col ' All these lines of code in
PRINT " MAIN MENU" ' The given space display the
LOCATE row - 2, col ' Printed text and their specific
PRINT " ---------" ' Location with the exception of
LOCATE row + 2, col ' The last 3 lines of code.
PRINT "--------------------"
LOCATE row + 3, col
PRINT "(A)dd Record"
LOCATE row + 4, col
PRINT "(E)dit Record"
LOCATE row + 5, col
PRINT "(L)ookup Record"
LOCATE row + 6, col
PRINT "(D)elete Record"
LOCATE row + 7, col
PRINT "(U)tility Menu"
LOCATE row + 8, col
PRINT "(Q)uit Program"
PRINT
LOCATE row + 10, col - 6
PRINT "Choice ";
COLOR clr + 3 ' Sets the "*" color.
PRINT "*" ' Display the "*".
COLOR clr ' Control color settings?unsure.
'*************************** COMMAND MAIN MENU ************************************
' This is the Comand Main Menu where
' the program is commanded to do a
' certain function in the Main Menu.
DO
choice$ = UCASE$(INKEY$)
IF choice$ = "Q" OR choice$ = CHR$(13) THEN
CLS 'Press "Q" or "Enter" to end program
END
END IF
IF choice$ = "A" THEN 'Press "A" to go to addrecords page.
GOSUB Addrecord
END IF
IF choice$ = "E" THEN 'Press "E" to Edit record (Incomplete).
END IF
IF choice$ = "L" THEN 'Press "L" to Lookup records (Incomplete).
GOSUB search.menu
END IF
IF choice$ = "U" THEN 'Press "U" to go to the Utility menu.
GOSUB Utility.menu
END IF
IF choice$ = "D" THEN 'Press"D" to Delete record (Incomplete).
END IF
LOOP
'************************* UTILITY MENU DISPLAY PAGE ******************************
Utility.menu: ' Displays Utility menu page.(Also used
CLS 'as a subroutine by Command Main Menu).
' -----------------
LOCATE row + 1, col ' Displays text "utility menu".
PRINT " UTILITY MENU"
LOCATE row + 2, col
PRINT "---------------------"
LOCATE row + 3, col
PRINT "(I)nitialize Database" ' Press "I" to initialize database.
LOCATE row + 4, col
PRINT "(R)ebuild Key Files"
' Press "R" to rebuild key files.
LOCATE row + 5, col
PRINT "(M)ain Menu" ' Press "M" to go to main menu.
LOCATE row + 7, col - 6
PRINT "Choice";
COLOR clr + 5 ' Already explained in Main Menu slide above.
PRINT "*" ' ---------
COLOR clr
'*************************** COMMAND UTILITY MENU ***************************
' This is the Comand Utility Menu where
' the program is commanded to do a
' certain function in the Utility Main Menu.
DO
choice$ = UCASE$(INKEY$)
IF choice$ = "M" THEN ' Press "M" to go to main menu
RETURN Main.menu
END IF
IF choice$ = "I" THEN ' Incomplete
END IF
IF choice$ = "R" THEN ' When "R" is pressed, program goes
GOSUB create.key.file ' to gosub Create.files and then to
GOSUB Sort.name.ss ' Sort.name.ss.
END IF
IF choice$ = CHR$(13) THEN ' Press "Enter" to go to main menu.
GOTO Main.menu
END IF
LOOP
'************************ COMMAND ADD.RECORD ****************************************************
Addrecord:
DO
CLS
GOSUB Display.data ' Goes to Display.data subroutine.
LOCATE 1, 15
INPUT "", dat$
IF dat$ = "" THEN ' If name field is left blank, program
GOSUB create.key.file
GOSUB Sort.name.ss
RETURN Main.menu ' will return to main menu.
END IF
LSET name$ = UCASE$(dat$)
LOCATE 2, 15 ' The next 18 lines of code are
INPUT "", dat$ ' For User to input data to the record.
LSET street$ = UCASE$(dat$)
LOCATE 3, 15
INPUT "", dat$
LSET zip$ = UCASE$(dat$)
LOCATE 4, 15
INPUT "", dat$
LSET city$ = UCASE$(dat$)
LOCATE 5, 15
INPUT "", dat$
LSET state$ = UCASE$(dat$)
LOCATE 6, 15
INPUT "", dat$
LSET phone$ = UCASE$(dat$)
LOCATE 7, 15
INPUT "", dat$
LSET ss$ = UCASE$(dat$)
GOSUB rec.no
PUT #1, nxtrec
LOOP
'******************** ADD.RECORD DISPLAY PAGE (As Subroutine) **************************************************
Display.data:
PRINT "Name"
PRINT "Street" ' This is what you will see in the
PRINT "Zip Code" ' Add.record Display Page.
PRINT "City"
PRINT "State"
PRINT "Phone"
PRINT "SS Number"
RETURN
'********************************** ??????? ******************************************
'Subs here
' This is a subroutine which commands
' program to create key file but I'm not
' sure how it works and relates to the program.
create.key.file: ' Subroutine used by Command Utility Menu.
GOSUB rec.no
FOR record = 1 TO numrec
GET #1, record
LSET k.name$ = UCASE$(name$)
LSET k.name.pointer$ = STR$(record)
LSET k.ss$ = ss$
LSET k.ss.pointers$ = STR$(record)
PUT #3, record
PUT #4, record
NEXT record
RETURN
'************************* FILES BEING OPENED *********************************
' All information of
' The records User writes
' Will end up here.
O.employee:
OPEN "R", #1, "C:\qb4.5\employee.dat", 256
FIELD #1, 40 AS name$, 40 AS street$, 10 AS zip$, 30 AS city$, 2 AS state$, 12 AS phone$, 11 AS ss$, 111 AS nul0$
RSET nul0$ = "EOR"
RETURN
O.zip:
OPEN "R", #2, "C:\qb4.5\zip.dat", 64
FIELD #2, 5 AS k.zip$, 30 AS k.city$, 2 AS k.state$, 27 AS nul1$
RSET nul1$ = "EOR"
RETURN
O.name:
OPEN "R", #3, "C:\qb4.5\name.dat", 64
FIELD #3, 40 AS k.name$, 10 AS k.name.pointer$, 14 AS nul2$
RSET nul2$ = "EOR"
RETURN
O.ss:
OPEN "R", #4, "C:\qb4.5\ss.dat", 32
FIELD #4, 11 AS k.ss$, 10 AS k.ss.pointer$, 11 AS nul3$
RSET nul3$ = "EOR"
RETURN
END ' *** REC.NO SUBROUTINE HERE!!! ***
rec.no: ' ----------------------
numrec = LOF(1) / 256
nxtrec = numrec + 1
RETURN
'*************** (Subroutine) FILES BEING OPENED ****************************************************
' ------------
' This Subroutine opens the
' 4 data files seen below.
All.files.open: 'This subroutine is used by Sort.name.ss (subroutine
GOSUB O.employee 'Opens Employee files
GOSUB O.zip 'Opens Zip files
GOSUB O.name 'Opens name files
GOSUB O.ss 'Open SS files
RETURN
'************************ SORT.NAME.SS (Subroutine) **************************
Sort.name.ss:
GOSUB rec.no
CLOSE
OPEN "R", #3, "C:\QB4.5\name.dat", 64
FIELD #3, 64 AS dat$
rec.len = 40
tempFlag = 3
GOSUB Bubble.sort
CLOSE
OPEN "R", #4, "C:\QB4.5\ss.dat", 32
FIELD #4, 32 AS dat$
rec.len = 11
tempFlag = 4
GOSUB Bubble.sort
GOSUB All.files.open
RETURN
'*************************** BUBBLE SORT (Subroutine) ****************************************
Bubble.sort:
limit = numrec
switch$ = "on"
DO WHILE switch$ = "on"
switch$ = "off"
FOR count = 1 TO (limit - 1)
GET tempFlag, count
record.first$ = dat$
GET tempFlag, count + 1
record.first.plus.1$ = dat$
IF LEFT$(record.first$, rec.len) > LEFT$(record.first.plus.1$, rec.len) THEN
SWAP record.first$, record.first.plus.1$
LSET dat$ = record.first$
PUT tempFlag, count
LSET dat$ = record.first.plus.1$
PUT tempFlag, count + 1
switch$ = "on"
last = count
END IF
NEXT count
limit = last
LOOP
CLOSE
RETURN
'************************** LOOKUP RECORD DATA ******************************
OPEN "R", #3, "c:\qb4.5\data\name.dat", 64
FIELD #3, 40 AS k.name$, 10 AS k.name.pointer$, 14 AS nul2$
RSET nul2$ = "EOR"
Start:
CLS
INPUT "Enter Name To Find "; name.to.be.found$
IF name.to.be.found$ = "" THEN
END
END IF
GOSUB Search1
IF rec.number% = 0 THEN
PRINT "Record Not Found"
SLEEP 5
GOTO Start
END IF
PRINT
PRINT "Name "; RTRIM$(k.name$); " Found In Record Number"; rec.number%
SLEEP 3
GOTO Start
'************************ subroutine: SEARCH1 *********************************
Search1: ' -------
' *** BINARY SEARCH FOR CONTACT ***
GOSUB rec.no
rec.upper% = numrec
rec.lower% = 0
name.to.be.found$ = UCASE$(name.to.be.found$)
name.to.be.found.length% = LEN(name.to.be.found$)
mid.point% = CINT((rec.upper% + rec.lower%) / 2)
IF mid.point% = 0 THEN
rec.number% = 0
RETURN
END IF
rec.number% = 0
'/************************* subroutine: REDO **********************************
Redo: ' ----
GET #3, mid.point%
IF flagMid = mid.point% THEN
rec.number% = 0
RETURN
END IF
flagMid = mid.point%
IF name.to.be.found$ = LEFT$(k.name$, name.to.be.found.length%) THEN
rec.number% = VAL(k.name.pointer$)
RETURN
END IF
IF (rec.lower% >= rec.upper%) THEN
rec.number% = 0
RETURN
END IF
IF rec.number% <> 0 THEN
RETURN
END IF
IF name.to.be.found$ > LEFT$(k.name$, name.to.be.found.length%) THEN
rec.lower% = mid.point%
mid.point% = CINT((rec.upper% + rec.lower%) / 2)
GOTO Redo
END IF
rec.upper% = mid.point%
mid.point% = CINT((rec.upper% + rec.lower%) / 2)
GOTO Redo
'************************ SEARCH FOR EXISTING RECORDS **********************************
search.menu: ' ---------------------------
CLS
INPUT "Enter Name or Social Security Number "; name.ssn$
IF name.ssn$ = "1" THEN
GOSUB name.search
END IF
'************************* SEARCH FOR NAME **************************************
name.search: ' ---------------
CLS
INPUT "Enter Name "; name.to.be.found$
IF name.to.be.found$ = "" THEN
GOTO Main.menu
END IF
GOSUB Search1
IF rec.number% = 0 THEN
PRINT "Record not found"
SLEEP 3
GOTO Search1
END IF
PRINT
PRINT "Name "; RTRIM$(k.name$); " found in record number "; rec.number%
SLEEP 3
GOTO name.search
RETURN
'/************************* END OF LOOKUP************************************
