Frostbyte's 1980s DOS Shareware Collection/floppyshareware.zip/floppyshareware/APOG/BORUSR2.ZIP/BOREDIT.PRG

Text File | 1992-06-29 | 17KB | 570 lines

*-------------------------------------------------------------------------------
*-- Program.....: BOREDIT.PRG
*-- Programmer..: Ken Mayer
*-- Date........: 06/12/1992
*-- Notes.......: Used to edit data in ATUSER.DBF
*-- Written for.: dBASE IV, 1.1/1.5
*-- Rev. History: 11/26/1991 -- added use of Martin's PICKLIST routine, to
*--                 allow a user to ask for people by STATE. This will bring
*--                 up a list of just those AT/BOR-BBS users for that state.
*--               05/14/1992 -- Added delete routine to THIS, rather than
*--                 having a separate delete routine.
*--               06/12/1992 -- I believe I have cleared up some of the color
*--                 problems in version 1.5 of dBASE that I was having. A few
*--                 other minor changes (like renaming the programs, etc.).
*-------------------------------------------------------------------------------

save screen to sEdit
cEdtColor = set("ATTRIBUTES")
clear
x=scrnhead("&cStand2","BOR-BBS Users Database - Search/Update Data")

*-- 03/27/1992 -- network() function included to deal with
*--               exclusive/non-exclusive use of database on
*--               a network
if network()
    use atusers excl
else
    use atusers
endif

lPgUp = .f.                  && used if user presses <PgUp> in second screen ...

*-- window for 'bio' field
define window wBio from 9,10 to 20,79

