Weatherman2020
Diamond Member
This is where I say something pithy. OK.
Navigation
Install the app
How to install the app on iOS
Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
More options
You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.
You should upgrade or use an alternative browser.
#LearnToCode
- Thread starter Weatherman2020
- Start date
This is where I say something pithy. OK.
Covid is a plot by the Trump administration to destroy the MSM and leave us with fringe outlets that treat Trump tweets as journalistic "proof".
miketx
Diamond Member
- Dec 25, 2015
- 121,555
- 70,538
- 2,645
- Banned
- #3
I learned to code decades ago. Here are a couple network access routines and a routine to check if the printer is ready in my shop program.
SUB allow_access
SHARED var3%
retry:
OPEN "net_ctrl.ctr" FOR RANDOM ACCESS READ WRITE SHARED AS #12 LEN = 25
FIELD #12, 25 AS lockstring$
net_ctrl_records% = LOF(12) / 25
'**************PROCESS FILE *****************
FOR Rloop% = 1 TO UBOUND(Lfiles%(1))
recordnum% = Lfiles%(Rloop%)
GET #12,recordnum%
SELECT CASE lockstring$
CASE STRING$(25,CHR$(1)) ' ****** FILE IS MARKED AS LOCKED *********
CLOSE #12
GOTO execute_menu
CASE ELSE
EXIT SELECT
END SELECT
NEXT
CLOSE #12
OPEN "net_ctrl.ctr" FOR RANDOM ACCESS READ WRITE SHARED AS #12 LEN = 25
FIELD #12, 25 AS lockstring$
net_ctrl_records% = LOF(12) / 25
FOR Rloop% = 1 TO UBOUND(Lfiles%(1))
GET #12,Lfiles%(Rloop%)
LSET lockstring$ = STRING$(25,CHR$(1)) ' **** MARK FILE AS LOCKED
PUT #12,Lfiles%(Rloop%)
NEXT
CLOSE #12
EXIT SUB
execute_menu:
CLOSE #12
OPEN "net_ctrl.ctr" FOR RANDOM ACCESS READ WRITE SHARED AS #12 LEN = 25
FIELD #12, 25 AS lockstring$
net_ctrl_records% = LOF(12) / 25
LOCATE 1,1,0
f$ = savescreen$
s$ = savescreen$
DIM item$(3)
item$(1) =" ATTEMPT FILE ACCESS LATER "
item$(2) =" ATTEMPT TO ACCESS FILE AGAIN "
item$(3) =" CONTINUOUS ATTEMPTS TO ACCESS FILE "
itemcount% = UBOUND(item$(1))
row% = 8
col% = 22
downto% = 12+itemcount%+1
outTo% = LEN(item$(1))+col%-1
bordr% = 1
attr% = fnattr%(4,3)
mhattr% = fnattr%(7,4)
PopWindow 10,col%,downto%-1,outTo%,bordr%, attr%, 0, -5, 10, ""
xqprint STRING$(36,CHR$(196)),12,22,fnattr%(4,3)
xqprint "ATTEMPT TO ACCESS FILE HAS FAILED -",10,22,fnattr%(4,3)
xqprint "FILE IS BUSY. SELECT OPTION:",11,22,fnattr%(4,3)
enterpayflag% = 0
subscript% = 1
curntpos% = 1
row% = 13
for mloop% = 1 to itemcount%
xqprint item$(mloop%),mloop%+row%-1,col%,attr%
next
xqprint item$(1),row%,col%,mhattr%
DO
WHILE NOT INSTAT
WEND
ans$=inkey$
SELECT CASE ans$
CASE chr$(0,72)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
DECR curntpos%
DECR subscript%
IF subscript% < 1 THEN subscript% = UBOUND(item$(1))
IF curntpos% < 1 THEN curntpos% = UBOUND(item$(1))
CASE chr$(0,80)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
INCR curntpos%
INCR subscript%
IF subscript% > UBOUND(item$(1)) THEN subscript% = 1
IF curntpos% > UBOUND(item$(1)) THEN curntpos% = 1
CASE chr$(13)
SELECT CASE curntpos%
ERASE item$
CASE 1
CLOSE
ERASE Lfiles%()
popwindow 13,36,13,44,1,fnattr%(0,3),0,0,0,""
ctext 13, "CLOSING",14,3
director% = 1
var3% = 0
top_line% = topline%
pick_line% = pickline%
MEMPACK
CHAIN "romenu.pbc"
CASE 2
restorescreen s$
CLOSE
s$ = savescreen$
popwindow 11,30,11,50,1,fnattr%(0,7),0,-5,0,""
xqprint "ATTEMPTING ACCESS ...",11,30,fnattr%(0,7)
SOUND 400,1
DELAY 1
restorescreen s$
GOTO retry
CASE 3
counter% = 1
restorescreen s$
popwindow 11,13,12,67,1,fnattr%(0,7),0,-5,0, ""
Xqprint " ATTEMPTING TO ACCESS FILE - PRESS ESC TO STOP ...",11,13,fnattr%(0,7)
xqprint " ATTEMPT # 1 ",12,13,fnattr%(0,7)
ans$ = ""
DO
ans$ = INKEY$
DELAY 1.2
INCR counter%
COLOR 0,7
loopcount% = 0
LOCATE 12,23
RINT counter%
' IF counter% > 100 THEN EXIT LOOP
FOR Rloop% = 1 TO UBOUND(Lfiles%(1))
recordnum% = Lfiles%(Rloop%)
GET #12,recordnum%
SELECT CASE lockstring$
CASE STRING$(25,CHR$(1)) ' ****** FILE IS MARKED AS LOCKED *********
EXIT SELECT
CASE STRING$(25,CHR$(2))
INCR loopcount%
END SELECT
NEXT
IF loopcount% = UBOUND(Lfiles%(1)) THEN EXIT LOOP
LOOP UNTIL ans$ = CHR$(27) ' **** CLEAR FOR WRITE ************
SELECT CASE loopcount%
CASE UBOUND(Lfiles%(1))
FOR Rloop% = 1 TO UBOUND(Lfiles%(1))
GET #12,Lfiles%(Rloop%)
LSET lockstring$ = STRING$(25,CHR$(1)) ' **** MARK FILE AS LOCKED
PUT #12,Lfiles%(Rloop%)
NEXT
CLOSE #12
restorescreen f$
EXIT SUB
CASE ELSE
CLOSE #12
restorescreen f$
var3% = 0
top_line% = topline%
pick_line% = pickline%
MEMPACK
CHAIN "romenu.pbc"
END SELECT
END SELECT
END SELECT
xqprint item$(subscript%),curntpos%+row%-1,col%,mhattr%
LOOP
EXIT SUB
accesserr:
e& = ERR
era& = ERADR
address$ = "allow_access"
errorhandler e&, era&, address$
END SUB
SUB update_access
SHARED Lfiles%()
OPEN "net_ctrl.ctr" FOR RANDOM ACCESS READ WRITE SHARED AS #12 LEN = 25
FIELD #12, 25 AS lockstring$
net_ctrl_records% = LOF(12) / 25
ON ERROR GOTO update
'ON ERROR GOTO 0
'FILE ID
'1 = RO.DB
'2 = CLDBASE.DB
'3 = INVNMST.DB
'4 = PARTS.DB
'5 = LABOR.DB
'6 = START.INF
'7 = VENDBSE.DB
'8 = LDATA.DTA
'9 = LTDATA.DTB
'10 = ACCT.DB
'11 = LH.DB
'12 = HP.DB
'13 = HCTRL.DB
'14 = ACRMAIN.DB
'15 = ACRSLAVE.DB
FOR Rloop% = 1 TO UBOUND(Lfiles%(1))
GET #12,Lfiles%(Rloop%)
LSET lockstring$ = STRING$(25,CHR$(2))
PUT #12,Lfiles%(Rloop%)
NEXT
CLOSE #12
ERASE Lfiles%()
EXIT SUB
update:
e& = ERR
era& = ERADR
address$ = "update_access"
errorhandler e&, era&, address$
END SUB
SUB check_prn
SHARED var1%,roscreen$
local status%,a$,parPort%,mes1$,mes2$,mes3$,s$
DEF SEG = &H40
ParPort%=(peek(8)+256*peek(9))+1 'get address of LPT1
DEF SEG
! push bp
! push sp
! push ds ;Save the Data Segment
! mov dx, Parport% ;LPT 1 Printer Address +1 (&h379 or 889)
! in ax, dx ;Request Status
! and ax, &hF0 ;turn off LSB's
! mov status%, ax ;Load the register into status%
! pop ds ;Return the Data Segment
! pop sp
! pop bp
SELECT CASE Status%
CASE &H80, &H70, &H60 ' ************** Printer bad ****************
mes1$ = "THE PRINTER IS NOT RESPONDING! PRESS ANY KEY ..."
EXIT SELECT
CASE &HD0 '************ Printer OK ***********
EXIT SUB
CASE ELSE ' ************** Printer bad ****************
mes1$ = "THE PRINTER IS NOT RESPONDING! PRESS ANY KEY ..."
EXIT SELECT
END SELECT
popwindow 11,15,12,67,4,fnattr%(0,7),0,-5,20," OOPS! "
xqprint mes1$,11,15,fnattr%(0,7)
a$ = INPUT$( 1 )
restorescreen roscreen$
mainmenu
END SUB
SUB open_view_access
OPEN "net_ctrl.ctr" FOR RANDOM ACCESS READ WRITE SHARED AS #12 LEN = 25
FIELD #12, 25 AS lockstring$
net_ctrl_records% = LOF(12) / 25
ON ERROR GOTO update_view
'ON ERROR GOTO 0
GET #12,16
LSET lockstring$ = STRING$(25,CHR$(2))
PUT #12,16
CLOSE #12
EXIT SUB
update_view:
e& = ERR
era& = ERADR
address$ = "update_access"
errorhandler e&, era&, address$
END
FUNCTION NetBios% '************ Determine if NetBios is present (for network users) **
Reg 1, 0
CALL INTERRUPT &H2A
AH = Reg( 1 ) \ 256
IF AH = 0 THEN
NetBios% = 0
ELSE
NetBios% = - 1
END IF
END FUNCTION
FUNCTION NetName%( Machine$ ) '************** Get current machine name.(network) *********
MName$ = SPACE$( 16 )
REG 1, &H5E00
REG 8, STRSEG( MName$ ) 'DS
REG 4, STRPTR( MName$ ) 'DX
CALL INTERRUPT &H21
IF ( REG( 0 ) AND 1 ) THEN 'Carry flag is set. (Error)
NetName% = 0
LSET MName$ = "N/A"
Strip MName$, Machine$
EXIT FUNCTION
END IF
CH = REG( 3 ) \ 256
IF CH = 0 THEN
NetName% = 0
EXIT FUNCTION
END IF
NetName% = REG( 3 ) - ( CH * 256 ) 'CL
Strip MName$, Machine$
END FUNCTION
SUB allow_access
SHARED var3%
retry:
OPEN "net_ctrl.ctr" FOR RANDOM ACCESS READ WRITE SHARED AS #12 LEN = 25
FIELD #12, 25 AS lockstring$
net_ctrl_records% = LOF(12) / 25
'**************PROCESS FILE *****************
FOR Rloop% = 1 TO UBOUND(Lfiles%(1))
recordnum% = Lfiles%(Rloop%)
GET #12,recordnum%
SELECT CASE lockstring$
CASE STRING$(25,CHR$(1)) ' ****** FILE IS MARKED AS LOCKED *********
CLOSE #12
GOTO execute_menu
CASE ELSE
EXIT SELECT
END SELECT
NEXT
CLOSE #12
OPEN "net_ctrl.ctr" FOR RANDOM ACCESS READ WRITE SHARED AS #12 LEN = 25
FIELD #12, 25 AS lockstring$
net_ctrl_records% = LOF(12) / 25
FOR Rloop% = 1 TO UBOUND(Lfiles%(1))
GET #12,Lfiles%(Rloop%)
LSET lockstring$ = STRING$(25,CHR$(1)) ' **** MARK FILE AS LOCKED
PUT #12,Lfiles%(Rloop%)
NEXT
CLOSE #12
EXIT SUB
execute_menu:
CLOSE #12
OPEN "net_ctrl.ctr" FOR RANDOM ACCESS READ WRITE SHARED AS #12 LEN = 25
FIELD #12, 25 AS lockstring$
net_ctrl_records% = LOF(12) / 25
LOCATE 1,1,0
f$ = savescreen$
s$ = savescreen$
DIM item$(3)
item$(1) =" ATTEMPT FILE ACCESS LATER "
item$(2) =" ATTEMPT TO ACCESS FILE AGAIN "
item$(3) =" CONTINUOUS ATTEMPTS TO ACCESS FILE "
itemcount% = UBOUND(item$(1))
row% = 8
col% = 22
downto% = 12+itemcount%+1
outTo% = LEN(item$(1))+col%-1
bordr% = 1
attr% = fnattr%(4,3)
mhattr% = fnattr%(7,4)
PopWindow 10,col%,downto%-1,outTo%,bordr%, attr%, 0, -5, 10, ""
xqprint STRING$(36,CHR$(196)),12,22,fnattr%(4,3)
xqprint "ATTEMPT TO ACCESS FILE HAS FAILED -",10,22,fnattr%(4,3)
xqprint "FILE IS BUSY. SELECT OPTION:",11,22,fnattr%(4,3)
enterpayflag% = 0
subscript% = 1
curntpos% = 1
row% = 13
for mloop% = 1 to itemcount%
xqprint item$(mloop%),mloop%+row%-1,col%,attr%
next
xqprint item$(1),row%,col%,mhattr%
DO
WHILE NOT INSTAT
WEND
ans$=inkey$
SELECT CASE ans$
CASE chr$(0,72)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
DECR curntpos%
DECR subscript%
IF subscript% < 1 THEN subscript% = UBOUND(item$(1))
IF curntpos% < 1 THEN curntpos% = UBOUND(item$(1))
CASE chr$(0,80)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
INCR curntpos%
INCR subscript%
IF subscript% > UBOUND(item$(1)) THEN subscript% = 1
IF curntpos% > UBOUND(item$(1)) THEN curntpos% = 1
CASE chr$(13)
SELECT CASE curntpos%
ERASE item$
CASE 1
CLOSE
ERASE Lfiles%()
popwindow 13,36,13,44,1,fnattr%(0,3),0,0,0,""
ctext 13, "CLOSING",14,3
director% = 1
var3% = 0
top_line% = topline%
pick_line% = pickline%
MEMPACK
CHAIN "romenu.pbc"
CASE 2
restorescreen s$
CLOSE
s$ = savescreen$
popwindow 11,30,11,50,1,fnattr%(0,7),0,-5,0,""
xqprint "ATTEMPTING ACCESS ...",11,30,fnattr%(0,7)
SOUND 400,1
DELAY 1
restorescreen s$
GOTO retry
CASE 3
counter% = 1
restorescreen s$
popwindow 11,13,12,67,1,fnattr%(0,7),0,-5,0, ""
Xqprint " ATTEMPTING TO ACCESS FILE - PRESS ESC TO STOP ...",11,13,fnattr%(0,7)
xqprint " ATTEMPT # 1 ",12,13,fnattr%(0,7)
ans$ = ""
DO
ans$ = INKEY$
DELAY 1.2
INCR counter%
COLOR 0,7
loopcount% = 0
LOCATE 12,23
RINT counter%' IF counter% > 100 THEN EXIT LOOP
FOR Rloop% = 1 TO UBOUND(Lfiles%(1))
recordnum% = Lfiles%(Rloop%)
GET #12,recordnum%
SELECT CASE lockstring$
CASE STRING$(25,CHR$(1)) ' ****** FILE IS MARKED AS LOCKED *********
EXIT SELECT
CASE STRING$(25,CHR$(2))
INCR loopcount%
END SELECT
NEXT
IF loopcount% = UBOUND(Lfiles%(1)) THEN EXIT LOOP
LOOP UNTIL ans$ = CHR$(27) ' **** CLEAR FOR WRITE ************
SELECT CASE loopcount%
CASE UBOUND(Lfiles%(1))
FOR Rloop% = 1 TO UBOUND(Lfiles%(1))
GET #12,Lfiles%(Rloop%)
LSET lockstring$ = STRING$(25,CHR$(1)) ' **** MARK FILE AS LOCKED
PUT #12,Lfiles%(Rloop%)
NEXT
CLOSE #12
restorescreen f$
EXIT SUB
CASE ELSE
CLOSE #12
restorescreen f$
var3% = 0
top_line% = topline%
pick_line% = pickline%
MEMPACK
CHAIN "romenu.pbc"
END SELECT
END SELECT
END SELECT
xqprint item$(subscript%),curntpos%+row%-1,col%,mhattr%
LOOP
EXIT SUB
accesserr:
e& = ERR
era& = ERADR
address$ = "allow_access"
errorhandler e&, era&, address$
END SUB
SUB update_access
SHARED Lfiles%()
OPEN "net_ctrl.ctr" FOR RANDOM ACCESS READ WRITE SHARED AS #12 LEN = 25
FIELD #12, 25 AS lockstring$
net_ctrl_records% = LOF(12) / 25
ON ERROR GOTO update
'ON ERROR GOTO 0
'FILE ID
'1 = RO.DB
'2 = CLDBASE.DB
'3 = INVNMST.DB
'4 = PARTS.DB
'5 = LABOR.DB
'6 = START.INF
'7 = VENDBSE.DB
'8 = LDATA.DTA
'9 = LTDATA.DTB
'10 = ACCT.DB
'11 = LH.DB
'12 = HP.DB
'13 = HCTRL.DB
'14 = ACRMAIN.DB
'15 = ACRSLAVE.DB
FOR Rloop% = 1 TO UBOUND(Lfiles%(1))
GET #12,Lfiles%(Rloop%)
LSET lockstring$ = STRING$(25,CHR$(2))
PUT #12,Lfiles%(Rloop%)
NEXT
CLOSE #12
ERASE Lfiles%()
EXIT SUB
update:
e& = ERR
era& = ERADR
address$ = "update_access"
errorhandler e&, era&, address$
END SUB
SUB check_prn
SHARED var1%,roscreen$
local status%,a$,parPort%,mes1$,mes2$,mes3$,s$
DEF SEG = &H40
ParPort%=(peek(8)+256*peek(9))+1 'get address of LPT1
DEF SEG
! push bp
! push sp
! push ds ;Save the Data Segment
! mov dx, Parport% ;LPT 1 Printer Address +1 (&h379 or 889)
! in ax, dx ;Request Status
! and ax, &hF0 ;turn off LSB's
! mov status%, ax ;Load the register into status%
! pop ds ;Return the Data Segment
! pop sp
! pop bp
SELECT CASE Status%
CASE &H80, &H70, &H60 ' ************** Printer bad ****************
mes1$ = "THE PRINTER IS NOT RESPONDING! PRESS ANY KEY ..."
EXIT SELECT
CASE &HD0 '************ Printer OK ***********
EXIT SUB
CASE ELSE ' ************** Printer bad ****************
mes1$ = "THE PRINTER IS NOT RESPONDING! PRESS ANY KEY ..."
EXIT SELECT
END SELECT
popwindow 11,15,12,67,4,fnattr%(0,7),0,-5,20," OOPS! "
xqprint mes1$,11,15,fnattr%(0,7)
a$ = INPUT$( 1 )
restorescreen roscreen$
mainmenu
END SUB
SUB open_view_access
OPEN "net_ctrl.ctr" FOR RANDOM ACCESS READ WRITE SHARED AS #12 LEN = 25
FIELD #12, 25 AS lockstring$
net_ctrl_records% = LOF(12) / 25
ON ERROR GOTO update_view
'ON ERROR GOTO 0
GET #12,16
LSET lockstring$ = STRING$(25,CHR$(2))
PUT #12,16
CLOSE #12
EXIT SUB
update_view:
e& = ERR
era& = ERADR
address$ = "update_access"
errorhandler e&, era&, address$
END
FUNCTION NetBios% '************ Determine if NetBios is present (for network users) **
Reg 1, 0
CALL INTERRUPT &H2A
AH = Reg( 1 ) \ 256
IF AH = 0 THEN
NetBios% = 0
ELSE
NetBios% = - 1
END IF
END FUNCTION
FUNCTION NetName%( Machine$ ) '************** Get current machine name.(network) *********
MName$ = SPACE$( 16 )
REG 1, &H5E00
REG 8, STRSEG( MName$ ) 'DS
REG 4, STRPTR( MName$ ) 'DX
CALL INTERRUPT &H21
IF ( REG( 0 ) AND 1 ) THEN 'Carry flag is set. (Error)
NetName% = 0
LSET MName$ = "N/A"
Strip MName$, Machine$
EXIT FUNCTION
END IF
CH = REG( 3 ) \ 256
IF CH = 0 THEN
NetName% = 0
EXIT FUNCTION
END IF
NetName% = REG( 3 ) - ( CH * 256 ) 'CL
Strip MName$, Machine$
END FUNCTION
Covid is a plot by the Trump administration to destroy the MSM and leave us with fringe outlets that treat Trump tweets as journalistic "proof".
Nah, it's the Martians. They can't risk another defeat like they suffered listening to Slim Whitman so they decided to go the viral route.
Weatherman2020
Diamond Member
- Thread starter
- #5
Related.
www.bbc.com
Buzzfeed closing UK and Australian news operations
The online media company says it will be focusing on stories for its US audiences.
www.bbc.com
MaryL
Diamond Member
- Banned
- #6
The media, ever since the 1800's has made themselves the watchdogs and arbiters of every cause...Like
WR Hearst splendid little war, or say CBS and Murrow war against McCarthyism, and W. Conkite and CBS's 60 minutes, The Watergate and the Washington post. In all this, the media has over stepped . Just give us the facts WE will figure out what they mean.
WR Hearst splendid little war, or say CBS and Murrow war against McCarthyism, and W. Conkite and CBS's 60 minutes, The Watergate and the Washington post. In all this, the media has over stepped . Just give us the facts WE will figure out what they mean.
HenryBHough
Diamond Member
Hey, I'm not even Italian and I can write spaghetti code better'n dat!
Tastes better, too.
Tastes better, too.
MaryL
Diamond Member
- Banned
- #8
An open and free media that just coincidentally panders to gay rights and pushes anti white anti Christian agenda, never sees outrageous black crimes but questions every and anything whites do but yet cant question itself or these things, not seeing the spirit of Edward R. Murrow in the new media. Sure, question everything, but not yourselves.
miketx
Diamond Member
- Dec 25, 2015
- 121,555
- 70,538
- 2,645
- Banned
- #9
Nothing funny about this, it's real.I learned to code decades ago. Here are a couple network access routines and a routine to check if the printer is ready in my shop program.
SUB allow_access
SHARED var3%
retry:
OPEN "net_ctrl.ctr" FOR RANDOM ACCESS READ WRITE SHARED AS #12 LEN = 25
FIELD #12, 25 AS lockstring$
net_ctrl_records% = LOF(12) / 25
'**************PROCESS FILE *****************
FOR Rloop% = 1 TO UBOUND(Lfiles%(1))
recordnum% = Lfiles%(Rloop%)
GET #12,recordnum%
SELECT CASE lockstring$
CASE STRING$(25,CHR$(1)) ' ****** FILE IS MARKED AS LOCKED *********
CLOSE #12
GOTO execute_menu
CASE ELSE
EXIT SELECT
END SELECT
NEXT
CLOSE #12
OPEN "net_ctrl.ctr" FOR RANDOM ACCESS READ WRITE SHARED AS #12 LEN = 25
FIELD #12, 25 AS lockstring$
net_ctrl_records% = LOF(12) / 25
FOR Rloop% = 1 TO UBOUND(Lfiles%(1))
GET #12,Lfiles%(Rloop%)
LSET lockstring$ = STRING$(25,CHR$(1)) ' **** MARK FILE AS LOCKED
PUT #12,Lfiles%(Rloop%)
NEXT
CLOSE #12
EXIT SUB
execute_menu:
CLOSE #12
OPEN "net_ctrl.ctr" FOR RANDOM ACCESS READ WRITE SHARED AS #12 LEN = 25
FIELD #12, 25 AS lockstring$
net_ctrl_records% = LOF(12) / 25
LOCATE 1,1,0
f$ = savescreen$
s$ = savescreen$
DIM item$(3)
item$(1) =" ATTEMPT FILE ACCESS LATER "
item$(2) =" ATTEMPT TO ACCESS FILE AGAIN "
item$(3) =" CONTINUOUS ATTEMPTS TO ACCESS FILE "
itemcount% = UBOUND(item$(1))
row% = 8
col% = 22
downto% = 12+itemcount%+1
outTo% = LEN(item$(1))+col%-1
bordr% = 1
attr% = fnattr%(4,3)
mhattr% = fnattr%(7,4)
PopWindow 10,col%,downto%-1,outTo%,bordr%, attr%, 0, -5, 10, ""
xqprint STRING$(36,CHR$(196)),12,22,fnattr%(4,3)
xqprint "ATTEMPT TO ACCESS FILE HAS FAILED -",10,22,fnattr%(4,3)
xqprint "FILE IS BUSY. SELECT OPTION:",11,22,fnattr%(4,3)
enterpayflag% = 0
subscript% = 1
curntpos% = 1
row% = 13
for mloop% = 1 to itemcount%
xqprint item$(mloop%),mloop%+row%-1,col%,attr%
next
xqprint item$(1),row%,col%,mhattr%
DO
WHILE NOT INSTAT
WEND
ans$=inkey$
SELECT CASE ans$
CASE chr$(0,72)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
DECR curntpos%
DECR subscript%
IF subscript% < 1 THEN subscript% = UBOUND(item$(1))
IF curntpos% < 1 THEN curntpos% = UBOUND(item$(1))
CASE chr$(0,80)
xqprint item$(subscript%),curntpos%-1+row%,col%,attr%
INCR curntpos%
INCR subscript%
IF subscript% > UBOUND(item$(1)) THEN subscript% = 1
IF curntpos% > UBOUND(item$(1)) THEN curntpos% = 1
CASE chr$(13)
SELECT CASE curntpos%
ERASE item$
CASE 1
CLOSE
ERASE Lfiles%()
popwindow 13,36,13,44,1,fnattr%(0,3),0,0,0,""
ctext 13, "CLOSING",14,3
director% = 1
var3% = 0
top_line% = topline%
pick_line% = pickline%
MEMPACK
CHAIN "romenu.pbc"
CASE 2
restorescreen s$
CLOSE
s$ = savescreen$
popwindow 11,30,11,50,1,fnattr%(0,7),0,-5,0,""
xqprint "ATTEMPTING ACCESS ...",11,30,fnattr%(0,7)
SOUND 400,1
DELAY 1
restorescreen s$
GOTO retry
CASE 3
counter% = 1
restorescreen s$
popwindow 11,13,12,67,1,fnattr%(0,7),0,-5,0, ""
Xqprint " ATTEMPTING TO ACCESS FILE - PRESS ESC TO STOP ...",11,13,fnattr%(0,7)
xqprint " ATTEMPT # 1 ",12,13,fnattr%(0,7)
ans$ = ""
DO
ans$ = INKEY$
DELAY 1.2
INCR counter%
COLOR 0,7
loopcount% = 0
LOCATE 12,23
' IF counter% > 100 THEN EXIT LOOP
FOR Rloop% = 1 TO UBOUND(Lfiles%(1))
recordnum% = Lfiles%(Rloop%)
GET #12,recordnum%
SELECT CASE lockstring$
CASE STRING$(25,CHR$(1)) ' ****** FILE IS MARKED AS LOCKED *********
EXIT SELECT
CASE STRING$(25,CHR$(2))
INCR loopcount%
END SELECT
NEXT
IF loopcount% = UBOUND(Lfiles%(1)) THEN EXIT LOOP
LOOP UNTIL ans$ = CHR$(27) ' **** CLEAR FOR WRITE ************
SELECT CASE loopcount%
CASE UBOUND(Lfiles%(1))
FOR Rloop% = 1 TO UBOUND(Lfiles%(1))
GET #12,Lfiles%(Rloop%)
LSET lockstring$ = STRING$(25,CHR$(1)) ' **** MARK FILE AS LOCKED
PUT #12,Lfiles%(Rloop%)
NEXT
CLOSE #12
restorescreen f$
EXIT SUB
CASE ELSE
CLOSE #12
restorescreen f$
var3% = 0
top_line% = topline%
pick_line% = pickline%
MEMPACK
CHAIN "romenu.pbc"
END SELECT
END SELECT
END SELECT
xqprint item$(subscript%),curntpos%+row%-1,col%,mhattr%
LOOP
EXIT SUB
accesserr:
e& = ERR
era& = ERADR
address$ = "allow_access"
errorhandler e&, era&, address$
END SUB
SUB update_access
SHARED Lfiles%()
OPEN "net_ctrl.ctr" FOR RANDOM ACCESS READ WRITE SHARED AS #12 LEN = 25
FIELD #12, 25 AS lockstring$
net_ctrl_records% = LOF(12) / 25
ON ERROR GOTO update
'ON ERROR GOTO 0
'FILE ID
'1 = RO.DB
'2 = CLDBASE.DB
'3 = INVNMST.DB
'4 = PARTS.DB
'5 = LABOR.DB
'6 = START.INF
'7 = VENDBSE.DB
'8 = LDATA.DTA
'9 = LTDATA.DTB
'10 = ACCT.DB
'11 = LH.DB
'12 = HP.DB
'13 = HCTRL.DB
'14 = ACRMAIN.DB
'15 = ACRSLAVE.DB
FOR Rloop% = 1 TO UBOUND(Lfiles%(1))
GET #12,Lfiles%(Rloop%)
LSET lockstring$ = STRING$(25,CHR$(2))
PUT #12,Lfiles%(Rloop%)
NEXT
CLOSE #12
ERASE Lfiles%()
EXIT SUB
update:
e& = ERR
era& = ERADR
address$ = "update_access"
errorhandler e&, era&, address$
END SUB
SUB check_prn
SHARED var1%,roscreen$
local status%,a$,parPort%,mes1$,mes2$,mes3$,s$
DEF SEG = &H40
ParPort%=(peek(8)+256*peek(9))+1 'get address of LPT1
DEF SEG
! push bp
! push sp
! push ds ;Save the Data Segment
! mov dx, Parport% ;LPT 1 Printer Address +1 (&h379 or 889)
! in ax, dx ;Request Status
! and ax, &hF0 ;turn off LSB's
! mov status%, ax ;Load the register into status%
! pop ds ;Return the Data Segment
! pop sp
! pop bp
SELECT CASE Status%
CASE &H80, &H70, &H60 ' ************** Printer bad ****************
mes1$ = "THE PRINTER IS NOT RESPONDING! PRESS ANY KEY ..."
EXIT SELECT
CASE &HD0 '************ Printer OK ***********
EXIT SUB
CASE ELSE ' ************** Printer bad ****************
mes1$ = "THE PRINTER IS NOT RESPONDING! PRESS ANY KEY ..."
EXIT SELECT
END SELECT
popwindow 11,15,12,67,4,fnattr%(0,7),0,-5,20," OOPS! "
xqprint mes1$,11,15,fnattr%(0,7)
a$ = INPUT$( 1 )
restorescreen roscreen$
mainmenu
END SUB
SUB open_view_access
OPEN "net_ctrl.ctr" FOR RANDOM ACCESS READ WRITE SHARED AS #12 LEN = 25
FIELD #12, 25 AS lockstring$
net_ctrl_records% = LOF(12) / 25
ON ERROR GOTO update_view
'ON ERROR GOTO 0
GET #12,16
LSET lockstring$ = STRING$(25,CHR$(2))
PUT #12,16
CLOSE #12
EXIT SUB
update_view:
e& = ERR
era& = ERADR
address$ = "update_access"
errorhandler e&, era&, address$
END
FUNCTION NetBios% '************ Determine if NetBios is present (for network users) **
Reg 1, 0
CALL INTERRUPT &H2A
AH = Reg( 1 ) \ 256
IF AH = 0 THEN
NetBios% = 0
ELSE
NetBios% = - 1
END IF
END FUNCTION
FUNCTION NetName%( Machine$ ) '************** Get current machine name.(network) *********
MName$ = SPACE$( 16 )
REG 1, &H5E00
REG 8, STRSEG( MName$ ) 'DS
REG 4, STRPTR( MName$ ) 'DX
CALL INTERRUPT &H21
IF ( REG( 0 ) AND 1 ) THEN 'Carry flag is set. (Error)
NetName% = 0
LSET MName$ = "N/A"
Strip MName$, Machine$
EXIT FUNCTION
END IF
CH = REG( 3 ) \ 256
IF CH = 0 THEN
NetName% = 0
EXIT FUNCTION
END IF
NetName% = REG( 3 ) - ( CH * 256 ) 'CL
Strip MName$, Machine$
END FUNCTION
Overtime Paycheck
Active Member
- May 6, 2020
- 153
- 40
- 31
#LearnToCode
I don't code, I like regular language and refuse to learn anything else.
Missourian
Diamond Member
Vice lays off 155 today...blames Google, Silicon Valley...
nypost.com
...they may be onto something here...or Woke Journalism is failing...or both...
Vice Media CEO slams ‘Big Tech’ as ‘great threat to journalism’ amid cuts
The boss of Vice Media blamed “Big Tech” as she revealed a fresh wave of layoffs at the gonzo news gatherer, saying Silicon Valley poses a “great threat to journalism.” The …
nypost.com
...they may be onto something here...or Woke Journalism is failing...or both...
Missourian
Diamond Member
Covid is a plot by the Trump administration to destroy the MSM and leave us with fringe outlets that treat Trump tweets as journalistic "proof".
The line between news and opinion has blurred. Report what happened. Leave the opinion for the op-eds.
Similar threads
- Replies
- 61
- Views
- 388
- Poll
- Replies
- 58
- Views
- 404
- Replies
- 0
- Views
- 86
Latest Discussions
- Replies
- 61
- Views
- 473
- Replies
- 80
- Views
- 264
Forum List
-
-
-
-
-
Political Satire 8561
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
ObamaCare 781
-
-
-
-
-
-
-
-
-
-
-
Member Usernotes 485
-
-
-
-
-
-
-
-
-
-