home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / trl14db.zip / TRLPRG.EXE / COUNTRY2.PRG < prev    next >
Text File  |  1990-10-22  |  5KB  |  177 lines
  1. *********
  2. *  COUNTRY.PRG
  3. *
  4. *  by Ralph Davis
  5. *  modified by Tom Rettig and Leonard Zerman
  6. *
  7. *  Placed in the Public Domain by Tom Rettig Associates, 10/22/1990.
  8. *
  9. *  Demonstrates use of level-1 syntax and DOSFUNC procedure.
  10. *********
  11.  
  12. SET TALK OFF
  13. SET ESCAPE OFF
  14. CLEAR
  15. x = 1000
  16. CALL trpass WITH x
  17. CALL trexe  WITH "ALLOCATE"
  18. IF [] = tr_retc
  19.    ? "Not enough memory to allocate."
  20. ELSE
  21.    m_buffer = tr_retc          && save long address for deallocation
  22.    CALL trpass WITH m_buffer
  23.    CALL trexe  WITH "SEPARATE"
  24.    segment = tr_retc
  25.    offset = tr_retn
  26. ENDIF
  27.  
  28. STORE 0 TO i, m_flags
  29. DO WHILE i <= 254
  30.    @  0, 0 SAY i
  31.    CALL trpass WITH i
  32.    CALL trexe  WITH "HEX"
  33.    m_ax = '38' + SUBSTR(tr_retc,3,2)
  34.    m_bx = '0000'
  35.    m_cx = '0000'
  36.    m_dx = SUBSTR( m_buffer, 5, 4 )
  37.    m_si = '0000'
  38.    m_di = '0000'
  39.    m_ds = segment
  40.    m_es = '0000'
  41.    m_regs = m_ax + m_bx + m_cx + m_dx + m_si + m_di + m_ds + m_es
  42.  
  43.    CALL trpass WITH m_regs
  44.    CALL trpass WITH m_flags
  45.    CALL trexe  WITH "DOSFUNC"
  46.  
  47.    IF MOD(m_flags,2) # 0
  48.       i = i + 1
  49.       LOOP
  50.    ELSE
  51.       ?
  52.       ? "COUNTRY NO:  " + LTRIM(STR(i))
  53.       CALL trpass WITH segment
  54.       CALL trpass WITH offset
  55.       CALL trexe  WITH "PEEKINT"
  56.       DO CASE
  57.          CASE tr_retn = 0
  58.             ? "Date format:  USA (mm/dd/yy)"
  59.          CASE tr_retn = 1
  60.             ? "Date format:  European (dd/mm/yy)"
  61.          CASE tr_retn = 2
  62.             ? "Date format:  Japanese (yy/mm/dd)"
  63.       ENDCASE
  64.  
  65.       offset = offset + 2
  66.       CALL trpass WITH segment
  67.       CALL trpass WITH offset
  68.       CALL trexe  WITH "PEEKSTR"
  69.       ? "Currency symbol:       " + tr_retc
  70.  
  71.       offset = offset + 5
  72.       CALL trpass WITH segment
  73.       CALL trpass WITH offset
  74.       CALL trexe  WITH "PEEKSTR"
  75.       ? "Thousands separator:   " + tr_retc
  76.  
  77.       offset = offset + 2
  78.       CALL trpass WITH segment
  79.       CALL trpass WITH offset
  80.       CALL trexe  WITH "PEEKSTR"
  81.       ? "Decimal separator:     " + tr_retc
  82.  
  83.       offset = offset + 2
  84.       CALL trpass WITH segment
  85.       CALL trpass WITH offset
  86.       CALL trexe  WITH "PEEKSTR"
  87.       ? "Date separator:        " + tr_retc
  88.  
  89.       offset = offset + 2
  90.       CALL trpass WITH segment
  91.       CALL trpass WITH offset
  92.       CALL trexe  WITH "PEEKSTR"
  93.       ? "Time separator:        " + tr_retc
  94.  
  95.       offset = offset + 2
  96.       CALL trpass WITH segment
  97.       CALL trpass WITH offset
  98.       CALL trexe  WITH "PEEKSTR"
  99.       IF MOD(tr_retn,2) = 0
  100.          ? "Currency symbol precedes the value"
  101.       ELSE
  102.          ? "Currency symbol follows the value"
  103.       ENDIF
  104.       m_spaces = MOD( INT((tr_retn/2)), 2 )
  105.       ? "There are " + LTRIM(STR(m_spaces,1,0)) + " spaces " +;
  106.         "between the value and the symbol"
  107.  
  108.       offset = offset + 1
  109.       CALL trpass WITH segment
  110.       CALL trpass WITH offset
  111.       CALL trexe  WITH "PEEKSTR"
  112.       ? "Significant decimal digits in currency:  " + LTRIM(STR(tr_retn))
  113.  
  114.       offset = offset + 1
  115.       CALL trpass WITH segment
  116.       CALL trpass WITH offset
  117.       CALL trexe  WITH "PEEKSTR"
  118.       IF MOD(tr_retn,2) = 0
  119.         ? "Twelve hour clock in use"
  120.       ELSE
  121.         ? "Twenty-four hour clock in use"
  122.       ENDIF
  123.  
  124.       offset = offset + 1
  125.       CALL trpass WITH segment
  126.       CALL trpass WITH offset
  127.       CALL trexe  WITH "PEEKINT"
  128.       CALL trpass WITH tr_retn
  129.       CALL trexe  WITH "HEX"
  130.       m_caseoff = tr_retc   && HEX( PEEKINT(segment, offset+18) )
  131.  
  132.       offset = offset + 2
  133.       CALL trpass WITH segment
  134.       CALL trpass WITH offset
  135.       CALL trexe  WITH "PEEKINT"
  136.       CALL trpass WITH tr_retn
  137.       CALL trexe  WITH "HEX"
  138.       m_caseseg = tr_retc   && HEX( PEEKINT(segment, offset+20) )
  139.       ? "Case map call address:  " + m_caseseg + ":" + m_caseoff
  140.  
  141.       offset = offset + 2
  142.       CALL trpass WITH segment
  143.       CALL trpass WITH offset
  144.       CALL trexe  WITH "PEEKSTR"
  145.       ? "Data list separator:   " + tr_retc
  146.       ?
  147.       ?
  148.       ? "Press any key to continue, <Esc> to abort..."
  149.       holdkey = 0
  150.       DO WHILE holdkey = 0
  151.          holdkey = INKEY()
  152.          IF holdkey = 27          && Escape key aborts
  153.             SET TALK ON
  154.             SET ESCAPE ON
  155.             RETURN
  156.          ENDIF
  157.       ENDDO
  158.       offset = ( offset - 22 )
  159.       CLEAR
  160.    ENDIF
  161.    i = i + 1
  162.    m_flags = 0
  163. ENDDO
  164.  
  165. CALL trpass WITH m_buffer
  166. CALL trexe  WITH "DEALLOC"
  167. IF .NOT. tr_retl
  168.    ?? CHR(7)
  169.    ? 'Error freeing memory'
  170. ENDIF
  171.  
  172. SET TALK ON
  173. SET ESCAPE ON
  174. RETURN
  175. * eof: country.prg
  176.  
  177.