Programmer 7500/MAX_PROGRAMMERS.iso/CLIPPER/DATABASE/DB3STOCK.ZIP/DB3STOCK.SKL

Text File | 1986-04-12 | 11.3 KB | 360 lines

  procedure bigboxdt
  * -----------------------------------------------------
  * BIGBOXDT - draws a large box for major screen display
  * -----------------------------------------------------
  * define HEADER as a str < 60 chars before entering this routine
  SET COLOR TO 7/0
  @ 1,0 SAY "╔══════════════════════════════════════════════════════"
  @ 1,55 SAY "═══════════════════════╗"
  L=2
  DO WHILE L<24
     @ L,0 SAY "║"
     @ L,78 SAY "║"
     L=L+1
  ENDDO
  @ 24,0 SAY "╚══════════════════════════════════════════════════════"
  @ 24,55 SAY "═══════════════════════╝"
  @ 3, 1 SAY "---------------------------------------"
  @ 3,40 SAY "--------------------------------------"
  @ 2,3 say date()
  @ 2,69 say time()
  * H E A D E R  programming set up below
  set color to 15/0
  @ 2,(80-len(header))/2 say header
  set color to 7/0
  RETURN

  procedure boxclear
  * ---------------------------------------------------------------
  * BOXCLEAR.prg - a routine that clears the screen INSIDE BIGBOXDT
  * ---------------------------------------------------------------
  * define LN BEFORE coming into this routine
  do while ln<24
     @ ln,1 say space(77)
     ln=ln+1
  enddo
  RETURN


  procedure smallbox
  * -----------------------------------------------------------
  * SMALLBOX.prg - a routine that draws a smaller box on screen
  * -----------------------------------------------------------
  @ 4,12 SAY "┌───────────────────────────────────────────────────────┐"
  L=5
  DO WHILE L<21
     @ L,12 SAY "│"
     @ L,68 SAY "│"
     L=L+1
  ENDDO
  @21,12 SAY "└───────────────────────────────────────────────────────┘"
  RETURN

  procedure lineboxm
  * ------------------------------------------------------------------
  * LINEBOXM.prg - draws a single line box in the middle of the screen
  * ------------------------------------------------------------------
  * define MSG as a str <55 chars before entering this routine
  @ 11,12 SAY "┌───────────────────────────────────────────────────────┐"
  @ 12,12 SAY "│"
  @ 12,68 SAY "│"
  @ 13,12 SAY "└───────────────────────────────────────────────────────┘"
  set color to 15/0
  @12,(80-len(msg))/2 say msg
  set color to 7/0
  RETURN


  procedure slinboxm
  * ------------------------------------------------------------------
  * SLINBOXM.prg - draws a single line box in the middle of the screen
  * ------------------------------------------------------------------
  * define MSG as a str <55 chars before entering this routine
  SET COLOR TO 7/0
  @ 11,12 SAY "┌───────────────────────────────────────────────────────┐"
  @ 12,12 SAY "│"
  @ 12,68 SAY "│"
  @ 13,12 SAY "└───────────────────────────────────────────────────────┘"
  set color to 15/0
  @12,(80-len(msg))/2 say msg
  set color to 7/0
  RETURN


  procedure slinboxt
  * ------------------------------------------------------------------
  * SLINBOXT.prg - draws a single line box at the top of the screen
  * ------------------------------------------------------------------
  * define MSG as a str <55 chars before entering this routine
  SET COLOR TO 7/0
  @  1,12 SAY "┌───────────────────────────────────────────────────────┐"
  @  2,12 SAY "│"
  @  2,68 SAY "│"
  @  3,12 SAY "└───────────────────────────────────────────────────────┘"
  set color to 15/0
  @ 2,(80-len(msg))/2 say msg
  set color to 7/0
  RETURN

  procedure slinboxb
  * ------------------------------------------------------------------
  * SLINBOXB.prg - draws a single line box at the bottom of the screen
  * ------------------------------------------------------------------
  * define MSG as a str <55 chars before entering this routine
  SET COLOR TO 7/0
  @ 22,12 SAY "┌───────────────────────────────────────────────────────┐"
  @ 23,12 SAY "│"
  @ 23,68 SAY "│"
  @ 24,12 SAY "└───────────────────────────────────────────────────────┘"
  set color to 15/0
  @23,(80-len(msg))/2 say msg
  set color to 7/0
  RETURN


  procedure dlinboxm
  * ------------------------------------------------------------------
  * DLINBOXM.prg - draws a double line box at the middle of the screen
  * ------------------------------------------------------------------
  * define MSG as a str <55 chars before entering this routine
  SET COLOR TO 7/0
  @ 11,12 SAY "╔═══════════════════════════════════════════════════════╗"
  @ 12,12 SAY "║"
  @ 12,68 SAY "║"
  @ 13,12 SAY "╚═══════════════════════════════════════════════════════╝"
  set color to 15/0
  @12,(80-len(msg))/2 say msg
  set color to 7/0
  RETURN


  procedure dlinboxt
  * ------------------------------------------------------------------
  * DLINBOXT.prg - draws a double line box at the top of the screen
  * ------------------------------------------------------------------
  * define MSG as a str <55 chars before entering this routine
  SET COLOR TO 7/0
  @  1,12 SAY "╔═══════════════════════════════════════════════════════╗"
  @  2,12 SAY "║"
  @  2,68 SAY "║"
  @  3,12 SAY "╚═══════════════════════════════════════════════════════╝"
  set color to 15/0
  @ 2,(80-len(msg))/2 say msg
  set color to 7/0
  RETURN


  procedure dlinboxb
  * ------------------------------------------------------------------
  * DLINBOXB.prg - draws a double line box at the bottom of the screen
  * ------------------------------------------------------------------
  * define MSG as a str <55 chars before entering this routine
  SET COLOR TO 7/0
  @ 22,12 SAY "╔═══════════════════════════════════════════════════════╗"
  @ 23,12 SAY "║"
  @ 23,68 SAY "║"
  @ 24,12 SAY "╚═══════════════════════════════════════════════════════╝"
  set color to 15/0
  @23,(80-len(msg))/2 say msg
  set color to 7/0
  RETURN


  procedure linprm23
  * --------------------------------------
  * LINPRM23.PRG - GET A PARTICULAR KEY
  * --------------------------------------
  * define MSG as a str <75 chars before entering this routine
  * define TEST as a target string of chars to test FOR
  * define TZ as PUBLIC, and then initialize to " " before using this routine
  @ 23,1 say space(77)
  set color to 15/0
  @ 23,(80-len(msg))/2 say msg
  set color to 7/0
  tz=" "
  do while at(tz,test)=0
     tz=" "
     CLEAR GETS
     tkol=((80-len(msg))/2)+len(msg)+2
     if tkol>77
        tkol=77
     endif
     @ 23,tkol get tz picture "!"
     read
  enddo
  set color to 7/0
  @ 23,1 SAY SPACE(77)
  RETURN

  procedure linmsg23
  * --------------------------------------
  * LINMSG23.PRG - GET ANY KEY TO CONTINUE
  * --------------------------------------
  * define MSG as a str <75 chars before entering this routine
  @ 23,1 say space(77)
  set color to 15/0
  @ 23,(80-len(msg))/2 say msg
  set color to 7/0
  zz=" "
  tkol=((80-len(msg))/2)+len(msg)+2
  if tkol>77
   tkol=77
  endif
  @ 23,tkol get zz
  read
  set color to 7/0
  @ 23,1 SAY SPACE(77)
  RETURN


  procedure prtmsg23
  * --------------------------------------------------------------
  * PRTMSG23.PRG - prints a message ONLY on line 23; no gets/reads
  * --------------------------------------------------------------
  * define MSG as a str <75 chars before entering this routine
  @23,1 say space(77)
  set color to 15/0
  @23,(80-len(msg))/2 say msg
  set color to 7/0
  RETURN


  procedure getfld23
  * --------------------------------------
  * GETFLD23.PRG - GET A PARTICULAR FIELD
  * --------------------------------------
  * define KOL as 0 before entering the routine.
  * define FEELD as any EMPTY string of any length.
  * define MSG as a str <75 chars before entering this routine
  * the variable KOL is now the new column position at which to GET the field
  msg=msg+"  "+feeld
  @ 23,1 say space(77)
  set color to 15/0
  @ 23,(80-len(msg))/2 say msg
  set color to 7/0
  kol=col()-len(feeld)
  if kol>77
     kol=77
  endif
  RETURN



  procedure prevmo
  * ----------------------------------------------------------
  * Prevmo.prg -- finds the ACTUAL month of the previous month
  * ----------------------------------------------------------
  * must define PMONTH as a blank string BEFORE entering this routine
  Tmonth=substr(dtoc(date(),1,2)+"/"+substr(dtoc(date(),7,2)
  Pmo=ctod(substr(Tmonth,1,2)+"/15/"+substr(Tmonth,4,2))
  Pmo=Pmo-30
  Pmonth=substr(dtoc(Pmo),1,2)+"/"+substr(dtoc(Pmo),7,2)
  RETURN

  procedure nextmo
  * ----------------------------------------------------------
  * Nextmo.prg -- finds the ACTUAL month of the next month
  * ----------------------------------------------------------
  *  must define NMONTH as a blank string BEFORE entering this routine
  Tmonth=substr(dtoc(date(),1,2)+"/"+substr(dtoc(date(),7,2)
  Nmo=ctod(substr(Tmonth,1,2)+"/15/"+substr(Tmonth,4,2))
  Nmo=Nmo+30
  Nmonth=substr(dtoc(Nmo),1,2)+"/"+substr(dtoc(Nmo),7,2)
  RETURN

  procedure passwerd
  * -------------------------------------------------------------
  * PASSWERD.PRG - COMPLETE SECURITY PROGRAM FOR AUTHORIZED USERS
  * -------------------------------------------------------------
  use SECURITY.dbf
  go top
  delete all for enterok=space(12)
  pack
  go top
  mastrpass=trim(enterok)
  header="Authorized Users Check"
  do bigboxdt
  ct=1
  password=space(12)
  nupasswd=space(12)
  MSG=" "
  do dlinboxm
  do while .t.
     @ 12,14 say space(50)
     password=space(12)
     @ 12,23 say "Enter your PASSWORD:  "
     SET console Off
     ACCEPT TO PASSWORD
     SET console ON
     @ 12,14 say space(50)
     @ 12,20 say "Checking authorized users.  Please wait."
     password=upper(password)
     nupass=""
     z=1
     do while z<len(password)+1
        tz=asc(substr(password,z,1))+117
        nupass=nupass+chr(tz)
        z=z+1
     enddo
     go top
     locate for nupass=trim(enterok)
     if eof()
        @ 12,14 say space(50)
        ct=ct+1
        if ct>5
           set color to 15/0
           @ 12,21 say "I think you are an unauthorized user."
           set color to 7/0
           set console off
           set escape off
           do while .t.
              loop
           enddo
         else
           msg="Wrong SECURITY CODE.  Press any key to continue."
           do linmsg23
           loop
        endif
     endif
     if nupass<>mastrpass
        exit
     endif
     * ---------------------------------------
     * PASSWORD ADDITION ROUTINE follows here:
     * ---------------------------------------
     do while .t.
        @ 12,14 say space(50)
        @ 12,21 say "Enter a password to add:  "
        set console OFF
        ACCEPT TO NUPASSWD
        nupasswd=upper(nupasswd)
        set console on
        nupass=""
        nupasswd=trim(nupasswd)
        z=1
        do while z<len(nupasswd)+1
           tz=asc(substr(nupasswd,z,1))+117
           nupass=nupass+chr(tz)
           z=z+1
        enddo
        append blank
        replace enterok with nupass
        msg="Enter another NEW password?  <Y/N>  "
        test="YN"
        do linprm23
        if tz="Y"
           loop
          else
           exit
        endif
     enddo
     * -----------------------------------
     * PASSWORD ADDITION ROUTINE ends here
     * -----------------------------------
  enddo
  use
  set color to 15/0
  @ 23,6 say "The System identifies you.  Welcome!  Please wait."
  set color to 7/0
  RETURN