Category : Databases and related files
Archive : VENDOR3.ZIP
Filename : VENDOR.CLA
Output of file : VENDOR.CLA contained in archive : VENDOR3.ZIP
TITLE('VENDOR')
OMIT('¼')
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º Program - VENDOR ! º
º Author - Ed Robichaud - PC Consultants ! º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PROGRAM
INCLUDE('KEYCODES.EQU')
INCLUDE('CLARION.EQU')
INCLUDE('ERRORS.EQU')
MAP
CheckOpen(*FILE)
DiskError(
ShowWarning
MODULE('VENDOR01')
upd_names
shownames
END
MODULE('VENDOR02')
showcodes
printall
RedirectReport
ViewReport
printcodes
printonecode
printone
END
MODULE('VENDOR03')
showuticodes
updateuticodes
SHOWONENAME
endlogo
END
MODULE('VENDOR04')
uticodes
valuticodes
END
MODULE('DOVXGUI')
loadgui
END
MODULE('TIMER')
timer
END
INCLUDE('BROWSE.INC')
INCLUDE('TEMPFILE.INC')
END
EJECT('File Layouts')
GLO:MessageGroup GROUP
GLO:Message1 STRING(45)
GLO:Message2 STRING(45)
GLO:Message3 STRING(45)
.
GLO:InsertMsg STRING('Record will be added {9}')
GLO:ChangeMsg STRING('Record will be changed {7}')
GLO:DeleteMsg STRING('Select OK to delete {10}')
GLO:Filespec STRING(64)
Util FILE,PRE(UTI),DRIVER('Clarion'),RECLAIM
By_code KEY(+UTI:Code),DUP,OPT,NOCASE
RECORD RECORD
Code STRING(3)
Description STRING(15)
. .
Vendors FILE,PRE(VEN),DRIVER('Clarion'),RECLAIM
Name_key KEY(+VEN:Name),DUP,NOCASE
By_code KEY(+VEN:Code,+VEN:Name),DUP,OPT,NOCASE
Notes2 MEMO(455)
RECORD RECORD
Name STRING(40)
Date LONG
Address STRING(35)
City_ST_ZIP STRING(35)
BBS STRING(14)
Sales STRING(14)
Tech STRING(14)
Fax STRING(14)
Other STRING(14)
Email STRING(20)
Notes STRING(60)
Code STRING(3)
. .
AddRecord EQUATE(1) ! Add a new record
ChangeRecord EQUATE(2) ! Change the current record
DeleteRecord EQUATE(3) ! Delete the current record
CODE
EMBED('~~::PROGRAM~1~Setup Program~3~~')
IF GRAPHIC(0) = 87
SETGRAPHIC(89)
END
LOADGUI
!IDLE(TIMER)
ENDEMBED
LOADSYMBOLS !Display graphic mouse
SETNOBLINK !Enable enhanced colors
HELP('VENDOR') !Open the help file
SETMOUSE(1,1) !Turn on mouse
SETCOLOR(WhiteOnBlack) !Set white on black
BLANK !Clear the screen
SETCOLOR !Turn off override color
ShowNames !Call the first procedure
EMBED('~~::PROGRAM~1~Before return to DOS~3~~')
endlogo
ENDEMBED
RETURN !Return to DOS
OMIT('¼')
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º Check ERROR() function after opening a file º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
CheckOpen PROCEDURE(File)
CODE
OPEN(File,22h) !Attempt to open the file
CASE ERRORCODE() ! and check for errors
OF NoError !Return if no error
OROF IsOpenErr ! or if already open.
RETURN
OF InvalidFileErr !Invalid Record Declaration
GLO:Message1 = 'Error accessing: '& NAME(File)
GLO:Message2 = 'Code: ' & ERRORCODE() & ' ' & ERROR()
GLO:Message3 = 'Press OK to return to DOS'
ShowWarning
HALT(InvalidFileErr)
OF BadKeyErr !Key Files must be rebuilt
GLO:Message1 = NAME(File) & ' Key file is invalid'
GLO:Message3 = 'Press OK to rebuild keyfile'
ShowWarning
OPEN(File,12H) !Open for exclusive access
BUILD(File) !Rebuild the key files
IF ERRORCODE()
GLO:Message1 = NAME(File) & ' The file cannot be repaired'
GLO:Message2 = 'while other stations are using it'
GLO:Message3 = 'Press OK to return to DOS'
ShowWarning
HALT(BadKeyErr)
ELSE
CLOSE(File) !Close
OPEN(File,22h) ! then open it
END
END !End of Case Structure
IF DiskError(NAME(File) & ' File could not be opened') THEN HALT(0). !Cannot resume
OMIT('¼')
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º Check ERROR() function after a disk access º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
DiskError FUNCTION(Cause)
StopMsg:: STRING(180)
CODE
IF ~ERRORCODE() THEN RETURN(0). !Return with no error
IF ~OMITTED(1) !If a cause was given
StopMsg:: = 'Cause: ' & Cause & LF:CR ! Display it
END !End IF
IF ERRORFILE() !If error involves a file
StopMsg:: = CLIP(StopMsg::) & 'File : ' | ! display the file
& ERRORFILE() & LF:CR
END !End IF
StopMsg:: = CLIP(StopMsg::) & 'Error: ' | !Display the error code
& ERRORCODE() & ' - ' | ! and the error message
& ERROR() & LF:CR
STOP(StopMsg::) !Stop with message
RETURN(1) !Return with error
OMIT('¼')
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º Display a warning message using 3 Global message variables. º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
ShowWarning PROCEDURE
SaveStyle STRING(256)
!
! COMMENTED OUT TO CHANGE TO FOLLOW THE PPS SCREEN CONVENTIONS
!Screen SCREEN(9,53),PRE(SCR),CENTER,SHADOW,CUA,COLOR(112)
! ROW(1,1) STRING('Ûß{51}Û'),COLOR(116)
! ROW(9,1) STRING('ÛÜ{51}Û'),COLOR(116)
! REPEAT(7)
! ROW(2,1) STRING('Û'),COLOR(116)
! ROW(2,53) STRING('Û'),COLOR(116)
! .
! ROW(3,5) ENTRY(@S45),USE(GLO:Message1),INS,SKIP,COLOR(112,112,112)
! ROW(4,5) ENTRY(@S45),USE(GLO:Message2),INS,SKIP,COLOR(112,112,112)
! ROW(5,5) ENTRY(@s45),USE(GLO:Message3),INS,SKIP,COLOR(112,112,112)
! ROW(7,24) BUTTON(' &Ok |'),SHADOW,USE(?Ok),COLOR(23,71,24,31,79)
! .
Screen SCREEN(9,53),PRE(SCR),CENTER,SHADOW,ZOOM,CUA,COLOR(116)
!dimensions=25,80,25,80
ROW(1,1) PAINT(1,18),COLOR(127)
ROW(1,36) PAINT(1,18),COLOR(127)
ROW(1,19) STRING('USER MESSAGE FORM'),COLOR(127)
ROW(3,5) ENTRY(@S45),USE(GLO:Message1),INS,SKIP,COLOR(15,15,15)
ROW(4,5) ENTRY(@S45),USE(GLO:Message2),INS,SKIP,COLOR(15,15,15)
ROW(5,5) ENTRY(@s45),USE(GLO:Message3),INS,SKIP,COLOR(15,15,15)
ROW(7,24) BUTTON(' &Ok |'),USE(?Ok),COLOR(23,143,24,31,143)
.
CODE
SaveStyle = STYLES() !Save current style
GETSTYLES('') !Turn off Styles
GLO:Message1 = CENTER(GLO:Message1,SIZE(GLO:Message1))
GLO:Message2 = CENTER(GLO:Message2,SIZE(GLO:Message2))
GLO:Message3 = CENTER(GLO:Message3,SIZE(GLO:Message3))
OPEN(Screen)
DISPLAY
ACCEPT !Enable keyboard and mouse
CLEAR(GLO:MessageGroup) !Blank out message fields
SETSTYLES(SaveStyle) !Restore user styles
RETURN
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/