do while .t.                 && loop for menu/search routines

    lOk = .f.
    @5,0 clear
    @4,67 clear to 4,79       && clean out any 'deleted' messages that might
                              && be left
    cChoice = VPick(8,30,"~Borland BBS ID~Last Name~State","Search By:",;
                            "Select one, or <Esc> to return to menu",.t.,;
                            "&cStand2,&cStand,&cStand2")

    *-- if user pressed <Esc> to exit the popup ...
    if IsBlank(cChoice) && user pressed <Esc>
        exit             && we done
    endif

    *-----------------------------------------------------------------------
    *-- Choices from above ...
    *-----------------------------------------------------------------------
    do case
        case cChoice = "B"  && look by AT/BBS Id

            cTest = space(9)
            set order to tag borbbs_id
            @10,10 say "Enter BOR BBS Id: " get cTest picture "@!"
            read

            *-- check for <Esc> key
            if lastkey() = 27
                loop
            endif

            *-- user press <Enter>? If NOT, look for it ...
            if .not. IsBlank(cTest)
                seek trim(cTest)
                lOK = .f.
            else
                loop
            endif

            *-- we didn't find one that matched ...
            if .not. found()
                x=errormsg("","Could not find record","","&cStand3")
                loop
            endif

            *-- found one, display, if not that one, try another ???
            do while upper(trim(borbbs_id)) = trim(cTest)

                @12,8 SAY "BORBBS ID:"
                @12,19 GET Borbbs_id PICTURE "@!"
                @13,13 SAY "Name:"
                @13,19 GET First_name picture "!XXXXXXXXXXXXXXXXXXXXXXXX"
                @13,45 GET Mi PICTURE "!" message "Middle Initial"
                @13,47 GET Last_name picture  "!XXXXXXXXXXXXXXXXXXXXXXXX";
                    message "Last Name"
                @14,8 SAY "Honorific:"
                @14,19 GET Honorific PICTURE "!XXXXX";
                    message "Honorific (Mr., Mrs., Ms., Dr., etc.)"
                clear gets

                if yesno2(.t.,"BC","Is this the one?","","","&cl_wind1")
                    store .t. to lOK
                    exit
                else
                    store .f. to lOK
                    skip  && if this ain't it, skip to next record, and
                    loop  && go back and check again ...
                endif

            enddo

        case cChoice = "L"   && check by Last Name

            cTest = space(25)
            set order to tag last_name
            @10,10 say "Enter Last Name: " get cTest picture "@!"
            read

            *-- check for <Esc> key
            if lastkey() = 27
                loop
            endif

            *-- user press <Enter>? If NOT, look for it ...
            if .not. IsBlank(cTest)
                seek trim(cTest)
                lOK = .f.
            else
                loop
            endif

            *-- we didn't find one that matched ...
            if .not. found()
                x=errormsg("","Could not find record","","&cl_wind2")
                loop
            endif

            *-- found one, display, if not that one, try another ???
            do while trim(upper(last_name)) = trim(cTest)

                @12,8 SAY "BORBBS ID:"
                @12,19 GET Borbbs_id PICTURE "@!"
                @13,13 SAY "Name:"
                @13,19 GET First_name picture "!XXXXXXXXXXXXXXXXXXXXXXXX"
                @13,45 GET Mi PICTURE "!" message "Middle Initial"
                @13,47 GET Last_name picture  "!XXXXXXXXXXXXXXXXXXXXXXXX";
                    message "Last Name"
                @14,8 SAY "Honorific:"
                @14,19 GET Honorific PICTURE "!XXXXX";
                    message "Honorific (Mr., Mrs., Ms., Dr., etc.)"
                clear gets

                if yesno2(.t.,"BC","Is this the one?","","","&cl_wind1")
                    store .t. to lOK
                    exit
                else
                    store .f. to lOK
                    skip
                    loop
                endif

            enddo  && end of search ...

        case cChoice = "S"   && state

            cTest = space(2)
            set order to tag state
            @10,10 say "Enter State: " get cTest picture "@!"
            read

            *-- Check for <Esc> key
            if lastkey() = 27
                loop
            endif

            *-- user press <Enter>? If NOT, look for it ...
            if .not. IsBlank(cTest)
                locate for hState = cTest .or. bState = cTest  && home or business
                lOK = .f.
            else
                loop
            endif

            *-- we didn't find one that matched ...
            if .not. found()
                x=errormsg("","Could not find record","","&cl_wind2")
                loop
            endif

            *-- now for the fun part ... if here, we found one ... are there
            *-- more?
            nRecNo = recno()
            count to nCount for hState = cTest .or. bState = cTest

            if nCount = 1  && if only one record ...

                goto nRecNo
                @12,8 SAY "BORBBS ID:"
                @12,19 GET Borbbs_id PICTURE "@!"
                @13,13 SAY "Name:"
                @13,19 GET First_name picture "!XXXXXXXXXXXXXXXXXXXXXXXX"
                @13,45 GET Mi PICTURE "!" message "Middle Initial"
                @13,47 GET Last_name picture  "!XXXXXXXXXXXXXXXXXXXXXXXX";
                    message "Last Name"
                @14,8 SAY "Honorific:"
                @14,19 GET Honorific PICTURE "!XXXXX";
                    message "Honorific (Mr., Mrs., Ms., Dr., etc.)"
                clear gets

                if yesno2(.t.,"BC","Is this the one?","","","&cl_wind1")
                    store .t. to lOK
                else
                    store .f. to lOK
                endif

            else  && there's more than one, bring up a picklist ...
                  && this is a bit slower than I'd like, but since we have to
                  && be flexible enough to deal with the fact that some users
                  && may not want to give either home or state, we need to look
                  && at both business state AND home state (and some might work
                  && across state lines, I suppose ...).
                set filter to bstate = cTest .or. hstate = cTest
                set order to last_name
                go top
                *-- do a picklist ...
                save screen to sPick
                do shadow with 11,7,20,72
                do picklist with ;
                    "borbbs_id+' │ '+left(first_name,15)+' │ '+left(last_name,15)"+;
                    "+' │ '+iif(len(trim(hcity))>0,hcity,bcity)",;
                    11,7,20,72,"&cstand2","&cStand","DOUBLE"
                restore screen from sPick
                release screen sPick
                set order to
                if lastkey() = 27  && user pressed <Esc>
                    lOK = .f.       && must not have liked what they saw
                    set filter to
                    loop
                else
                    lOK = .t.       && ok, this is fine ...
                endif
                set filter to
            endif  && nCount = 1

    endcase  && type of search

    *-- if memvar lOK is false, we still didn't find it ...
    if .not. lOK
        x=errormsg("","Could not find record","","&cl_wind2")
        loop
    endif

    *-----------------------------------------------------------------------
    *-- if we go into this loop, we've found a match ...
    *-----------------------------------------------------------------------
    on key label alt-d do delrec  && routine to delete/recall a record
    on key label f2 do memoview   && routine below to deal with VIEWing the memo
    lDone2 = .f.

    do while .t.          && main loop once search is complete ...

        if lPgUp       && if user pressed <PgUp> to get here, turn it off
            lPgUp = .f.
        endif
        lDone = .f.    && this must be defined SOMEWHERE ...

        *-- set deleted flag (on screen)
        if deleted()
            @4,67 say "DELETED" color &cStand3
        else
            @4,67 clear to 4,79
        endif

        *-----------------------------------------------------------------------
        *-- SCREEN 1
        *-----------------------------------------------------------------------
        do while .t.      && first screen

            @5,0 clear

            @  6, 8 SAY "BORBBS ID:"
            @  6,19 GET Borbbs_id PICTURE "@!"
            @  7,13 SAY "Name:"
            @  7,19 GET First_name picture "!XXXXXXXXXXXXXXXXXXXXXXXX"
            @  7,45 GET Mi PICTURE "!" message "Middle Initial"
            @  7,47 GET Last_name picture  "!XXXXXXXXXXXXXXXXXXXXXXXX";
                 message "Last Name"
            @  8, 8 SAY "Honorific:"
            @  8,19 GET Honorific PICTURE "!XXXXX";
                 message "Honorific (Mr., Mrs., Ms., Dr., etc.)"
            @  8,26 say "Bio:"
            @  8,31 get bio window wBio;
                message;
                "Interests of user: <Ctrl><Home> = enter/edit,<Ctrl><End> = save, <F2>=view"
            @ 10,10 SAY "Company:"
            @ 10,19 GET Company message ""
            @ 11,12 SAY "Title:"
            @ 11,19 GET Title message "Enter Job Title"
            @ 12,10 SAY "Address:"
            @ 12,19 GET Baddress1
            @ 13,19 GET Baddress2 message "Enter if second address line necessary";
                when .not. isblank(bAddress1)
            @ 14,19 GET Bcity message "City"
            @ 14,44 SAY ","
            @ 14,46 GET Bstate PICTURE "!!" message "State";
                valid required state(bState)
            @ 14,50 GET Bzip PICTURE "#####-####" message "Zip"
            @ 15, 7 SAY "Work Phone:"
            @ 15,19 GET Bphone PICTURE "@R [phone]"
            @ 15,36 SAY "Fax:"
            @ 15,41 GET Fax PICTURE "@R [phone]"
            @ 17,13 SAY "Home:"
            @ 17,19 GET Haddress1
            @ 18,19 GET Haddress2 message "Enter if second address line necessary";
                when .not. isblank(hAddress2)
            @ 19,19 GET Hcity message "City"
            @ 19,44 SAY ","
            @ 19,46 GET Hstate PICTURE "!!" message "State";
                valid required state(hState)
            @ 19,50 GET Hzip PICTURE "#####-####"  message "Zip"
            @ 20, 7 SAY "Home Phone:"
            @ 20,19 GET Hphone PICTURE "@R [phone]"
            @ 21, 8 SAY "BBS Phone:"
            @ 21,19 GET Bbsphone PICTURE "@R [phone]"

            do center with 22,80,"&cStand3",;
                "Press <Alt>D to "+iif(.not. deleted(),"delete","recall")
            do center with 23,80,"&cStand3",;
                "Press <PgDn> for next screen"

            read

            nI = readkey()
            if nI > 255
                nI = nI - 256
            endif

            *-- if record not changed, and <PgDn>/<Ctrl><End> key was pressed ...
            if readkey() < 255 .and. (lastkey() = 3 .or. lastkey() = 23)
                lDone = .f.   && just making sure ...
                exit
            endif

            *-- if user pressed <Esc>
            if lastkey() = 27
                lDone = .t.
                exit
            endif

            *-- check for and process <Ctrl><End>
            if nI+256 = 270  && ^<end> or ^w
                @22,0 clear
                cYN = "N"
                @23,25 say "Finished with this record?" get cYN picture "!";
                    valid required cYN $ "YN";
                    error chr(7)+"Enter 'Y' or 'N'"
                read

                if cYN = "Y"
                    lDone2 = .t.
                    exit
                else
                    lDone2 = .f.
                    exit
                endif
            endif

            *-- check to see if this is alright
            @22,0 clear
            cYN = "Y"
            @23,25 say "Is this screen ok? " get cYN picture "!";
                valid required cYN $ "YN";
                error chr(7)+"Enter 'Y' or 'N'"
            read

            *-- if so, exit ...
            if cYN = "Y"
                exit
            endif

        enddo              && end of first screen

        *-----------------------------------------------------------------------
        *-- SCREEN 2
        *-----------------------------------------------------------------------
        do while .t.      && second screen

            if lDone .or. lDone2   && if <Esc> was pressed in previous screen ...
                exit
            endif

            @5,0 clear

            @  6, 8 SAY "BORBBS ID:"
            @  6,19 get Borbbs_id
            @  7,13 SAY "Name:"
            @  7,19 get First_name
            @  7,45 GET Mi
            @  7,47 GET Last_name
            clear gets  && these (above) are display only

            @  9, 7 SAY "CompuServe:"
            @  9,19 GET Compuserve
            @ 10, 9 SAY "MCI_Mail:"
            @ 10,19 GET Mci_mail
            @ 11,12 SAY "GEnie:"
            @ 11,19 GET Genie
            @ 12,13 SAY "FIDO:"
            @ 12,19 GET Fido
            @ 13, 9 SAY "InterNet:"
            @ 13,19 GET Internet
            @ 14,11 SAY "Source:"
            @ 14,19 GET Source
            @ 15,10 SAY "Prodigy:"
            @ 15,19 GET Prodigy
            @ 16,11 SAY "Delphi:"
            @ 16,19 GET Delphi
            @ 17, 3 SAY "America OnLine:"
            @ 17,19 GET Am_online

            do center with 21,80,"&cStand3","Press <PgUp> for previous screen"
            do center with 22,80,"&cStand3",;
                "Press <Alt>D to "+iif(.not. deleted(),"delete","recall")
            do center with 23,80,"&cStand3",;
                "Press <PgDn> or <Ctrl><End> to complete/exit this record"
            read

            *-- if user pressed <PgUp>
            if lastkey() = 18
                lPgUp = .t.
                exit
            endif

            *-- if <Esc>
            if lastkey() = 27
                lDone = .t.
                exit
            endif

            *-- ask if screen ok
            @21,0 clear
            cYN = "Y"
            @23,25 say "Is this screen ok? " get cYN picture "!";
                valid required cYN $ "YN";
                error chr(7)+"Enter 'Y' or 'N'"
            read

            *-- if so, exit
            if cYN = "Y"
                exit
            endif

        enddo              && while .t. -- second screen

        *--------------------------------------------------------------------
        *-- End of SCREEN Processing
        *--------------------------------------------------------------------

        if lDone       && if <Esc> was pressed ...
            exit
        endif

        if lPgUp       && user hit <PgUp> on second screen?
            loop
        else
            exit
        endif

    enddo  && end of first level loop -- handles <PgUp> ...

    on key label alt-d  && turn this off, so we don't get WEIRD results ...
    on key label f2     && turn this off, also ...

    *-- check for more records ...
    if yesno(.f.,"More?","Do you wish to edit","another record?",;
        "&cl_wind1")
        loop
    else
        exit
    endif

