ADDRESS MANAGER
Posted: Tue Jul 21, 2020 6:56 pm
I needed an Address Manager for my PC and I decided to obtain or produce one written in Liberty Basic. After searching LB, LBB and JB, I finally found one in the JB Archives written by jabas http://jbfilesarchive.com/phpBB3/viewto ... f=3&t=1501. It is not as complicated as some that I looked at and was an Address Manager, rather than a Contact Manager (I’m way past needing a Contact Manager). The layout needed adjustment to meet my needs and I also changed the size of fonts and smartened up the controls.
The code below is the result. I am most grateful to jabas for his code (which makes up almost all of it), so any credit is due to him. I’m just a modifier. Although I am loath to say it, the code also runs on both LB and JB, but I shan’t post it on their web sites because I was banned. If someone wishes to do so, I have no objection. The code came from JB anyway.
I have found the program to be most useful. I hope others may also find it so.
The code below is the result. I am most grateful to jabas for his code (which makes up almost all of it), so any credit is due to him. I’m just a modifier. Although I am loath to say it, the code also runs on both LB and JB, but I shan’t post it on their web sites because I was banned. If someone wishes to do so, I have no objection. The code came from JB anyway.
I have found the program to be most useful. I hope others may also find it so.
Code: Select all
'=========================
' My Address Book
' by RNBW 20 July 2020 (but all credit to jabas)
'
' Adapted from JABAS Address Cardfile
' by jaba 16 Aug 2009
' All content free to use.
'=========================
' MyAddressBookV1.bas
' 20 July 2020
'=========================
'GLOBAL VARIABLES
global path$, noRec, DBFname$
' Assign file and path info to variables
path$ = DefaultDir$
DBFname$ = "contactme.txt"
nomainwin
WindowWidth = 480
WindowHeight = 610
UpperLeftX = 20
UpperLeftY = 20
statictext #main, " Name/Company:", 20, 25, 110, 20
stylebits #main.textName, _ES_LEFT, _WS_BORDER, 0, 0
textbox #main.textName, 150, 20, 300, 25
statictext #main, "Tel:", 20, 55, 45, 20
stylebits #main.textPhone, _ES_LEFT, _WS_BORDER, 0, 0
textbox #main.textPhone, 150, 50, 110, 25
statictext #main, "Mob:", 300, 55, 35, 20
stylebits #main.textCell, _ES_LEFT, _WS_BORDER, 0, 0
textbox #main.textCell, 340, 50, 110, 25
statictext #main, "Address:", 20, 85, 100, 20
stylebits #main.textAddress, _ES_LEFT, _WS_BORDER, 0, 0
textbox #main.textAddress, 150, 80, 300, 25
statictext #main, "City:", 20, 115, 45, 20
stylebits #main.textCity, _ES_LEFT, _WS_BORDER, 0, 0
textbox #main.textCity, 150, 110, 300, 25
statictext #main, "County:", 20, 145, 100, 20
stylebits #main.textSt, _ES_LEFT, _WS_BORDER, 0, 0
textbox #main.textSt, 150, 140, 130, 25
statictext #main, "Zip:", 300, 145, 20, 20
stylebits #main.textZip, _ES_LEFT, _WS_BORDER, 0, 0
textbox #main.textZip, 340, 140, 110, 25
statictext #main, " E-Mail:", 20, 175, 45, 20
stylebits #main.textEmail, _ES_LEFT, _WS_BORDER, 0, 0
textbox #main.textEmail, 150, 170, 300, 25
statictext #main, " Notes:", 20, 235, 45, 20
stylebits #main.textNotes, _ES_LEFT OR _WS_VSCROLL OR _ES_MULTILINE, _WS_BORDER OR _ES_AUTOHSCROLL, 0, 0
textbox #main.textNotes, 150, 230, 300, 100
statictext #main, " Contacts:", 20, 335, 100, 15
statictext #main.totRecs, " ", 30, 365, 30, 20
button #main.btnSave, "Save", [btnSaveClicked], UL, 375, 480, 75, 25
button #main.btnExit, "Exit", [btnExitClicked], UL, 375, 510, 75, 25
button #main.btnClear,"Clear",[btnClearClicked], UL, 375, 450, 75, 25
button #main.btnEdit, "Edit Help", [btnEditHelpClicked], UL, 210, 540, 80, 22
button #main.btnHelp, "?", [btnHelpClicked], UR, 15, 4, 18, 18
button #main.btnSaveEdit, "Save Edit",[btnSaveEdit] ,UL, 295, 540, 60, 22
button #main.btnDelete,"Delete",[btnDeleteClicked], UL, 150, 540, 55, 22
stylebits #main.lbx, _ES_LEFT, _WS_BORDER, 0, 0
listbox #main.lbx, address$(, [displayContactInfo], 150, 335, 205, 200
statictext #main.helpme, "", 350, 2, 40, 15
'see if data file exists?
'thanks to Noble Bell
dim Info$(10, 10)
If fileExists(path$, DBFname$) = 0 then
confirm "The contacts file does not exist." + chr$(13) +_
"Do you want to create the file?"; answer$
If answer$ = "no" then
notice "The program must end until you create a new contacts file."
close #main
end
end if
'no database, so create one
open DBFname$ for output as #new
close #new
notice "The contacts file has been created."
end if
'open database and fill arrays - rs$, recA$
gosub [fillContactsArray]
'Fill listbox array - address$()
gosub [fillListbox]
'set GUI colors
BackgroundColor$="buttonface"
ForegroundColor$="black"
[openMainWindow]
open "Address Cardfile" for window_nf as #main
#main, "trapclose [btnExitClicked]"
#main, "font ms_sans_serif 11"
#main.textName, "!font arial 11 "
#main.textPhone, "!font arial 11"
#main.textCell, "!font arial 11 "
#main.textAddress, "!font arial 11 "
#main.textCity, "!font arial 11 "
#main.textSt, "!font arial 11 "
#main.textZip, "!font arial 11 "
#main.textEmail, "!font arial 11 "
#main.textNotes, "!font arial 11"
#main.btnClear, "!font arial 9 "
#main.btnSave, "!font arial 9 "
#main.btnExit, "!font arial 9 "
#main.btnEdit, "!font arial 9 "
#main.btnDelete, "!font arial 9 "
#main.btnSaveEdit, "!font arial 9 "
#main.totRecs, "!font arial 11 bold"
#main.helpme, "!font arial 10 "
#main.lbx, "singleclickselect [displayContactInfo]"
') *Note: When user selects contact from listbox, edit buttons
') are enabled so user can edit or delete a contact AND
') Save button is disabled to avoid user re-saving the contact
') that is currently displayed.
gosub [helpmeLoop]
[getUserInput]
gosub [hide] 'hide edit buttons
#main.totRecs, noRec
#main.btnSave, "!enable"
#main.textName, "!setfocus"
WAIT
[btnSaveClicked]
'get new record info
gosub [readDataFields]
'valid info so continue - record string is saved as rs$
addFlag=1
'add record to file
open DBFname$ for append as #f
#f, rs$
close #f
'update total records
noRec=noRec+1
'update arrays and listbox
gosub [fillContactsArray]
gosub [fillListbox]
'refresh listbox names - address$()
#main.lbx, "reload"
'clear fields and prevent user from saving record twice
'save button is disabled while addFlag set
gosub [btnClearClicked]
notice "Record has been saved."
'done adding record
addFlag=0
'we could wait, but lets go back and let user enter another contact
GOTO [getUserInput]
[readDataFields]
'trap accidental save button click if name field is empty
#main.textName, "!contents? name$"
if name$="" then
notice "Please provide a name for your contact."
addFlag=0 'didn't work - reset flag
goto [getUserInput]
end if
'ok to cont.
#main.textPhone, "!contents? phone$"
#main.textCell, "!contents? cell$"
#main.textAddress, "!contents? address$"
#main.textCity, "!contents? city$"
#main.textSt, "!contents? state$"
#main.textZip, "!contents? zip$"
#main.textEmail, "!contents? email$"
'its all good to here because probably no commas used in first fields
'but a comma in notes field will cause problems with CSV records
'so best to catch it and remove it before attempting to save record...
#main.textNotes, "!contents? notes$"
iscom=instr(notes$,",")
if iscom>0 then
temp$=left$(notes$,iscom-1)+mid$(notes$,iscom+1)
notes$=temp$
notice "Commas not allowed..."+chr$(13)+_
"Commas are not allowed in notes field and have "+chr$(13)+_
"been removed. (A comma could cause loss of your data)."+chr$(13)+_
chr$(13)+"Use another character, if needed, and re-save."
end if
'Create a record string - used for editing and deleting records
rs$=""
rs$=rs$+name$;",";phone$;",";cell$;",";address$;",";_
city$;",";state$;",";zip$;",";email$;",";notes$
RETURN
[fieldHeadingDisplayString]
'to be used if helper windows are added
fd$="Name: "+"Phone: "+"Cell: "+"Address: "+"City: "+_
"State: "+"Zip: "+"E-Mail: "+"Notes: "
[btnClearClicked]
'following is used to allow user to cancel editing a record
'NOTE TO ME: I COULD USE THE EDIT CONTACT BUTTON AS A CANCEL BUTTON????
if editFlag=1 then
confirm "Cancel editing the contact?";ans$
if ans$="yes" then
editFlag=0
#main.btnSaveEdit, "!disable"
goto [getUserInput]
end if
end if
#main.btnSave, "!enable"
'good to go, so clear the fields
#main.textName, ""
#main.textPhone, ""
#main.textCell, ""
#main.textAddress, ""
#main.textCity, ""
#main.textSt, ""
#main.textZip, ""
#main.textEmail, ""
#main.textNotes, ""
'if here from btnSaveClicked (add a record) then go back there
if addFlag=1 then RETURN
'otherwise...
GOTO [getUserInput]
[btnExitClicked]
Confirm "Close Address Cardfile?"; ans$
if ans$= "no" then WAIT
'backup routine (from JB help files)
open DBFname$ for input as #original
open "contactme.bak" for output as #copy
#copy, input$(#original, lof(#original));
close #original
close #copy
#main.textNotes, "Backing up database..."
timer 500, [null]
wait
[null]
timer 0
'shut down
close #main
END
'***************************************************
'* EDIT AND DELETE RECORD ROUTINES *
'***************************************************
[btnEditHelpClicked]
'instruct user how to edit records
#main.btnSaveEdit, "!enable"
notice "Edit contact"+chr$(13)+"Select a contact to modify..."_
+chr$(13)+"Press SAVE EDIT when done."+chr$(13)+chr$(13)+_
"Press CLEAR button to cancel editing."+chr$(13)+_
"Press DELETE to remove selected contact."
editFlag=1
WAIT
[btnSaveEdit]
#main.lbx, "selectionindex? index" 'number of edited record
gosub [readDataFields] 'read fields will catch changes
rs$(index)=rs$ 'edited record string
'write all records back to file to update database
open DBFname$ for output as #fout
for i=1 to noRec
#fout, rs$(i)
next i
close #fout
'update arrays and listbox
gosub [fillContactsArray]
gosub [fillListbox]
#main.lbx, "reload"
'notify user record edit successful
notice "Modifications have been saved."
'trap accidental save attempt
#main.btnSaveEdit, "!disable"
editFlag=0
WAIT
[btnDeleteClicked]
confirm "Delete this record?"; ans$
if ans$="no" then
gosub [hide]
WAIT
end if
'ok to delete so go ahead
#main.lbx, "selectionindex? index" 'record number to delete
rs$(index)="" 'tell program this record is empty string
open DBFname$ for output as #fout
'the following test goes through each record; if its not an empty
'string its written to the database
for i=1 to noRec
if rs$(i)<>rs$(index) then
#fout, rs$(i)
end if
next i
close #fout
'at this point, the new database does not include the deleted record
' so we need to refresh everything
gosub [fillContactsArray]
gosub [fillListbox]
print #main.lbx, "reload"
GOTO [btnClearClicked]
[hide]
#main.btnEdit, "!disable"
#main.btnDelete, "!disable"
#main.btnSaveEdit, "!disable"
RETURN
'**********************************************************
'* COUNT THE RECORDS, FILL THE ARRAYS, SORT THE RECORDS *
'* AND FILL THE LISTBOX *
'**********************************************************
[fillContactsArray]
'open the database to count the records
noRec=0
open DBFname$ for input as #f
while eof(#f)=0
line input #f, dummy$
noRec=noRec+1
wend
close #f
'open the database to read each record into an array - rs$()
dim rs$(noRec)
open DBFname$ for input as #f
for i=1 to noRec
line input #f, rs$(i)
next i
close #f
'Sort rs$() array
FOR i=1 TO noRec
FOR k=1 TO noRec-1
IF rs$(k) > rs$(k+1) THEN
temp$=rs$(k)
rs$(k)=rs$(k+1)
rs$(k+1)=temp$
END IF
NEXT k
NEXT i
're-write the database as sorted list
open DBFname$ for output as #fout
for i=1 to noRec
#fout, rs$(i)
next i
close #fout
'create two-dimensional array for elements of each record - recA$()
dim recA$(noRec,9) '<== change this number if number of fields chg
open DBFname$ for input as #fin
for i=1 to noRec
input #fin, recA$(i,1),recA$(i,2),recA$(i,3),recA$(i,4),_
recA$(i,5),recA$(i,6),recA$(i,7),recA$(i,8),recA$(i,9)
next i
close #fin
RETURN
[fillListbox]
'show name and phone for each contact in listbox - address$()
dim address$(noRec)
for j=1 to noRec
'address$(j)=recA$(j,1)+" "+recA$(j,2)+" "+recA$(j,3)
address$(j)=recA$(j,1)
next j
RETURN
[displayContactInfo]
'when user selects name from listbox,display all info fields
'enable edit buttons
#main.btnEdit, "!enable"
#main.btnDelete, "!enable"
#main.btnSaveEdit, "!enable"
'disable save button to prevent duplicate records if
' user accidentally presses save button instead of save edit button
#main.btnSave, "!disable"
#main.lbx, "selectionindex? index" 'record to display
#main.textName, recA$(index,1)
#main.textPhone, recA$(index,2)
#main.textCell, recA$(index,3)
#main.textAddress, recA$(index,4)
#main.textCity, recA$(index,5)
#main.textSt, recA$(index,6)
#main.textZip, recA$(index,7)
#main.textEmail, recA$(index,8)
#main.textNotes, recA$(index,9)
WAIT
[btnHelpClicked]
notice "Address Cardfile v1.0" +chr$(13)+_
"Freeware by jaba - 8/16/2009"+chr$(13)+_
"Made for my wife because she likes "+chr$(13)+_
"MS Cardfile and it hiccups on Vista."+chr$(13)+_
chr$(13)+_
"CONTROLS"+chr$(13)+_
" Clear: clears display to receive new contact info"+chr$(13)+_
" Save: saves new contact info to database file"+chr$(13)+_
" Exit: close program"+chr$(13)+_
" Edit Help: help for modifying contact"+chr$(13)+_
" Delete: delete a contact and refresh the database "+chr$(13)+_
" Save Edit: saves any editing done to contact"+chr$(13)+_
" and refreshes database"
WAIT
'*********************************
'* FUNCTIONS AND SUBS *
'*********************************
'see if file exists
function fileExists(path$, filename$)
files path$, filename$, Info$()
fileExists = val(Info$(0, 0)) 'non zero is true
end function
[helpmeLoop]
for i=1 to 3
#main.helpme, "help==>"
timer 500, [oop]
wait
[oop]
timer 0
#main.helpme, " "
timer 100, [oops]
wait
[oops]
timer 0
next i
RETURN
[hehe]
notice "It's not really a button. It's a line!"
goto [getUserInput]
end