Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : PROGEN32.ZIP
Filename : PROGGEN.DBF

Output of file : PROGGEN.DBF contained in archive : PROGEN32.ZIP

MENU****************************************************** &&ProgName MENU* -------------------------- MainMenu for: &&MainTitle MENU MENUSET DEFAULT TO %%MDrive MENUSET TALK OFF MENUSET HEADING OFF MENU MENU* Create Underline Variable MENUULine = "__________" MENUDO WHILE LEN(ULine) < 80 MENU ULine = ULine + ULine MENUENDDO MENU MENU* Display Menu MENUChoice = " " MENUUSE %%FullUse MENUDO WHILE Choice # "X" MENU CLEAR MENU @ 1,1 SAY " %%MainTitle " MENU @ 2,0 SAY ULine MENU ? MENU ? MENU TEXT MENU 1. Add new data MENU MENU 2. Print Reports MENU MENU 3. Edit Data MENU MENU 4. Delete Data MENU MENU %%DupOpt MENU MENU X. Exit MENU ENDTEXT MENU @ 24,1 SAY "Enter Choice " GET Choice PICT "!" MENU READ MENU MENU * Branch to choice MENU DO CASE MENU CASE Choice = "1" MENU &-AddOpt MENU CASE Choice = "2" MENU DO %%RepProg MENU CASE Choice = "3" MENU DO %%EdProg MENU CASE Choice = "4" MENU DO %%DelProg MENU %%DupCase1 MENU %%DupCase2 MENU ENDCASE MENU MENUENDDO MENUCLEAR MENUCLOSE DATABASES MENU*QUIT MENU REPT**************************************************** &&RepProg REPT* Set up sort and search REPT* and print report REPT REPTCLEAR REPT@ 1,1 SAY "Report Options" REPT@ 2,0 SAY ULine REPT? REPT? REPTTEXT REPT &-RepMenu REPT REPT X. None (Return to Main menu) REPTENDTEXT REPT REPTMChoice = " " REPT@ 24,1 SAY "Enter Choice " GET MChoice PICT "!" REPTREAD REPT REPTIF MChoice = "X" REPT RETURN REPTENDIF REPT REPT&-Ask4.PRG REPT REPT* Ask sort order REPTCLEAR REPT@ 1,1 SAY "Sort Options" REPT@ 2,0 SAY ULine REPT? REPT? REPTTEXT REPT &-SortMenu REPT REPTENDTEXT REPT REPTSChoice = 0 REPT@ 24,1 SAY "Enter Choice " GET SChoice PICT "9" REPTREAD REPT REPT* Set up sort order REPTDO CASE REPT &-SortCase REPTENDCASE REPT REPT* Ask about filters REPT* Set up memory variables REPT&-FldLengths REPTAndOr = "A" REPT* SNames Section REPTANSWER = " " REPTSET CONFIRM ON REPT* Display Search screen REPTCLEAR REPT &-SScreens REPT REPTSET CONFIRM OFF REPT* Set up filter conditions REPTCondit = " " REPT REPTIF UPPER(AndOr) = "O" REPT Logic = ".OR." REPTELSE REPT Logic = ".AND." REPTENDIF REPT REPT* Build condition macro REPT REPT &-SearchCase REPT* Trim excess and/or's REPTIF UPPER(AndOr) = "O" REPT Condit = SUBSTR(Condit,1,LEN(Condit)-4) REPTELSE REPT Condit = SUBSTR(Condit,1,LEN(Condit)-5) REPTENDIF REPT REPT* Set Filter REPTSET FILTER TO &Condit REPT REPT* Print Report REPTCLEAR REPTSTORE " " TO Where, WMacro REPT REPT@ 15,5 SAY "Printer / Disk / Screen? (P/D/S) " GET Where PICT "!" REPTREAD REPTIF Where = "P" REPT WMacro = "TO PRINT" REPT WAIT "Make sure printer is ready. Press any key to continue... " REPTENDIF REPTIF Where = "D" THEN REPTFileOut = SPACE(15) REPT@ 20,5 SAY "Output Filename: " GET FileOut REPTREAD REPT Wmacro = "TO FILE &FileOut" REPTENDIF REPTSET DELETED ON REPTCLEAR REPT REPTDO CASE REPT REPT &-RepCases REPT REPTENDCASE REPT REPT* Return to main menu REPTIF Where = "P" REPT EJECT REPTENDIF REPTSET DELETED OFF REPTSET FILTER TO REPTUSE %%FullUse REPTWAIT "Press any key to return to menu..." REPTRETURN REPT EDIT***************************************************** %%EdProg EDIT* Edit data EDIT* Set up loop EDITMore = .T. EDITDO WHILE More EDITCLEAR EDIT@ 1,1 SAY "Edit Data" EDIT@ 2,0 SAY ULine EDITSearch = %%LookBeg EDIT@ 10,5 SAY "Enter %%LookComm to Edit" EDIT@ 12,5 SAY "or press ENTER to Exit " GET Search EDITREAD EDIT EDIT* Exit if blank EDITIF Search = %%LookStop EDIT More = .F. EDIT LOOP EDITENDIF EDIT%%LookConv EDIT* Find record EDITSEEK Search EDITCOUNT WHILE %%LookCount = Search TO HowMany EDITIF HowMany > 1 EDIT @ 20,1 SAY STR(HowMany,3)+" matches found" EDIT @ 22,1 SAY "Use PgDn, PgUp Keys to scroll" EDIT ? EDIT WAIT "Press any key to edit..." EDITENDIF EDITSEEK Search EDIT* If found, edit Else warn user EDITIF .NOT. EOF() EDIT &-EdDecide EDITELSE EDIT @ 22,0 EDIT ? "Can't find: ",Search EDIT ?? CHR(7) EDIT WAIT EDITENDIF EDIT EDITENDDO EDIT EDITRETURN EDIT DEL ************************************************ &&DelProg DEL * Delete Data DEL CLEAR DEL @ 1,1 SAY "Delete Data" DEL @ 2,0 SAY ULine DEL * Find highest record number DEL USE %%DbName DEL GO BOTTOM DEL Max = RECNO() DEL USE %%FullUse DEL * Ask for record DEL More = .T. DEL DO WHILE More DEL @ 3,0 CLEAR DEL Search = %%LookBeg DEL SET EXACT ON DEL @ 10,2 SAY "Enter %%LookComm to Delete " DEL @ 12,2 SAY "or ENTER to exit " ; DEL GET Search DEL READ DEL * Respond to entry DEL DO CASE DEL * If not exit, lookup DEL CASE Search # %%LookStop DEL %%LookConv DEL SEEK Search DEL OTHERWISE DEL More = .F. DEL SET EXACT OFF DEL LOOP DEL ENDCASE DEL DEL * Verify record exists DEL IF EOF() DEL @ 20,0 CLEAR DEL ? "Can't find",Search DEL ?? CHR(7) DEL WAIT "Press any key to try again..." DEL LOOP DEL ENDIF DEL DEL * If found, count and display DEL COUNT WHILE %%LookCount = SEARCH TO HowMany DEL IF HowMany > 1 DEL @ 3,0 CLEAR DEL SEEK Search DEL DISPLAY %%SmallDisp WHILE ; DEL %%LookCount = Search DEL RecNo = 0 DEL @ 23,2 SAY "Delete which one (by record number) "; DEL GET RecNo PICT "9999" DEL READ DEL If RecNo <= Max .AND. RecNo > 0 DEL DELETE RECORD RecNo DEL ELSE DEL @ 20,0 CLEAR DEL @ 22,1 SAY "No such record: "+STR(RecNo,4) DEL ? CHR(7) DEL WAIT "Press any key to try again..." DEL ENDIF DEL ELSE DEL SEEK Search DEL @ 3,0 CLEAR DEL DISPLAY %%SmallDisp DEL Maybe = " " DEL @ 23,2 SAY "Delete this record? (Y/N) "; DEL GET Maybe PICT "!" DEL READ DEL IF UPPER (Maybe) = "Y" DEL DELETE DEL ENDIF DEL ENDIF DEL ENDDO DEL DEL * Final double check before permanent deletion DEL * Count number marked for deletion DEL * Store number to NoDels DEL COUNT FOR DELETED() TO NoDels DEL DEL Permiss = "N" DEL DO WHILE Permiss = "N" .AND. NoDels > 0 DEL @ 3,0 CLEAR DEL ? DEL DISPLAY %%SmallDisp FOR DELETED() DEL ? DEL Permiss = " " DEL @ 23,5 SAY "OK to delete all these? (Y/N) "; DEL GET Permiss PICT "!" DEL READ DEL * If not ok, find out which DEL IF Permiss # "Y" DEL RecNo = 0 DEL @ 20,0 CLEAR DEL @ 23,5 SAY "Recall which one (record number): "; DEL GET RecNo PICT "9999" DEL READ DEL IF RecNo > 0 .AND. RecNo <= Max DEL GOTO RecNo DEL IF DELETED() DEL RECALL DEL NoDels = NoDels-1 DEL ENDIF DEL ELSE DEL @ 20,0 CLEAR DEL @ 22,1 SAY No such record: "+STR(RecNo,4) DEL ? CHR(7) DEL WAIT DEL ENDIF DEL ENDIF DEL ENDDO DEL DEL * Pack and return DEL IF NoDels > 0 DEL PACK DEL ENDIF DEL RETURN DEL *********************************************** %%DupProg DUP * Scan for duplicates DUP SET HEADING OFF DUP SET DELETED ON DUP DUP * Ask to print? DUP CLEAR DUP @ 1,1 SAY "Duplicate Check" DUP @ 2,0 SAY ULine DUP Printer = " " DUP @ 10,5 SAY "Send possible duplicates to Printer? (Y/N) "; DUP GET Printer PICT "!" DUP READ DUP DUP * Set Printer on if desired DUP IF Printer = "Y" DUP WAIT "Prepare Printer, then press any key to continue..." DUP SET PRINT ON DUP ENDIF DUP DUP * Clear and print title screen DUP @ 3,0 CLEAR DUP USE %%DbName DUP ? "Pre-sorting for duplication check..." DUP SET SAFETY OFF DUP INDEX ON %%DupComp TO Temp DUP SET SAFETY ON DUP CLEAR DUP ? "Possible duplications" + SPACE(38) + DTOC(DATE()) DUP ? ULine DUP ? DUP ? DUP DUP * Loop to end of file DUP * Compare on specified fields DUP DUP RecCheck = " %%DupComp " DUP DO WHILE .NOT. EOF() DUP Compare = &RecCheck DUP SKIP DUP IF &RecCheck = Compare DUP SKIP -1 DUP LIST FIELDS &RecCheck OFF WHILE &RecCheck = Compare DUP ? DUP ENDIF DUP ENDDO DUP DUP * Return to menu DUP IF Printer = "Y" DUP EJECT DUP SET PRINT OFF DUP ENDIF DUP SET DELETED OFF DUP * Reassign index files and return DUP USE %%FullUse DUP @ 22,0 DUP WAIT "Press any key to return to menu..." DUP RETURN DUP * Back to main menu DUP USE %%FullUse DUP @ 22,0

  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : PROGEN32.ZIP
Filename : PROGGEN.DBF

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: