home *** CD-ROM | disk | FTP | other *** search
/ The Pier Shareware 6 / The_Pier_Shareware_Number_6_(The_Pier_Exchange)_(1995).iso / 038 / pmd110.zip / BBUTIL.PAS < prev    next >
Pascal/Delphi Source File  |  1994-11-14  |  17KB  |  255 lines
  1. (* This file was mangled by Mangler 1.35 (c) Copyright 1993-1994 by Berend de Boer *)
  2. { Created : From BBUTIL.PAS for Turbo Pascal 5.5
  3.  
  4. Last changes :
  5. 93-02-27  Added procedure Discard, mainly an idea of Pete Roth, posted in
  6.           COMP.LANG.PASCAL
  7. 93-09-22  Copied TSItem from Dialogs to BBUtil so units will be less
  8.           tv dependent. Renamed it to TSLink.
  9.           Renamed DisposeSItem to DisposeSLink. DisposeSItem is removed
  10.           in this regard. It's now added to BBDlg
  11. 93-09-23  Copied FormatStr from Drivers. It still needs FORMAT.OBJ to
  12.           link properly
  13. 93-12-04  Added GetLogicalAddr, moved from TDInfo
  14.           Procedures HorizLine, CalcCents and IncTotaal deleted
  15. 93-12-07  Moved GetLogicalAddr to BBError
  16. 93-12-08  Procedure Beep removed
  17. 93-12-09  Added TByteArray with MaxWord entries
  18. 93-12-13  Removed Crt from uses clause
  19. 94-01-01  Added function ScasW
  20. 94-02-15  Added function Min which returns the minimum of two longints
  21. 94-04-15  Removed array Maanden to BBDate
  22. 94-05-16  Adapted to the Windows environment
  23. 94-08-31  Added function ValHex
  24. 94-10-06  Moved function DateValid as DateStrValid to BBDate
  25. 94-10-12  Added function HexB to return a byte in hex format
  26.  
  27.  
  28. Remarks:
  29. function FreeStr should be considered obsolete
  30. }
  31.  
  32.  
  33. {$IFDEF MsDos}
  34. {$F+,O+,D-}
  35. {$ENDIF}
  36.  
  37. {$R-,Q-,I-,S-,X+}
  38. unit BBUtil;
  39.  
  40. interface
  41.  
  42. uses Objects;
  43.  
  44.  
  45. const
  46.   CR = #13;
  47.   LF = #10;
  48.   FF = #12;
  49.   FormFeed = #12;
  50.  
  51. const
  52.   prnLineFeed  = #10;
  53.   prnFormFeed  = #12;
  54.   prnCR        = #13;
  55.   prnNL        = #13#10;      {* advance to next line and give a CR *}
  56.   prnLargeOn   = #27+'W'+#1;  {* Shift Out, double width characters *}
  57.   prnSmallOn   = #15;         {* Shift In, small characters, 17CPI *}
  58.   prnSmallOff  = #18;         {* stops printing in small characters *}
  59.   prnLargeOff  = #27+'W'+#0;  {* stops printing with double char width *}
  60.   prnCAN       = #24;         {* empties printerbuffer without any printing *}
  61.   prnUndOn     = #27 + '-1';  {* prints with underlined text *}
  62.   prnUndOff    = #27 + '-0';  {* stops printing with underlines *}
  63.   prnBoldOn    = #27 + 'E';
  64.   prnBoldOff   = #27 + 'F';
  65.   prnDoubleOn  = #27 + 'G';   {* start printing two times a line *}
  66.   prnDoubleOff = #27 + 'H';   {* stops printing a line two times *}
  67.  
  68.  
  69. const
  70.   MaxWord = $FFFF;
  71.  
  72. type
  73.   PSLink = ^TSLink;
  74.   TSLink = record
  75.     Value: PString;
  76.     Next: PSLink;
  77.   end;
  78.  
  79.  
  80. var
  81.   valcode : word;
  82.  
  83.  
  84. {* number -> Str *}
  85.  
  86. function  StrS(n : shortint) : string;
  87. function  StrB(n : byte) : string;
  88. function  StrI(n : integer) : string;
  89. function  StrW (n : word) : string;
  90. function  StrL(n : longint) : string;
  91. function  StrR(n : real; width, decimals : word) : string;
  92. function  LeadingZero(value : word) : string;
  93. function  HexB(b : byte) : string;
  94. function  HexStr(w : word) : string;
  95.  
  96. {* Str -> number *}
  97.  
  98. function  ValB(const s : string) : byte;
  99. function  ValI(const s : string) : integer;
  100. function  ValW(const s : string) : word;
  101. function  ValL(const s : string) : longint;
  102. function  ValR(const s : string) : real;
  103. function  ValHex(const s : string) : longint;
  104.  
  105. {* Uppercase and Lowercase string *}
  106.  
  107. function  LowCase(c : char) : char;
  108. function  LowStr(const s : string) : string;
  109. function  UpStr(const s : string) : string;
  110. function  FancyStr(s : string) : string;
  111.  
  112. {* Various string routines *}
  113.  
  114. function  CPos(c : char; const s : string) : byte;
  115. function  Empty(const s : string) : Boolean;
  116. function  ExtractStr(const From, startStr, endStr : string) : string;
  117. procedure FormatStr(var Result : string; const Format : string; var Params);
  118. function  FTCopy(const s : string; f,t : word) : string;
  119. function  GetAddrStr(Addr : pointer) : string;
  120. function  GetDateStr : string;
  121. function  GetTimeStr : string;
  122. function  LeftJustify(const s : string; f_len : integer) : string;
  123. function  RepChar(c : char; Count : integer) : string;
  124. function  RightJustify(const s : string; f_len : word) : string;
  125. function  Spc(Count : integer) : string;
  126. function  Spoiled(const s : string) : Boolean;
  127. function  StripSpc(const s : string) : string;
  128. function  TrimRight(const s : string) : string;
  129. function  ZeroRightJustify(const s : string; f_len : word) : string;
  130.  
  131. {* Dynamic strings *}
  132.  
  133. procedure FreeStr(p : PString);
  134. function  GetStr(p : PString) : string;
  135. procedure ReplaceStr(var p : PString; s : string);
  136.  
  137. {* Various *}
  138.  
  139. function  CMPB(const ptr1, ptr2; Size : word) : integer;
  140. function  CMPW(const ptr1, ptr2; Size : word) : integer;
  141. procedure Compare(var ptr1, ptr2; rsize : word; var flag : byte);
  142. procedure Discard(var p);
  143. procedure DisposeSLink(PS : PSLink);
  144. function  Min(L1, L2 : longint) : longint;
  145. function  NewSLink(const Str : string; ANext : PSLink) : PSLink;
  146. function  Rnd(r : real) : real;
  147. function  ScanB(Area : pointer; Size : word; Value : byte) : word;
  148. function  ScanW(Area : pointer; Size : word; Value : word) : word;
  149. procedure SmallEndianI(var i : integer);
  150. procedure SmallEndianW(var w : word);
  151. procedure SmallEndianL(var l : longint);
  152.  
  153.  
  154.  
  155.  IMPLEMENTATION USES {$IFDEF Windows}WINDOS {$ELSE}DOS {$ENDIF};FUNCTION STRS (N:SHORTINT):STRING ;VAR OO10:PSTRING;
  156. BEGIN ASM {} LES DI , @Result {} MOV WORD PTR OO10, DI {} MOV WORD PTR OO10+ 2 , ES {} END;STR (N , OO10 ^);END ;
  157. FUNCTION STRB (N:BYTE):STRING ;VAR OO1O:STRING ;BEGIN STR (N , OO1O );STRB := OO1O ;END ;FUNCTION STRL (N:LONGINT):STRING
  158. ;VAR OO10:PSTRING;BEGIN ASM {} LES DI , @Result {} MOV WORD PTR OO10, DI {} MOV WORD PTR OO10+ 2 , ES {} END;STR (N ,
  159. OO10 ^);END ;FUNCTION STRW (N:WORD):STRING ;VAR OO1O:STRING ;BEGIN STR (N , OO1O );STRW := OO1O ;END ;FUNCTION STRI
  160. (N:INTEGER):STRING ;VAR OO1O:STRING ;BEGIN STR (N , OO1O );STRI := OO1O ;END ;FUNCTION STRR (N:REAL;
  161. WIDTH,DECIMALS:WORD):STRING ;VAR OO1O:STRING ;BEGIN IF (WIDTH =0 )AND (DECIMALS =0 )THEN STR (N , OO1O )ELSE STR (N
  162. :WIDTH :DECIMALS , OO1O );STRR := OO1O ;END ;FUNCTION LEADINGZERO (VALUE:WORD):STRING ;VAR OO1O:STRING ;BEGIN STR (VALUE
  163. , OO1O );IF LENGTH (OO1O )=1 THEN OO1O := '0'+ OO1O ;LEADINGZERO := OO1O ;END ;CONST OOIOOOI11OI1:ARRAY [ 0 .. 15 ]
  164.  OF CHAR='0123456789ABCDEF';FUNCTION HEXB (B:BYTE):STRING ;BEGIN HEXB := OOIOOOI11OI1 [ (B SHR 4 )] + OOIOOOI11OI1 [ B
  165. MOD 16 ] ;END ;FUNCTION HEXSTR (W:WORD):STRING ;BEGIN HEXSTR := OOIOOOI11OI1 [ (W SHR 12 )MOD 16 ] + OOIOOOI11OI1 [ (W
  166. SHR 8 )MOD 16 ] + OOIOOOI11OI1 [ (W SHR 4 )MOD 16 ] + OOIOOOI11OI1 [ W MOD 16 ] ;END ;FUNCTION VALB (CONST S:STRING
  167. ):BYTE ;VAR OIOO:WORD;BEGIN VAL (S , OIOO , VALCODE );VALB := LO (OIOO );END ;FUNCTION VALI (CONST S:STRING ):INTEGER ;
  168. VAR OIOO:INTEGER;BEGIN VAL (S , OIOO , VALCODE );VALI := OIOO ;END ;FUNCTION VALW (CONST S:STRING ):WORD ;VAR OIOO:WORD;
  169. BEGIN VAL (S , OIOO , VALCODE );VALW := OIOO ;END ;FUNCTION VALL (CONST S:STRING ):LONGINT ;VAR OIOO:LONGINT;BEGIN VAL (S
  170. , OIOO , VALCODE );VALL := OIOO ;END ;FUNCTION VALR (CONST S:STRING ):REAL ;VAR OO1I:REAL;BEGIN VAL (S , OO1I , VALCODE
  171. );VALR := OO1I ;END ;FUNCTION VALHEX (CONST S:STRING ):LONGINT ;VAR OIlO:INTEGER;OO01:LONGINT;OI1I1O01l1ll:LONGINT;
  172. FUNCTION OIIll1OllI0 (OIOI:CHAR):BYTE ;BEGIN CASE OIOI  OF 'a'.. 'f':OIIll1OllI0 := ORD (OIOI )- ORD ('a')+ 10 ;'A'..
  173. 'F':OIIll1OllI0 := ORD (OIOI )- ORD ('A')+ 10 ;'0'.. '9':OIIll1OllI0 := ORD (OIOI )- ORD ('0');ELSE OIIll1OllI0 := 0 ;
  174. END ;END ;BEGIN OO01 := 0 ;OI1I1O01l1ll := 1 ;FOR OIlO := LENGTH (S )DOWNTO 1  DO BEGIN OO01 := OO01 + OIIll1OllI0 (S [
  175. OIlO ] )* OI1I1O01l1ll ;OI1I1O01l1ll := OI1I1O01l1ll * 16 ;END ;VALHEX := OO01 ;END ;FUNCTION LOWCASE (C:CHAR):CHAR ;
  176. BEGIN IF C IN [ 'A'.. 'Z'] THEN LOWCASE := CHR (ORD (C )+ (97 - 65 ))ELSE LOWCASE := C ;END ;FUNCTION LOWSTR
  177. (CONST S:STRING ):STRING ;ASSEMBLER;ASM {} PUSH DS {} CLD {} LDS SI , S{} LES DI , @Result {} LODSB {} STOSB {}
  178. XOR AH , AH {} XCHG AX , CX {} JCXZ @3 {} @1 : {} LODSB {} CMP AL , 'A' {} JB @2 {} CMP AL , 'Z' {} JA @2 {}
  179. ADD AL , 20H {} @2 : {} STOSB {} LOOP @1 {} @3 : {} POP DS {} END;FUNCTION UPSTR (CONST S:STRING ):STRING ;ASSEMBLER;
  180. ASM {} PUSH DS {} CLD {} LDS SI , S{} LES DI , @Result {} LODSB {} STOSB {} XOR AH , AH {} XCHG AX , CX {} JCXZ @3 {}
  181. @1 : {} LODSB {} CMP AL , 'a' {} JB @2 {} CMP AL , 'z' {} JA @2 {} SUB AL , 20H {} @2 : {} STOSB {} LOOP @1 {} @3 : {}
  182. POP DS {} END;FUNCTION FANCYSTR (S:STRING ):STRING ;VAR OIlO:WORD;BEGIN S [ 1 ] := UPCASE (S [ 1 ] );FOR OIlO := 2 TO
  183. LENGTH (S ) DO IF (S [ OIlO - 1 ] IN [ ' ', '-'] )THEN S [ OIlO ] := UPCASE (S [ OIlO ] )ELSE S [ OIlO ] := LOWCASE (S [
  184. OIlO ] );FANCYSTR := S ;END ;FUNCTION CPOS (C:CHAR;CONST S:STRING ):BYTE ;ASSEMBLER;ASM {} MOV AL , C{} CLD {}
  185. LES DI , S{} MOV CL , ES : [ DI ] {} MOV AH , CL {} XOR CH , CH {} JCXZ @end {} INC DI {} REPNE SCASB {} JNZ @end {}
  186. NEG CL {} ADD CL , AH {} @end : {} MOV AL , CL {} END;FUNCTION EMPTY (CONST S:STRING ):BOOLEAN ;ASSEMBLER;ASM {}
  187. LES DI , S{} MOV CL , [ ES : DI ] {} XOR CH , CH {} JCXZ @Empty {} MOV AL , ' ' {} INC DI {} CLD {} REPE SCASB {}
  188. JZ @Empty {} XOR AX , AX {} JMP @end {} @Empty : {} MOV AX , 1 {} @end : {} END;FUNCTION EXTRACTSTR
  189. (CONST FROM,STARTSTR,ENDSTR:STRING ):STRING ;VAR OIlO,OIll:WORD;BEGIN IF STARTSTR =''THEN OIlO := 1 ELSE OIlO := POS
  190. (STARTSTR , FROM )+ LENGTH (STARTSTR );IF ENDSTR =''THEN OIll := LENGTH (FROM )ELSE OIll := POS (ENDSTR , FROM )- 1 ;IF
  191. (OIll < OIlO )AND (LENGTH (ENDSTR )=1 )THEN BEGIN OIll := OIlO ;WHILE FROM [ OIll ] <> ENDSTR [ 1 ]  DO INC (OIll );DEC
  192. (OIll );END ;EXTRACTSTR := FTCOPY (FROM , OIlO , OIll );END ;{$L FORMAT.OBJ}PROCEDURE FORMATSTR (VAR RESULT:STRING ;
  193. CONST FORMAT:STRING ;VAR PARAMS);EXTERNAL;FUNCTION FTCOPY (CONST S:STRING ;F,T:WORD):STRING ;
  194. BEGIN {$IFOPT Q+}{$Q-}FTCOPY := COPY (S , F , T - F + 1 );{$Q+}{$ELSE}FTCOPY := COPY (S , F , T - F + 1 );{$ENDIF}END ;
  195. FUNCTION GETADDRSTR (ADDR:POINTER):STRING ;BEGIN GETADDRSTR := HEXSTR (PTRREC (ADDR ). SEG )+ ':'+ HEXSTR (PTRREC (ADDR
  196. ). OFS );END ;FUNCTION GETDATESTR :STRING ;VAR OOIl,OO0I,OIOO,OIlO11001ll:WORD;BEGIN GETDATE (OOIl , OO0I , OIOO ,
  197. OIlO11001ll );GETDATESTR := STRW (OOIl )+ '-'+ LEADINGZERO (OO0I )+ '-'+ LEADINGZERO (OIOO );END ;FUNCTION GETTIMESTR
  198. :STRING ;VAR OIlI,OO0I,OO1O,O11l0Il0:WORD;BEGIN GETTIME (OIlI , OO0I , OO1O , O11l0Il0 );GETTIMESTR := LEADINGZERO (OIlI
  199. )+ ':'+ LEADINGZERO (OO0I )+ ':'+ LEADINGZERO (OO1O );END ;FUNCTION LEFTJUSTIFY (CONST S:STRING ;F_LEN:INTEGER):STRING ;
  200. BEGIN LEFTJUSTIFY := COPY (S + SPC (ABS (F_LEN - LENGTH (S ))), 1 , F_LEN );END ;FUNCTION REPCHAR (C:CHAR;
  201. COUNT:INTEGER):STRING ;VAR OO1O:STRING ;BEGIN IF COUNT <= 0 THEN REPCHAR := ''ELSE BEGIN FILLCHAR (OO1O [ 1 ] , COUNT , C
  202. );OO1O [ 0 ] := CHR (COUNT );REPCHAR := OO1O ;END ;END ;FUNCTION RIGHTJUSTIFY (CONST S:STRING ;F_LEN:WORD):STRING ;
  203. VAR OIOO:STRING ;BEGIN OIOO := SPC (ABS (F_LEN - LENGTH (S )))+ S ;RIGHTJUSTIFY := COPY (OIOO , LENGTH (OIOO )- F_LEN + 1
  204. , F_LEN );END ;FUNCTION SPC (COUNT:INTEGER):STRING ;VAR OO1O:STRING ;BEGIN IF COUNT <= 0 THEN SPC := ''ELSE
  205. BEGIN FILLCHAR (OO1O [ 1 ] , ABS (COUNT ), ' ');OO1O [ 0 ] := CHR (ABS (COUNT ));SPC := OO1O ;END ;END ;FUNCTION SPOILED
  206. (CONST S:STRING ):BOOLEAN ;ASSEMBLER;ASM {} CLD {} LES SI , S{} MOV CL , [ ES : SI ] {} XOR CH , CH {}
  207. JCXZ @notspoiled {} INC SI {} @next : SEGES LODSB {} CMP AL , 32 {} JB @spoiled {} CMP AL , 163 {} JA @spoiled {}
  208. LOOP @next {} @notspoiled : {} XOR AL , AL {} JMP @end {} @spoiled : {} MOV AL , 1 {} @end : {} END;FUNCTION STRIPSPC
  209. (CONST S:STRING ):STRING ;ASSEMBLER;ASM {} LES DI , S{} MOV CL , [ ES : DI ] {} XOR CH , CH {} JCXZ @setlength {}
  210. MOV AL , ' ' {} ADD DI , CX {} STD {} REPE SCASB {} JNZ @@1 {} JCXZ @setlength {} @@1 : {} INC CL {} CLD {} LES DI , S{}
  211. INC DI {} REPE SCASB {} DEC DI {} MOV SI , DI {} MOV DX , DS {} MOV AX , ES {} MOV DS , AX {} LES DI , @Result {}
  212. INC CL {} MOV [ ES : DI ] , CL {} INC DI {} REP MOVSB {} MOV DS , DX {} JMP @end {} @setlength : {} LES DI , @Result {}
  213. MOV [ ES : DI ] , CL {} @end : {} END;FUNCTION TRIMRIGHT (CONST S:STRING ):STRING ;ASSEMBLER;ASM {} LES DI , S{}
  214. MOV CL , [ ES : DI ] {} XOR CH , CH {} JCXZ @setlength {} MOV AL , ' ' {} ADD DI , CX {} STD {} REPE SCASB {}
  215. JCXZ @setlength {} INC CL {} CLD {} MOV DX , DS {} LDS SI , S{} INC SI {} LES DI , @Result {} MOV [ ES : DI ] , CL {}
  216. INC DI {} REP MOVSB {} MOV DS , DX {} JMP @end {} @setlength : {} LES DI , @Result {} MOV [ ES : DI ] , CL {} @end : {}
  217. END;FUNCTION ZERORIGHTJUSTIFY (CONST S:STRING ;F_LEN:WORD):STRING ;VAR OIOO:STRING ;BEGIN IF F_LEN >= LENGTH (S )THEN
  218. BEGIN OIOO := REPCHAR ('0', F_LEN - LENGTH (S ))+ S ;ZERORIGHTJUSTIFY := COPY (OIOO , LENGTH (OIOO )- F_LEN + 1 , F_LEN
  219. );END ELSE ZERORIGHTJUSTIFY := S ;END ;FUNCTION GETSTR (P:PSTRING):STRING ;ASSEMBLER;ASM {} PUSH DS {} LDS SI , P{}
  220. MOV AX , DS {} CMP AX , 0 {} JE @nilptr {} LES DI , @Result {} CLD {} MOV CL , [ SI ] {} MOV CH , 0 {} INC CX {}
  221. REP MOVSB {} POP DS {} JMP @end {} @nilptr : {} POP DS {} LES BX , @Result {} XOR AX , AX {} MOV [ ES : BX ] , AX {}
  222. @end : {} END;PROCEDURE FREESTR (P:PSTRING);BEGIN IF P <> NIL THEN DISPOSESTR (P );END ;PROCEDURE REPLACESTR
  223. (VAR P:PSTRING;S:STRING );BEGIN DISPOSESTR (P );P := NEWSTR (S );END ;PROCEDURE COMPARE (VAR PTR1,PTR2;RSIZE:WORD;
  224. VAR FLAG:BYTE);ASSEMBLER;ASM {} MOV DX , DS {} LDS SI , PTR2{} LES DI , PTR1{} CLD {} MOV CX , RSIZE{} REPE CMPSW {}
  225. LDS BX , FLAG{} JAE @@1 {} MOV BYTE PTR [ BX ] , 01h {} MOV DS , DX {} JMP @end {} @@1 : JNE @@2 {}
  226. MOV BYTE PTR [ BX ] , 0h {} MOV DS , DX {} JMP @end {} @@2 : MOV BYTE PTR [ BX ] , 0FFh {} MOV DS , DX {} @end : {} END;
  227. FUNCTION CMPB (CONST PTR1,PTR2;SIZE:WORD):INTEGER ;ASSEMBLER;ASM {} MOV DX , DS {} LDS SI , PTR2{} LES DI , PTR1{} CLD {}
  228. MOV CX , SIZE{} REPE CMPSB {} JAE @@AboveOrEqual {} MOV AX , 01h {} JMP @end {} @@AboveOrEqual : {} JNE @@Above {}
  229. MOV AX , 0h {} JMP @end {} @@Above : {} MOV AX , 0ffffh {} @end : {} MOV DS , DX {} END;FUNCTION CMPW (CONST PTR1,PTR2;
  230. SIZE:WORD):INTEGER ;ASSEMBLER;ASM {} MOV DX , DS {} LDS SI , PTR2{} LES DI , PTR1{} CLD {} MOV CX , SIZE{} REPE CMPSW {}
  231. JAE @@AboveOrEqual {} MOV AX , 01h {} JMP @end {} @@AboveOrEqual : {} JNE @@Above {} MOV AX , 0h {} MOV DS , DX {}
  232. JMP @end {} @@Above : {} MOV AX , 0ffffh {} @end : {} MOV DS , DX {} END;PROCEDURE DISCARD (VAR P);
  233. VAR O11III0l:POBJECT ABSOLUTE P;BEGIN IF O11III0l <> NIL THEN BEGIN DISPOSE (O11III0l , DONE );O11III0l := NIL ;END ;
  234. END ;PROCEDURE DISPOSESLINK (PS:PSLINK);BEGIN IF PS <> NIL THEN BEGIN DISPOSESLINK (PS ^. NEXT );DISPOSESTR (PS ^. VALUE
  235. );DISPOSE (PS );END ;END ;FUNCTION MIN (L1,L2:LONGINT):LONGINT ;BEGIN IF L1 < L2 THEN MIN := L1 ELSE MIN := L2 ;END ;
  236. FUNCTION NEWSLINK (CONST STR:STRING ;ANEXT:PSLINK):PSLINK ;VAR OI1000l1II00:PSLINK;BEGIN NEW (OI1000l1II00 );
  237. OI1000l1II00 ^. VALUE := NEWSTR (STR );OI1000l1II00 ^. NEXT := ANEXT ;NEWSLINK := OI1000l1II00 ;END ;FUNCTION RND
  238. (R:REAL):REAL ;VAR OO1O:STRING ;OI0ll01lOOOl:WORD;O11IlIIO:INTEGER;BEGIN STR (R :20 :3 , OO1O );IF OO1O [ LENGTH (OO1O )-
  239. 2 ] ='-'THEN BEGIN O11IlIIO := POS ('.', OO1O )+ 2 ;IF OO1O [ O11IlIIO + 1 ] >= '5'THEN BEGIN INC (BYTE (OO1O [ O11IlIIO
  240. ] ));WHILE OO1O [ O11IlIIO ] =':' DO BEGIN OO1O [ O11IlIIO ] := '0';DEC (O11IlIIO );IF OO1O [ O11IlIIO ] ='.'THEN DEC
  241. (O11IlIIO );INC (OO1O [ O11IlIIO ] );END ;END ;VAL (COPY (OO1O , 1 , O11IlIIO ), R , OI0ll01lOOOl );END ELSE
  242. BEGIN O11IlIIO := POS ('.', OO1O )+ 2 ;IF OO1O [ O11IlIIO + 1 ] >= '5'THEN BEGIN INC (BYTE (OO1O [ O11IlIIO ] ));
  243. WHILE OO1O [ O11IlIIO ] =':' DO BEGIN OO1O [ O11IlIIO ] := '0';DEC (O11IlIIO );IF OO1O [ O11IlIIO ] ='.'THEN DEC
  244. (O11IlIIO );INC (OO1O [ O11IlIIO ] );END ;END ;VAL (COPY (OO1O , 1 , O11IlIIO ), R , OI0ll01lOOOl );END ;RND := R ;END ;
  245. FUNCTION SCANB (AREA:POINTER;SIZE:WORD;VALUE:BYTE):WORD ;ASSEMBLER;ASM {} MOV AL , VALUE{} CLD {} LES DI , AREA{}
  246. MOV CX , SIZE{} MOV BX , CX {} JCXZ @end {} REPNE SCASB {} JNZ @end {} NEG CX {} ADD CX , BX {} @end : {} MOV AX , CX {}
  247. END;FUNCTION SCANW (AREA:POINTER;SIZE:WORD;VALUE:WORD):WORD ;ASSEMBLER;ASM {} MOV AX , VALUE{} CLD {} LES DI , AREA{}
  248. MOV CX , SIZE{} MOV BX , CX {} JCXZ @end {} REPNE SCASW {} JNZ @end {} NEG CX {} ADD CX , BX {} @end : {} MOV AX , CX {}
  249. END;PROCEDURE SMALLENDIANI (VAR I:INTEGER);ASSEMBLER;ASM {} LES DI , I{} MOV AX , WORD PTR ES : [ DI ] {}
  250. MOV BYTE PTR ES : [ DI ] , AH {} MOV BYTE PTR ES : [ DI ] + 1 , AL {} END;PROCEDURE SMALLENDIANW (VAR W:WORD);ASSEMBLER;
  251. ASM {} LES DI , W{} MOV AX , WORD PTR ES : [ DI ] {} MOV BYTE PTR ES : [ DI ] , AH {}
  252. MOV BYTE PTR ES : [ DI ] + 1 , AL {} END;PROCEDURE SMALLENDIANL (VAR L:LONGINT);ASSEMBLER;ASM {} LES DI , L{}
  253. MOV DX , WORD PTR ES : [ DI ] {} MOV AX , WORD PTR ES : [ DI + 2 ] {} MOV BYTE PTR ES : [ DI ] , AH {}
  254. MOV BYTE PTR ES : [ DI ] + 1 , AL {} MOV BYTE PTR ES : [ DI ] + 2 , DH {} MOV BYTE PTR ES : [ DI ] + 3 , DL {} END;END .
  255.