• The CompuBBS code - October 2020 (3/3)

    From Aryavartan Riekh@21:1/5 to All on Mon Oct 26 01:40:35 2020
    [continued from previous message]

    w = left( awhen , 5 ) +",M, 0,"+oaccount+", , ,F, 0, 0, ,
    0.0000,00000000, 0, ,"+ ommid +", , , , ," +right(awhen,3)
    +","+oclearing+", "

    do write with w

    return

    proc new2cancel

    parameter olocate,oseq,oshares,ocontra && Contra indeicates
    reason for cancel

    if olocate <= 0 .or. olocate > reccount()

    ? time()+" CANCEL LOCATE OUT OF BOUNDS " +str( olocate ,
    8 , 0)+ " SEQ=" +str(oseq,8,0)

    return 0

    endif

    goto olocate

    if oseq # SEQ

    *** ? time()+" CANCEL OUT OF DATE " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)

    ttoolate = ttoolate + 1

    return 0

    endif

    if LEAVES <= oshares

    ttoolate = ttoolate + 1

    return

    endif

    xshares = LEAVES - oshares

    do mwrite with "X", SEQ , xshares , PRICE , ocontra , " " , 0 ,
    recno()

    txcount = txcount + 1

    dleaves = LEAVES - xshares

    if dleaves <=0

    && Must set LEAVES to zero to pull order from indexes

    replace LEAVES with 0 , SEQ with tnextdead tnextdead =
    recno()

    else

    replace LEAVES with dleaves

    endif

    return


    ****** Cancel Order takes a locator and a SEQ number ****** passed
    shares in new intedned order size ****** returns number of shares
    canceled and leaves record pointer on order canceled.

    proc i2cancel

    parameter olocate,oseq,oshares,ocontra && Contra indeicates
    reason for cancel


    if olocate <= 0 .or. olocate > reccount()

    ? time()+" CANCEL LOCATE OUT OF BOUNDS " +str( olocate ,
    8 , 0)+ " SEQ=" +str(oseq,8,0)

    return 0

    endif

    goto olocate

    if oseq # SEQ

    *** ? time()+" CANCEL OUT OF DATE " +str( olocate , 8 , 0)+ " SEQ=" +str(oseq,8,0)

    ttoolate = ttoolate + 1

    return 0

    endif

    msize = LEAVES + FILLED && Current size of order

    if oshares >= msize

    *** ? time()+" INTENEDED CANCEL BIGGER THAN ORDER SHARES="+str( oshares,
    6 , 0 )+" REASON="+ocontra

    return 0

    endif

    xshares = msize - oshares && HOwmany do we have to cancel to get
    from current size to new size?

    if xshares > LEAVES && Don't cancel more than are open

    xshares = LEAVES

    endif

    if xshares = 0

    ttoolate = ttoolate + 1

    return 0

    endif

    do mwrite with "X", SEQ , xshares , PRICE , ocontra , " " , 0 ,
    recno()

    txcount = txcount + 1

    dleaves = LEAVES - xshares

    if dleaves <=0

    && Must set LEAVES to zero to pull order from indexes

    replace LEAVES with 0 , SEQ with tnextdead tnextdead =
    recno()

    else

    replace LEAVES with dleaves

    endif

    return xshares


    proc initstatus activate window status @ 0,1 SAY "Orders:" @ 0,27 SAY
    "Executions:" @ 0,52 SAY "Cancels:" activate window ticker
    return

    proc showstatus activate window status @ 0,11 SAY tseq PICTURE
    "##,###,###" @ 0,38 SAY tmatch PICTURE "##,###,###" @ 0,60 SAY
    txcount PICTURE "##,###,###" activate window ticker
    return

    proc processtcpip

    param ptm

    tcommand = substr( ptm , 1 , 1 )

    if geom

    ? time()+" Command recieved after EOM:"+tcommand return

    endif

    do case

    case tcommand = "H"

    tport = substr( ptm , 2 , 6 )

    if !seek( tport , "SOURCES" )

    insert into SOURCES values ( tport , 1 )

    endif

    tinseq = val(substr( ptm , 73, 9 ) )

    if tinseq # SOURCES.SEQ

    if tinseq < SOURCES.SEQ

    *** ? time()+" Duped inseq "+tport+" Expected:"+str( SOURCES.SEQ , 9,
    0)+" Got:"+str( tinseq , 9 , 0 )
    return

    endif

    do alert with "Gapped inseq "+tport+"
    Expected:"+str( SOURCES.SEQ , 9, 0)+"
    Got:"+str( tinseq , 9 , 0 )

    endif

    tuser = substr( ptm , 8 , 4 ) ttoken = substr(
    ptm , 12 , 10 ) tbuy_sell = substr( ptm , 22 , 1
    ) tshares = val( substr( ptm , 23 , 6 ) ) tmin =
    val( substr( ptm , 29 , 6 ) ) tstock = substr(
    ptm , 35 , 6 ) tprice = val( substr( ptm , 41 ,
    11 ) ) ttif = val( substr( ptm , 52 , 5 ) )
    tdisplay = substr( ptm , 57 , 1 ) tshort =
    substr( ptm , 58 , 1 ) tpa = substr( ptm , 59 ,
    1 ) tmmid = substr( ptm , 60 , 4 ) tclearing =
    substr( ptm , 64 , 1 ) tflags = substr( ptm , 65
    , 4 )

    if tbuy_sell = "B"

    xshort = " "

    else

    if tbuy_sell # "S"

    ? time()+" Bad buy_sell
    "+tbuy_sell+" port="+tport

    return

    endif

    do case case tshort = "Y" xshort = "S"

    case tshort = "S" xshort = "S"

    case tshort = "N" xshort = "L"

    case tshort = "L" xshort = "L"

    case tshort = "E" xshort = "E"

    otherwise xshort = "?"

    endcase

    endif

    if tshares <= 0

    ? time()+" Jerk boy zero shares TOKEN "
    +tport+"-" +tuser+"-" +ttoken

    return

    endif

    if tshares >= 1000000

    ? time()+" Jerk boy million shares TOKEN
    " +tport+"-" +tuser+"-" +ttoken

    return

    endif


    if tprice <= 0

    ? time()+" Jerk boy zero price TOKEN "
    +tport+"-" +tuser+"-" +ttoken

    return

    endif


    if tprice >= 1000000

    ? time()+" Jerk boy million price TOKEN
    " +tport+"-" +tuser+"-" +ttoken

    return

    endif


    if ! tclearing $ "AIQOR"

    ? time()+" Jerk boy strange clearing >"
    +tclearing+"< TOKEN " +tport+"-"
    +tuser+"-" +ttoken

    return

    endif


    if ! tdisplay $ "YNLRP"

    ? time()+" Jerk boy strange display >"
    +tdisplay+"< TOKEN " +tport+"-"
    +tuser+"-" +ttoken

    return

    endif

    if (tdisplay = "R" .or. tdisplay = "P" ) .and.
    ttif > 0

    ? time()+" Jerk boy R or P or Q display
    with nonzero tif >" +str(ttif,5,0)+"<
    TOKEN " +tport+"-"+tuser+"-"+ttoken

    return

    endif

    if !gaccept

    ? time()+" Trade ignored outside SOD-EOD
    time "+tport+"-" +tuser+"-" +ttoken

    return

    endif

    if tclearing = "A"

    if !gactaccept

    ? time()+" ACT trade ignored
    outside ACT time " +tport+"-"
    +tuser+"-" +ttoken

    return

    endif

    endif


    select SOURCES replace SEQ with tinseq + 1
    select ISLAND

    do enter2order with tport , tuser , ttoken ,
    tbuy_sell , tshares , tstock , tprice , ttif ,
    xshort , tmmid , tpa , tdisplay , tmin ,
    tclearing , tflags

    case tcommand = "L"

    tolocate = val( substr( ptm , 2 , 8 ) ) toseq =
    val( substr( ptm , 10 , 9 ) ) tshares = val(
    substr( ptm , 19 , 6 ) ) treason = substr( ptm ,
    25 , 1 )

    do case case treason = "A" xreason = "#USR" case
    treason = "B"
    xreason = "#TME" case treason =
    "C"
    xreason = "#HLT" case treason =
    "D"
    xreason = "#SUP" case treason =
    "E"
    xreason = "#DNT" case treason =
    "F"
    xreason = "#MBL"

    otherwise xreason = "#USR" endcase

    do new2cancel with tolocate , toseq , tshares ,
    xreason

    case tcommand = "I"

    tport = substr( ptm , 2 , 6 )


    if !seek( tport , "SOURCES" )

    insert into SOURCES values ( tport , 1 )

    endif

    tinseq = val( substr( ptm , 24 , 9 ) )

    if tinseq # SOURCES.SEQ

    if tinseq < SOURCES.SEQ

    *** ? time()+" Duped REJ inseq "+tport+" Expected:"+str( SOURCES.SEQ ,
    9, 0)+" Got:"+str( tinseq , 9 ,
    0 ) return

    endif

    do alert with "Gapped REJ inseq
    "+tport+" Expected:"+str( SOURCES.SEQ ,
    9, 0)+" Got:"+str( tinseq , 9 , 0 )

    endif


    tuser = substr( ptm , 8 , 4 ) ttoken = substr(
    ptm , 12 , 10 ) ttype = substr( ptm , 22 , 1 )
    treason = substr( ptm , 23 , 1 )

    do enter2reject with tport , tuser , ttoken ,
    ttype , treason

    select SOURCES replace SEQ with tinseq + 1
    select ISLAND

    case tcommand = "Z"

    tolocate = val( substr( ptm , 2 , 8 ) ) toseq =
    val( substr( ptm , 10 , 9 ) ) tshares = val(
    substr( ptm , 19 , 6 ) ) treason = substr( ptm ,
    25 , 1 )

    do case case treason = "A" xreason = "#USR" case
    treason = "B"
    xreason = "#TME" case treason =
    "C"
    xreason = "#HLT" case treason =
    "D"
    xreason = "#SUP" case treason =
    "E"
    xreason = "#DNT" case treason =
    "F"
    xreason = "#MBL"

    otherwise xreason = "#USR" endcase


    =i2cancel( tolocate , toseq , tshares , xreason
    )

    case tcommand = "S"

    tport = substr( ptm , 2 , 6 )

    if !seek( tport , "SOURCES" )

    insert into SOURCES values ( tport , 1 )

    endif

    tinseq = val(substr( ptm , 58 , 9 ) )

    if tinseq # SOURCES.SEQ

    if tinseq < SOURCES.SEQ

    *** ? time()+" Duped REP inseq "+tport+" Expected:"+str( SOURCES.SEQ ,
    9, 0)+" Got:"+str( tinseq , 9 ,
    0 ) return

    endif

    do alert with "Gapped REP inseq
    "+tport+" Expected:"+str( SOURCES.SEQ ,
    9, 0)+" Got:"+str( tinseq , 9 , 0 )

    endif

    tuser = substr( ptm , 8 , 4 ) ttoken = substr(
    ptm , 12 , 10 ) tbuy_sell = substr( ptm , 22 , 1
    ) tshares = val( substr( ptm , 23 , 6 ) ) tstock
    = substr( ptm , 29 , 6 ) tprice = val( substr(
    ptm , 35 , 11 ) ) treport = substr( ptm , 46 , 1
    ) tshort = substr( ptm , 47 , 1 ) tpa = substr(
    ptm , 48 , 1 ) tmmid = substr( ptm , 49 , 4 )
    tclearing = substr( ptm , 53 , 1 ) tcontra =
    substr( ptm , 54 , 4 )


    if ! treport $ "YNS" ? time()+" Jerk boy REPORT
    code TOKEN " +tport

    return

    endif


    if tshares <= 0

    ? time()+" Jerk boy REPORT zero shares
    TOKEN "+tport+"-"+tuser+"-"+ttoken

    return

    endif


    if tshares >= 1000000

    ? "Jerk boy REPORT million shares TOKEN
    "+tport+"-"+tuser+"-"+ttoken

    return

    endif


    if tprice <= 0

    ? "Jerk boy REPORT zero price TOKEN
    "+tport+"-"+tuser+"-"+ttoken

    return

    endif

    if tprice >= 1000000

    ? "Jerk boy REPORT million price TOKEN
    "+tport+"-"+tuser+"-"+ttoken

    return

    endif


    if ! tclearing $ "ABSIQORN"

    ? "Jerk boy REPORT strange clearing
    >"+tclearing+"< TOKEN
    "+tport+"-"+tuser+"-"+ttoken

    return

    endif

    if !gaccept

    ? "Report ignored outside SOD-EOD time
    "+tport+"-"+tuser+"-"+ttoken

    return

    endif

    if tclearing = "A"

    if !gactaccept

    ? "ACT trade REPORT ignored
    outside ACT time
    "+tport+"-"+tuser+"-"+ttoken

    return

    endif

    endif

    do enter2report with tport , tuser , ttoken ,
    tbuy_sell , tshares , tstock , tprice , tshort ,
    tmmid , tpa , treport , tclearing , tcontra

    select SOURCES replace SEQ with tinseq + 1
    select ISLAND

    case tcommand = "D"

    tcseq = val( substr( ptm , 2 , 9 ) ) tcport =
    substr( ptm , 11 , 6 ) tcuser = substr( ptm , 17
    , 4 ) tctoken = substr( ptm , 21 , 10 )
    tcbuy_sell = substr( ptm , 31 , 1 ) tcshares =
    val( substr( ptm , 32 , 6 ) ) tcmatch = val(
    substr( ptm , 38 , 9 ) ) tcstock = substr( ptm ,
    47 , 6 ) tcprice = val( substr( ptm , 53 , 11 )
    ) tcmmid = substr( ptm , 64 , 4 ) tcmisc =
    substr( ptm , 68 , 1 ) tcreason = substr( ptm ,
    69 , 1 ) tcclearing = substr( ptm , 70 , 1 )

    do case case tcreason = "A" xreason = "#ERR"
    case tcreason = "B"
    xreason = "#CON" case tcreason =
    "C"
    xreason = "#SUP" case tcreason =
    "D"
    xreason = "#SYS" case tcreason =
    "E"
    xreason = "#EXT"

    otherwise

    ? time()+" Unvalid break reason
    = "+tcreason

    return

    endcase

    do case

    case tcbuy_sell = "B" xbuy_sell = "B"
    xshort = " "

    case tcbuy_sell = "S" xbuy_sell = "S"
    xshort = "L"

    case tcbuy_sell = "T" xbuy_sell = "S"
    xshort = "S"

    case tcbuy_sell = "E" xbuy_sell = "S"
    xshort = "E"

    otherwise

    ? time()+" Unvalid break
    buy_sell = "+tcbuy_sell return

    endcase

    do enterbreak with tcseq , tcport, tcuser,
    tctoken, xbuy_sell, tcshares , tcmatch ,tcstock
    , tcprice , tcmmid , xreason , tcmisc ,
    tcclearing , xshort

    case tcommand = "M"

    tctype = substr( ptm , 2 , 1 )

    do case

    case tctype = "S" && Stock maintence

    tport = substr( ptm , 3 , 6 )
    tuser = substr( ptm , 9 , 4 )
    ttoken = substr( ptm , 13 , 10 )

    tcstock = substr( ptm , 23 , 6 )

    tcshorttype = substr( ptm , 29 ,
    1 ) tcblocksub = substr( ptm ,
    30 , 1 ) tccenter = substr( ptm
    , 31 , 1 ) tcmisc = substr( ptm
    , 32 , 4 )

    do entermaint with tport, tuser,
    ttoken, tcstock , tcshorttype ,
    tcblocksub , tccenter , tcmisc

    case tctype = "A" && Account settings

    taccount = substr( ptm , 3 , 6 )
    tpassword = substr( ptm , 9 , 10
    ) ttest = substr( ptm , 19 , 1 )
    ttrusted = substr( ptm , 20 , 1
    ) tthresh = val( substr( ptm ,
    21 , 6 ) ) tsscheck = substr(
    ptm , 27 , 1 ) tiflag = substr(
    ptm , 28 , 1 ) tdefault =
    substr( ptm , 29 , 4 )

    do enteraccount with taccount,
    tpassword, ttest , ttrusted ,
    tthresh, tsscheck, tiflag,
    tdefault

    case tctype = "F" && Account settings

    taccount = substr( ptm , 3 , 6 )
    tmmid = substr( ptm , 9 , 4 )
    tclearing = substr( ptm , 13 , 1
    )

    do enterfirm with taccount,
    tmmid, tclearing

    case tctype = "T" && Stock state

    tport = substr( ptm , 3 , 6 )
    tuser = substr( ptm , 9 , 4 )
    ttoken = substr( ptm , 13 , 10 )

    tcstock = substr( ptm , 23 , 6 )

    tcstate = substr( ptm , 29 , 1 )

    do enterstate with tport, tuser,
    ttoken, tcstock , tcstate

    otherwise

    ? time()+" Unvalid maint reason
    = "+tctype


    endcase

    otherwise

    do alert with "Unknown command"+ptm

    endcase

    return

    proc sendeos

    s = "E" call int99 with s

    if s # "f" .and. s # "b"

    activate window output

    ? time() +" !!!! ERROR ON EOS WRITE!!!!!!"

    ? ws

    activate window ticker

    suspend

    endif

    return


    proc flush

    s = "F" call int99 with s if s # "f" ? "!!!!ERROR ON FLUSH!!!!"

    do alert with "Error on flush:"+werror(s) suspend endif

    gstoredflag = .F.

    return

    proc shutdown

    do alert with "Shutdown initiated"

    if !geom && Shutting down too early? Just in case...

    wait window "Can't end day, EOM has not happened yet!"
    nowait

    do alert with "Ending day attempted before EOM time!"

    return

    endif


    sdk = chr( (rand() * 25) + asc("A") )

    wait window "Initiate Shutdown by pressing ["+sdk+"] within 10
    seconds" to sdh timeout 10

    if upper( sdh ) # sdk

    wait window "Shutdown Aborted" nowait

    do alert with "Shutdown aborted"

    return

    endif

    wait window "Confirm Shutdown by pressing the magic key within
    10 seconds" to sdh timeout 10

    if upper( sdh ) # "M"

    wait window "Inccorect Shutdown confirmation" nowait

    do alert with "Incorrect shutdown magic key"

    return

    endif

    do alert with "Shutdown confirmed"

    if file( mholdofffile )

    ? "Holdoff file exists! Escalate!" suspend

    else

    sdf = fcreate( mholdofffile ) =fputs( sdf , "Stop in the
    name of love!") =fclose( sdf )

    endif

    if !file( mholdofffile )

    wait window "No HOLDOFF file created, aborting Shutdown"
    nowait

    do alert with "No HOLDOFF file created, aborting
    shutdown"

    return

    endif

    wait window "Shutting down..." nowait

    do swrite with "N" , "" wait window "Shutting down... 3" timeout
    1

    do swrite with "N" , "" wait window "Shutting down... 2" timeout
    1

    do swrite with "N" , "" wait window "Shutting down... 1" timeout
    1

    do flush

    wait window "Flushing..." timeout 1

    do sendeos do flush

    wait window "Sending End of Session... 3" timeout 1 do flush

    wait window "Sending End of Session... 2" timeout 1 do flush

    wait window "Sending End of Session... 1" timeout 1 do flush

    wait window "Sending End of Session... 0" timeout 1 do flush

    mdone = .T.

    zap

    return


    proc pingreply param preply , ptm

    ptoken = substr( ptm , 2 , 12 ) pport = substr( ptm , 14 , 4 )

    x = "R"+ptoken+str( tseq ,9,0)+str( tmatch ,9,0)+str(0,9,0)


    s = "S"+chr(len(x))+ preply+pport+ x call int99 with s

    return


    proc seteventflags param secode

    do case

    case secode = "SOD"

    gaccept = .T. gactaccept = .T.

    case secode = "EOA"

    gactaccept = .F.

    case secode = "EOD"

    gaccept = .F.

    case secode = "EOM"

    geom = .T. endcase

    return

    proc alert parameter s xs = dtoc(date())+" "+time() +"-"+ s

    ? xs

    IF FILE( malertfile ) && Does file exist? errfile = FOPEN(
    malertfile ,12) && If so, open read/write
    ELSE errfile = FCREATE( malertfile ) && If not create it ENDIF

    IF errfile < 0 && Check for error opening file WAIT 'Cannot open
    or create output file' WINDOW NOWAIT
    ELSE && If no error, write to file =fseek( errfile, 0 , 2 )
    =FWRITE(errfile, xs + chr(13) + chr(10) )
    ENDIF

    =FCLOSE(errfile) && Close file

    * ? chr(07)+chr(07)+chr(07)+chr(07) return -----------------------------------------------------------------------------



    --
    "The nature of the good is to overcome and defeat the bad." - divine voice



    --
    "The nature of the good is to overcome and defeat the bad." - divine voice



    --
    "The nature of the good is to overcome and defeat the bad." - divine voice



    --
    "The nature of the good is to overcome and defeat the bad." - divine voice



    --
    "The nature of the good is to overcome and defeat the bad." - divine voice



    --
    "The nature of the good is to overcome and defeat the bad." - divine voice



    --
    "The nature of the good is to overcome and defeat the bad." - divine voice



    --
    "The nature of the good is to overcome and defeat the bad." - divine voice



    --
    "The nature of the good is to overcome and defeat the bad." - divine voice



    --
    "The nature of the good is to overcome and defeat the bad." - divine voice

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)