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