enddo  && while .t.  -- absolute outside loop for menu/search

*--------------------------------------------------------------------------
*-- CLEANUP
*--------------------------------------------------------------------------
@22,0 clear
*-- deal with any deleted records ...
count to nCount for deleted()
if nCount > 0
    *-- a little additional code from Joey Carroll (JOEY) -- allow user
    *-- to not HAVE to pack the data at this time ...
    cCount = ltrim(str(nCount))
    if yesno2(.t.,"BC","Your database contains",;
        cCount+" marked deleted record(s).",;
        "Remove them now?","&cl_wind2")
        do center with 23,80,"&cStand3","... Deleting Marked Records ..."
        pack
    endif
    release cCount
endif

*-- cleanup
close database
restore screen from sEdit
release screen sEdit
do ReColor with cEdtColor

*--------------------------------------------------------------------------
*-- back to menu ...
*--------------------------------------------------------------------------
RETURN

*-- Deal with 'deleting' records ...
PROCEDURE DelRec

    on key label alt-d  ?? chr(7)  && disallow pressing key until done with this
                                   && routine

    if .not. deleted()   && if delete flag is OFF
        if yesno2(.f.,"BC","Delete Record?","Do you really want to",;
            "delete this record?","&cl_wind2")
            delete  && this record
        endif
    else
        if yesno2(.f.,"BC","UnMark Record?","Do you really want to",;
            "undelete this record?","&cl_wind2")
            *-- processing is a bit odd to ensure that the RECALL takes, we must
            *-- move the pointer back and forth ...
            nRec = recno()
            go nRec+iif(nRec > 1,-1,1)
            go nRec
            recall        && <-- this command actually recalls the record ...
            go nRec+iif(nRec > 1,-1,1)
            go nRec
        endif
    endif

    *-- set/reset DELETED flag ...
    if deleted()
        @4,67 say "DELETED" color &cStand3
    else
        @4,67 clear to 4,79
    endif
    *-- change message on screen ...
    do center with 22,80,"&cStand3",;
        "Press <Alt>D to "+iif(.not. deleted(),"delete","recall")

    on key label alt-d do delrec        && reset ...

RETURN
*-- EoP: DelRec

PROCEDURE MemoView   && uses Martin Leon's MEMOPAGR routine (currently residing
                     && in PROC.PRG
    on key label f2 ?? chr(7)
    save screen to sMemoView
    define window wMemotext from 20,10 to 22,70 double color &cl_Wind1
    do shadow with 20,10,22,70
    activate window wMemoText
    do center with 0,60,"&cStand2","Use arrow keys to scroll, <Esc> when done."
    activate screen
    x=memopagr("bio",9,10,18,77)
    deactivate window wMemoText
    restore screen from sMemoView
    release window wMemoText
    release screen sMemoView
    on key label f2 do memoview

RETURN

*-------------------------------------------------------------------------------
*-- EoP: BOREDIT.PRG
*-------------------------------------------------------------------------------