home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / S12192.ZIP / UTIL.BAS < prev   
BASIC Source File  |  1990-02-02  |  9KB  |  310 lines
  1. '===== UTIL.BAS =====
  2. ' This file contains some useful routines for use with
  3. ' the MS OS/2 SDK.
  4. CONST TRUE = -1
  5. CONST FALSE = 0
  6. TYPE ADDRESS
  7.      offset  AS INTEGER
  8.      segment AS INTEGER
  9. END TYPE
  10. DEFINT A-Z
  11.  
  12. DECLARE FUNCTION WDate$ (P1 AS INTEGER)
  13. DECLARE FUNCTION WTime$ (P1 AS INTEGER)
  14. DECLARE FUNCTION RightShift% (P1 AS LONG, P2 AS INTEGER)
  15. DECLARE FUNCTION LeftShift% (P1 AS LONG, P2 AS INTEGER)
  16. DECLARE FUNCTION FileType$ (P1 AS INTEGER)
  17. DECLARE FUNCTION Unsigned& (P1 AS INTEGER)
  18. DECLARE FUNCTION StringPeek% (P1 AS ADDRESS, P2 AS STRING, _
  19.                               P3 AS INTEGER)
  20. DECLARE FUNCTION IntegerPeek% (P1 AS ADDRESS, P2 AS INTEGER)
  21. DECLARE FUNCTION LongPeek% (P1 AS ADDRESS, P2 AS LONG)
  22. DECLARE FUNCTION SinglePeek% (P1 AS ADDRESS, P2 AS SINGLE)
  23. DECLARE FUNCTION DoublePeek% (P1 AS ADDRESS, P2 AS DOUBLE)
  24. DECLARE FUNCTION stringpoke% (info AS ANY, st$, strlen%)
  25.  
  26. ' ERROR HANDLER
  27. ErrorHandler:
  28.    status% = TRUE
  29.    RESUME NEXT
  30.  
  31. '============================================================
  32. '= DoublePeek : Finds a double at a given segment and offset
  33. '= Arguments
  34. '=      INFO    : structure containing segment and offset
  35. '=      Number# : double to be returned
  36. '=
  37. '= Return
  38. '=     TRUE    : If an error occurs
  39. '=     FALSE   : If everything went OK
  40. FUNCTION DoublePeek% (info AS ADDRESS, number#)
  41. SHARED status%
  42. ON ERROR GOTO ErrorHandler
  43. status% = FALSE
  44.   DEF SEG = info.segment
  45.   i = 0
  46.   WHILE (NOT status%) AND (i < 8)
  47.       hold$ = hold$ + CHR$(PEEK(info.offset + i))
  48.       PRINT PEEK(info.offset + i);
  49.       i = i + 1
  50.   WEND
  51.   DEF SEG
  52.   number# = CVD(hold$)
  53.   DoublePeek% = status%
  54. END FUNCTION
  55.  
  56. '==========================================================
  57. '= FileType$ : Determine the type of file by its attributes
  58. '= Arguments
  59. '=      attr : Attribute Number
  60. '=
  61. '= Return
  62. '=      String containing the file type
  63. FUNCTION FileType$ (attr)
  64.   SELECT CASE attr
  65.      CASE 0
  66.         FileType$ = "Normal File"
  67.      CASE 1
  68.         FileType$ = "Read-Only File"
  69.      CASE 2
  70.         FileType$ = "Hidden File"
  71.      CASE 4
  72.         FileType$ = "System File"
  73.      CASE &H10
  74.         FileType$ = "Subdirectory"
  75.      CASE &H20
  76.         FileType$ = "File Archive"
  77.      CASE ELSE
  78.         FileType$ = "Unknown Type"
  79.   END SELECT
  80. END FUNCTION
  81.  
  82. '==========================================================
  83. '= IntegerPeek% : Finds an integer at a given segment and
  84. '=                offset
  85. '= Arguments
  86. '=      INFO    : structure containing segment and offset
  87. '=      Number% : integer to be returned
  88. '=
  89. '= Return
  90. '=      TRUE    : If an error occurs
  91. '=      FALSE   : If everything went OK
  92. FUNCTION IntegerPeek% (info AS ADDRESS, number%)
  93. SHARED status%
  94. ON ERROR GOTO ErrorHandler
  95. status% = FALSE
  96.   DEF SEG = info.segment
  97.   i = 0
  98.   WHILE (NOT status%) AND (i < 2)
  99.       hold$ = hold$ + CHR$(PEEK(info.offset + i))
  100.       i = i + 1
  101.   WEND
  102.   DEF SEG
  103.   number% = CVI(hold$)
  104.   interpeek% = status%
  105. END FUNCTION
  106.  
  107. '==========================================================
  108. '= LeftShift% : Shift Bits to the left ====================
  109. '= Arguments
  110. '=      Number : Long to be shifted (unsigned integer)
  111. '=      Amount : Amount to be shifted
  112. '=
  113. '= Return
  114. '=      The shifted SIGNED integer
  115. FUNCTION LeftShift% (number&, amount)
  116.   LeftShift = number& * (2 ^ amount)
  117. END FUNCTION
  118.  
  119. '==========================================================
  120. '= LongPeek% : Finds a long at a given segment and offset
  121. '= Arguments
  122. '=      INFO    : structure containing segment and offset
  123. '=      Number& : long to be returned
  124. '=
  125. '= Return
  126. '=     TRUE    : If an error occurs
  127. '=     FALSE   : If everything went OK
  128. FUNCTION LongPeek% (info AS ADDRESS, number&)
  129. SHARED status%
  130. ON ERROR GOTO ErrorHandler
  131. status% = FALSE
  132.   DEF SEG = info.segment
  133.   i = 0
  134.   WHILE (NOT status%) AND (i < 4)
  135.       PRINT PEEK(info.offset + i)
  136.       hold$ = hold$ + CHR$(PEEK(info.offset + i))
  137.       i = i + 1
  138.   WEND
  139.   DEF SEG
  140.   number& = CVL(hold$)
  141.   LongPeek% = status%
  142. END FUNCTION
  143.  
  144. '==========================================================
  145. '= RightShift% : Shift bits to the right ==================
  146. '= Arguments
  147. '=      Number : Long to be shifted (unsigned integer)
  148. '=      Amount : Amount to be shifted
  149. '=
  150. '= Return
  151. '=      The shifted SIGNED integer
  152. FUNCTION RightShift% (number&, amount)
  153.    RightShift = number& \ 2 ^ amount
  154. END FUNCTION
  155.  
  156. '============================================================
  157. '= SinglePeek! : Finds a single at a given segment and offset
  158. '= Arguments
  159. '=      INFO    : structure containing segment and offset
  160. '=      Number! : single to be returned
  161. '=
  162. '= Return
  163. '=     TRUE    : If an error occurs
  164. '=     FALSE   : If everything went OK
  165. FUNCTION SinglePeek% (info AS ADDRESS, number!)
  166. SHARED status%
  167. ON ERROR GOTO ErrorHandler
  168. status% = FALSE
  169.   DEF SEG = info.segment
  170.   i = 0
  171.   WHILE (NOT status%) AND (i < 4)
  172.       hold$ = hold$ + CHR$(PEEK(info.offset + i))
  173.       PRINT PEEK(info.offset + i);
  174.       i = i + 1
  175.   WEND
  176.   DEF SEG
  177.   number! = CVS(hold$)
  178.   SinglePeek% = status%
  179.   PRINT
  180. END FUNCTION
  181.  
  182. '==========================================================
  183. '= StringPeek% : Given segment and offset create a string
  184. '=               with length STRLEN
  185. '= Arguments
  186. '=      INFO   : structure containing segment and offset
  187. '=      ST$    : String to be returned
  188. '=      STRLEN : Length max length of the string
  189. '=               If the a NULL is found before the counter
  190. '=               is greater than max length, the new length
  191. '=               of the string is returned in STRLEN.
  192. '= Return
  193. '=     TRUE    : If an error occurs
  194. '=     FALSE   : If everything went OK
  195. FUNCTION StringPeek% (info AS ADDRESS, st$, strlen)
  196. DIM null AS STRING * 1
  197. SHARED status%
  198. ON ERROR GOTO ErrorHandler
  199.    null = CHR$(0)
  200.    incr = 0
  201.    st$ = null
  202.    status% = FALSE
  203.    DEF SEG = info.segment
  204.    DO
  205.      c$ = CHR$(PEEK(info.offset + incr))
  206.      st$ = st$ + c$
  207.      incr = incr + 1
  208.    LOOP WHILE ((c$ <> null) AND (incr < strlen) AND (NOT status%))
  209.    strlen = incr
  210.    StringPeek% = status%
  211. END FUNCTION
  212.  
  213. '==========================================================
  214. '= stringpoke% : Poke a given string into the segment and
  215. '=               offset provided
  216. '= Arguments
  217. '=      INFO   : structure containing the segment and offset
  218. '=      ST$    : the string
  219. '=      Strlen : length of the string
  220. '=
  221. '= Return
  222. '=     TRUE    : If an error occurs
  223. '=     FALSE   : If everything went OK
  224. '=
  225. '= Notes
  226. '=    This function can also be used for placing numbers into
  227. '=    memory. MKx$ can be used to convert the number to a
  228. '=    string.  This string can be passed to the routine.
  229. FUNCTION stringpoke% (info AS ADDRESS, st$, strlen)
  230. DIM null AS STRING * 1
  231. SHARED status%
  232. ON ERROR GOTO ErrorHandler
  233.    incr = 0
  234.    status% = FALSE
  235.    DEF SEG = info.segment
  236.    DO
  237.      POKE info.offset + incr, ASC(MID$(st$, incr + 1, incr + 1))
  238.      incr = incr + 1
  239.    LOOP WHILE ((incr < strlen) AND (NOT status%))
  240.   strlen = incr
  241.   DEF SEG
  242.   stringpoke% = status%
  243. END FUNCTION
  244.  
  245. '==========================================================
  246. '= Unsigned& : Convert signed integer to unsigned long ====
  247. '= Arguments
  248. '=      NUM% : Signed integer to be converted to unsigned
  249. '=             long
  250. '= Return
  251. '=      Long which is the unsigned integer
  252. FUNCTION Unsigned& (num)
  253.    IF num >= 0 THEN
  254.       Unsigned& = num
  255.    ELSE
  256.       Unsigned& = 65536 + num
  257.    END IF
  258. END FUNCTION
  259.  
  260. '==========================================================
  261. '= WDate$ : FUNCTION to print file date returned by FindNext
  262. '= Arguments
  263. '=      d%  : Number to be printed as the date
  264. '=
  265. '= Return
  266. '=      String containing the date
  267. FUNCTION WDate$ (d%) STATIC
  268. DIM dl AS LONG
  269.     dl = Unsigned&(d%)
  270.     mn = (RightShift%(dl, 5)) AND (&HF)
  271.     IF mn < 10 THEN
  272.        mn$ = "0" + LTRIM$(STR$(mn))
  273.     ELSE
  274.        mn$ = LTRIM$(STR$(mn))
  275.     END IF
  276.     dy = dl AND (&H1F)
  277.     IF dy < 10 THEN
  278.        dy$ = "0" + LTRIM$(STR$(dy))
  279.     ELSE
  280.        dy$ = LTRIM$(STR$(dy))
  281.     END IF
  282.     yr$ = STR$(RightShift(dl, 9) + 1980)
  283.     WDate$ = mn$ + "/" + dy$ + "/" + LTRIM$(yr$)
  284. END FUNCTION
  285.  
  286. '==========================================================
  287. '= WTime$ : FUNCTION to print file time returned by FindNext
  288. '= Arguments
  289. '=      d%  : Number to be printed as the time
  290. '=
  291. '= Return
  292. '=      String containing the time
  293. FUNCTION WTime$ (d%)
  294. DIM dl AS LONG
  295.    dl = Unsigned&(d%)
  296.    hr = RightShift%(dl, 11) AND (&H1F)
  297.    IF hr < 10 THEN
  298.       hr$ = "0" + LTRIM$(STR$(hr))
  299.    ELSE
  300.       hr$ = LTRIM$(STR$(hr))
  301.    END IF
  302.    mt = (RightShift%(dl, 5) AND (&H3F))
  303.    IF mt < 10 THEN
  304.       mt$ = "0" + LTRIM$(STR$(mt))
  305.    ELSE
  306.       mt$ = LTRIM$(STR$(mt))
  307.    END IF
  308.    WTime$ = LTRIM$(hr$) + ":" + mt$ + STRING$(5, 32)
  309. END FUNCTION
  310.