home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / visionix / vgenu.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-12-28  |  136.8 KB  |  7,370 lines
  1. {
  2. ════════════════════════════════════════════════════════════════════════════
  3.  
  4.  Visionix General Functions Unit (VGEN)
  5.    Version 0.47
  6.  Copyright 1991,92,93 Visionix
  7.  ALL RIGHTS RESERVED
  8.  
  9. ────────────────────────────────────────────────────────────────────────────
  10.  
  11.  Revision history in reverse chronological order:
  12.  
  13.  Initials  Date      Comment
  14.  ────────  ────────  ───────────────────────────────────────────────────────
  15.  
  16.  jrt       12/28/93  Added BoolToStr, BoolToYn, BoolToOnOff.
  17.  
  18.  jrt       11/02/93  Moved most string functions to VStringu;
  19.                      Moved sort stuff to VSortu;
  20.                      added (but didn't finish) GetJump, LongJump,
  21.                      EnableInts, DisableInts, PushXXX, PopXXX.
  22.  
  23.  jrt       10/24/93  Reintroduced GetNextTwirlyChar
  24.  
  25.  bpl       09/30/93  Changed IsAlpha,IsAlphaNum,IsGrammer,IsUpCase, IsLoCase
  26.                      to include full alphabet of foreign characters.
  27.  
  28.  jrt       07/10/93  Added IntToBase, BaseToInt, BaseToBase,
  29.                      IntToBigNum, BigNumToInt.  ASMed ByteToBin.
  30.  
  31.  mep       05/17/93  Added PosBuf and PosBufNoCase
  32.  
  33.  jrt       05/15/93  Sync for BETA 0.21; Imported Trunc... funcs, GetQuote
  34.  
  35.  mep       04/25/93  Added PtrDiff.
  36.  
  37.  rob             04/22/93  Added WordWrap.
  38.  
  39.  mep       04/04/93  Now Sort works with ShortInt, Byte, Integer, Word,
  40.                      LongInt, String, PString, Real, and "User-supplied"
  41.                      arrays (ie. Records).
  42.  
  43.  mep       03/29/93  Now uses TDecHex in VTypes.
  44.                      Renamed PurgeTypeAheadBuffer to PurgeKbdBuf.
  45.  
  46.  mep       03/26/93  Now works with VBios.
  47.  
  48.  lpg       03/12/93  Completed Source Code Commenting
  49.  
  50.  lpg       03/11/93  Fixed Bug in BinToChar, IsHexByte
  51.                      Added: HexToDecStr
  52.                      Modified: DecToHexStr
  53.  
  54.  lpg       03/11/93  Added Source Commenting
  55.  
  56.  jrt       03/08/93  Moved DOS functions into unit VDOSHIGH
  57.  
  58.  jrt       02/15/93  Documentation integration and misc changes.
  59.                        Renamed FirstString --> ProperString
  60.  
  61.  mep       02/11/93  Cleaned up code for beta release
  62.                      Fixed SetKeyRate and DisketteStatus for DPMI mode.
  63.  
  64.  jrt       2/08/93   Sync with Beta 0.12
  65.  
  66.  mep       2/02/93   Added: DecToHexStr
  67.  
  68.  mep       1/31/93   Added: FileCRC32, CRC32String, FileCRC16,
  69.                        and CRC16String.
  70.                      Changed CRC32 to CRC32Char and CRC32Buffer.
  71.                      Changed CRC16 to CRC16Char and CRC16Buffer.
  72.  
  73.  lpg       1/12/92   Modified: Trim
  74.                      Added: TrimChar
  75.                      Updated: DisketteStatus
  76.  
  77.  mep       1/2/93    Fixed: DeleteChars, UpperString, FirstString, PosCount,
  78.                        StrToAsciiZ, AsciiZtoStr, Sort, PurgeTypeAheadBuffer.
  79.                      Added: FillWord, KeyboardOff, KeyboardOn.
  80.  
  81.  lpg       12/27/92  Cleaned up unnecessary Code
  82.  
  83.  mep       12/22/92  Fixed PosNext, PosNextDelimit - TP70 bug.
  84.                      Added: UnPutDot, PosAfter and PosBefore.
  85.  
  86.  mep       12/19/92  Fixed AddCommas.
  87.  
  88.  mep       12/16/92  Fixed FileExist only include file types
  89.                        (not Directory and VolumeID).
  90.                      Added: AddCommas.
  91.  
  92.  jrt       12/15/92  Changes for bp 7.0:
  93.                        Added code to linear<-->ptr functions to support
  94.                        pascal 7.0; changed PurgeTypeAheadBuffer to use
  95.                        Seg0040 constant instead of direct value.
  96.  
  97.  mep       12/09/92  Fixed InDir, PutSlash, FileExist, GetFileTime,
  98.                        GetFileSize, DirEmpty.
  99.                      Added: TakeWord, TakeQuote, UnPutSlash, and MkSubDir.
  100.  
  101.  mep       12/08/92  Fixed CRC32 to work correctly.
  102.                      Added credits at end of unit.
  103.  
  104.  jrt       12/07/92  Sync with beta 0.11 release
  105.  
  106.  mep       12/06/92  Made CompareSmaller assembly.
  107.                      Fixed Sort, PutSlash, SwapBuffers.
  108.                      Added: CopyOverStr, PosCount;
  109.  
  110.  jrt       12/02/92  Added: PtrToLin, LinToPtr, Ptr math functions,
  111.                        NewString and DisposeString.
  112.  
  113.  mep       12/01/92  Added: CopyStr, PutSlash, PutDot, FileExist, GetFileTime,
  114.                        GetFileAttr, GetFileSize, DirExist, DirEmpty,
  115.                        PredDir, InDir, MaskWildcards
  116.  
  117.  mep       11/30/92  Sync update. Beta 0.10
  118.  
  119.  mep       11/29/92  Sync update.
  120.                      Changed: SwapBuffers, Compare, CompareSmaller
  121.  
  122.  lpg       11/28/92  Added: DecToBCD, BCDtoDec, ByteToBCD, BCDtoByte,
  123.                        WordToBCD, BCDtoWord, GetDOSVersion, DisketteStatus,
  124.                        and FloppyReady.
  125.  
  126.  mep       11/25/92  Overlooked code and updated few bugs.
  127.                      Cleaned-up code.
  128.                      Re-implemented FastCompare.
  129.  
  130.  jrt       11/21/92  Sync with beta 0.08
  131.  
  132.  lpg       11/19/92  Corrected LowerChar, ArrayZtoStr, StrToArrayZ
  133.  
  134.  lpg       11/19/92  Added: ByteToBin, IntToBin, WordToBin, LongToBin,
  135.                        BinToChar, BinToByte, BinToInt, BinToWord, BinToLong
  136.  
  137.  jrt       11/18/92  Got rid of swapNoBuff functions; set greater/lesser
  138.                        code back to pascal on funcs that deal with signed
  139.                        values
  140.  
  141.  jrt       11/11/92  Converted Swap funcs and Greater/lesser funcs to
  142.                        asm code for performance.
  143.  
  144.  lpg       11/10/92  Added ValidByte, ValidInt, ValidLong, ValidFloat,
  145.                        ValidSci, ValidHexByte, ValidHexWord, ValidHex.
  146.  
  147.  mep       11/06/92  Changed PosNextField to return SubS if '=' not found.
  148.  
  149.  lpg       11/01/92  Added Dollar Conversion Functions
  150.  
  151.  lpg       10/19/92  Moved Date/Time functions to VDATES
  152.  
  153.  lpg       10/18/92  Added IncTime, DecTime, IncDate, DecDate, IncDateTime,
  154.                        DecDateTime, AddTime, SubTime, AddDate, SubDate,
  155.                        AddDateTime, SubDateTime, SoundexPack, SoundexUnPack
  156.  
  157.  lpg       10/08/92  Added MarkTime, Modified ClockOn/Off to use MarkTime
  158.                        SwapByteNoBuff, SwapIntNoBuff, SwapWordNoBuff,
  159.                        PosNextDelimit
  160.  
  161.  mep       10/06/92  Fixed Sort for ANY type.
  162.                      Removed CompareBytes - now use CompareBuffers.
  163.                      Removed FastCompare - now use Compare
  164.                      Updated SwapBuffers.
  165.  
  166.  mep       10/03/92  Added NEW functions:
  167.                        GetCurrDateTime, DateTimeOK, DateTimeStr, StrDateTime,
  168.                        DateTimeLinear, LinearDateTime, PosNext, PosNextField,
  169.                        PosNextData, Compare, SetKeyRate, SetKeyFast,
  170.                        FirstString, PurgeTypeAheadBuffer,
  171.                        CRC16, CRC32, Sort, SwapBuffers, CompareBuffers.
  172.  
  173.                      Organization of code.
  174.  
  175.                      Changed functions:
  176.                        StrToArray, StrToArrayZ, ArrayZtoStr
  177.  
  178.  lpg       10/01/92  Added More Functions.
  179.  
  180.  jrt       09/01/92  First logged revision.
  181.  
  182. ════════════════════════════════════════════════════════════════════════════
  183.  
  184. NOT DONE:
  185.  
  186.   Function DecToHexStr(                S         : STRING   ) : STRING;
  187.  
  188. }
  189.  
  190. (*-
  191.  
  192. [SECTION: Section 1: The General Libraries]
  193. [CHAPTER: Chapter 1: The General Functions Libraries]
  194.  
  195. [TEXT]
  196.  
  197. <Overview>
  198.  
  199. The general functions unit consists of functions which fall into 8
  200. categories:
  201.  
  202.  
  203.   - Validation routines
  204.  
  205.   - Type conversion
  206.  
  207.   - Variable comparing and swapping
  208.  
  209.   - System and CPU
  210.  
  211.   - CRC
  212.  
  213.   - Soundex functions
  214.  
  215.   - Pointer functions
  216.  
  217.   - Misc. functions
  218.  
  219.  
  220. <Interface>
  221.  
  222. -*)
  223.  
  224. Unit VGenu;
  225.  
  226. Interface
  227.  
  228. Uses
  229.  
  230.   DOS,
  231. {$IFNDEF OS2}
  232.   VBiosu,
  233. {$ENDIF}
  234.   VTypesu;
  235.  
  236. {────────────────────────────────────────────────────────────────────────────}
  237.  
  238. Type
  239.  
  240.   TCharArrayZ = Array[0..64000] of CHAR;
  241.  
  242. Type
  243.  
  244.   TJumpInfo = RECORD
  245.  
  246.     BP     : WORD;
  247.     IP     : WORD;
  248.     CS     : WORD;
  249.     SP     : WORD;
  250.  
  251.   END;
  252.  
  253.   PJumpInfo = TJumpInfo;
  254.  
  255. Const
  256.  
  257.   cTwirlyString : STRING[8] = '|/-\|/-\';
  258.   cTwirlyCurPos : BYTE = 1;
  259.  
  260. {────────────────────────────────────────────────────────────────────────────}
  261.  
  262.  
  263. {---------------------}
  264. { Validation Routines }
  265. {---------------------}
  266.  
  267. Function  ValidByte(              S             : STRING        ) : BOOLEAN;
  268.  
  269. Function  ValidInt(               S             : STRING        ) : BOOLEAN;
  270.  
  271. Function  ValidLong(              S             : STRING        ) : BOOLEAN;
  272.  
  273. Function  ValidFloat(             S             : STRING        ) : BOOLEAN;
  274.  
  275. Function  ValidSci(               S             : STRING        ) : BOOLEAN;
  276.  
  277. Function  ValidHexByte(           S             : STRING        ) : BOOLEAN;
  278.  
  279. Function  ValidHexWord(           S             : STRING        ) : BOOLEAN;
  280.  
  281. Function  ValidHex(               S             : STRING        ) : BOOLEAN;
  282.  
  283.  
  284. Function  IsAlpha(                C             : CHAR          ) : BOOLEAN;
  285.  
  286. Function  IsNum(                  C             : CHAR          ) : BOOLEAN;
  287.  
  288. Function  IsAlphaNum(             C             : CHAR          ) : BOOLEAN;
  289.  
  290. Function  IsUpCase(               C             : CHAR          ) : BOOLEAN;
  291.  
  292. Function  IsLoCase(               C             : CHAR          ) : BOOLEAN;
  293.  
  294. Function  IsGrammar(              C             : CHAR          ) : BOOLEAN;
  295.  
  296. Function  IsCtrl(                 C             : CHAR          ) : BOOLEAN;
  297.  
  298. Function  IsBorder(               C             : CHAR          ) : BOOLEAN;
  299.  
  300. Function  IsLang(                 C             : CHAR          ) : BOOLEAN;
  301.  
  302. Function  IsSymbol(               C             : CHAR          ) : BOOLEAN;
  303.  
  304.  
  305. {------------------}
  306. { Type Conversions }
  307. {------------------}
  308.  
  309. Function  IntToBase(              Base          : BYTE;
  310.                                   Int           : LONGINT    ) : STRING;
  311.  
  312. Function  BaseToInt(              Base          : BYTE;
  313.                                   S             : STRING     ) : LONGINT;
  314.  
  315. Function  BaseToBase(             InBase        : BYTE;
  316.                                   InVal         : STRING;
  317.                                   OutBase       : BYTE       ) : STRING;
  318.  
  319.  
  320. Function  IntToStr(               L             : LONGINT       ) : STRING;
  321.  
  322. Function  StrToInt(               S             : STRING        ) : LONGINT;
  323.  
  324. Function  RealToStr(              R             : REAL;
  325.                                   Field         : INTEGER;
  326.                                   Decimals      : INTEGER       ) : STRING;
  327.  
  328. Function  StrToReal(              S             : STRING        ) : REAL;
  329.  
  330. Function  SciToStr(               R             : REAL          ) : STRING;
  331.  
  332. Function  StrToSci(               S             : STRING        ) : REAL;
  333.  
  334. Function  IntToText(              L             : LONGINT       ) : ST80;
  335.  
  336. Function  LongToDollars(          L             : LONGINT       ) : REAL;
  337.  
  338. Function  DollarsToLong(          R             : REAL          ) : LONGINT;
  339.  
  340. Function  BoolToStr(              Bool          : BOOLEAN;
  341.                                   TrueStr       : STRING;
  342.                                   FalseStr      : STRING        ) : STRING;
  343.  
  344.  
  345. {------------------}
  346. { BigNum Functions }
  347. {------------------}
  348.  
  349. Function  IntToBigNum(            L             : LONGINT       ) : STRING;
  350.  
  351. Function  BigNumToInt(            S             : STRING        ) : LONGINT;
  352.  
  353.  
  354.  
  355.  
  356. {---------------}
  357. { Hex functions }
  358. {---------------}
  359.  
  360. Function  CharToHex(              C             : SHORTINT      ) : ST80;
  361.  
  362. Function  ByteToHex(              B             : BYTE          ) : ST80;
  363.  
  364. Function  IntToHex(               I             : INTEGER       ) : ST80;
  365.  
  366. Function  WordToHex(              W             : WORD          ) : ST80;
  367.  
  368. Function  PtrToHex(               P             : POINTER       ) : ST80;
  369.  
  370. Function  LongToHex(              L             : LONGINT       ) : ST80;
  371.  
  372. Function  DecToHexStr(            S             : STRING        ) : STRING;
  373.  
  374. Function  HexToDecStr(            S             : STRING        ) : STRING;
  375.  
  376. Function  HexToChar(              S             : ST80          ) : SHORTINT;
  377.  
  378. Function  HexToByte(              S             : ST80          ) : BYTE;
  379.  
  380. Function  HexToInt(               S             : ST80          ) : INTEGER;
  381.  
  382. Function  HexToWord(              S             : ST80          ) : WORD;
  383.  
  384. Function  HexToLong(              S             : ST80          ) : LONGINT;
  385.  
  386.  
  387. {------------------}
  388. { Binary Functions }
  389. {------------------}
  390.  
  391. Function  ByteToBin(              B             : BYTE          ) : ST80;
  392.  
  393. Function  IntToBin(               I             : INTEGER       ) : ST80;
  394.  
  395. Function  WordToBin(              W             : WORD          ) : ST80;
  396.  
  397. Function  LongToBin(              L             : LONGINT       ) : ST80;
  398.  
  399.  
  400. Function  BinToChar(              S             : ST80          ) : SHORTINT;
  401.  
  402. Function  BinToByte(              S             : ST80          ) : BYTE;
  403.  
  404. Function  BinToInt(               S             : ST80          ) : INTEGER;
  405.  
  406. Function  BinToWord(              S             : ST80          ) : WORD;
  407.  
  408. Function  BinToLong(              S             : ST80          ) : LONGINT;
  409.  
  410.  
  411. {-----------------}
  412. { BCD Conversions }
  413. {-----------------}
  414.  
  415. Function  DecToBCD(               Decimal       : BYTE          ) : BYTE;
  416.  
  417. Function  BCDtoDec(               Bcd           : BYTE          ) : BYTE;
  418.  
  419. Function  ByteToBCD(              Decimal       : BYTE          ) : WORD;
  420.  
  421. Function  BCDtoByte(              Bcd           : WORD          ) : BYTE;
  422.  
  423. Function  WordToBCD(              Decimal       : WORD          ) : LONGINT;
  424.  
  425. Function  BCDtoWord(              Bcd           : LONGINT       ) : WORD;
  426.  
  427.  
  428.  
  429. {---------------------------------}
  430. { Variable Comparing and swapping }
  431. {---------------------------------}
  432.  
  433. Function  FastCompare(        Var Buf1;
  434.                               Var Buf2;
  435.                                   Count         : WORD          ) : WORD;
  436.  
  437. Function  Compare(            Var Buf1;
  438.                               Var Buf2;
  439.                                   Count         : WORD          ) : WORD;
  440.  
  441. Function  CompareSmaller(     Var Buf1;
  442.                               Var Buf2;
  443.                                   Count         : WORD          ) : SHORTINT;
  444.  
  445. Function  CompareBufByte(     Var Buff;
  446.                                   Count         : WORD;
  447.                                   B             : BYTE          ) : WORD;
  448.  
  449. Function  CompareBufWord(     Var Buff;
  450.                                   Count         : WORD;
  451.                                   W             : WORD          ) : WORD;
  452.  
  453. Function  LookupByte(             InByte        : BYTE;
  454.                                   Count         : WORD;
  455.                               Var LTable;
  456.                               Var OutByte       : BYTE          ) : BOOLEAN;
  457.  
  458. Function  LookupWord(             InWord        : WORD;
  459.                                   Count         : WORD;
  460.                               Var LTable;
  461.                               Var OutWord       : WORD          ) : BOOLEAN;
  462.  
  463. Procedure SwapBuffers(        Var Buf1;
  464.                               Var Buf2;
  465.                                   Count         : WORD          );
  466.  
  467. Procedure SwapWords(          Var A,
  468.                                   B             : WORD          );
  469.  
  470. Procedure SwapInts(           Var A,
  471.                                   B             : INTEGER       );
  472.  
  473. Procedure SwapBytes(          Var A,
  474.                                   B             : BYTE          );
  475.  
  476. Function  GreaterInt(             A,
  477.                                   B             : INTEGER       ) : INTEGER;
  478.  
  479. Function  GreaterWord(            A,
  480.                                   B             : WORD          ) : WORD;
  481.  
  482. Function  GreaterLong(            A,
  483.                                   B             : LONGINT       ) : LONGINT;
  484.  
  485. Function  LesserInt(              A,
  486.                                   B             : INTEGER       ) : INTEGER;
  487.  
  488. Function  LesserWord(             A,
  489.                                   B             : WORD          ) : WORD;
  490.  
  491. Function  LesserLong(             A,
  492.                                   B             : LONGINT       ) : LONGINT;
  493.  
  494. Procedure FillWord(           Var Buf;
  495.                                   Count         : WORD;
  496.                                   Value         : WORD          );
  497.  
  498. Procedure FillLong(           Var Buf;
  499.                                   Count         : WORD;
  500.                                   Value         : LONGINT       );
  501.  
  502. {----------------}
  503. { System and CPU }
  504. {----------------}
  505.  
  506. Procedure RebootMachine(          WarmBoot      : BOOLEAN       );
  507.  
  508.  
  509. {---------------}
  510. { CRC Functions }
  511. {---------------}
  512.  
  513. Procedure CRC16Char(          Var Ch            : CHAR;
  514.                               Var Result        : WORD          );
  515.  
  516. Procedure CRC16Buffer(        Var Buf;
  517.                                   Count         : WORD;
  518.                               Var Result        : WORD          );
  519.  
  520. Procedure CRC32Char(          Var Ch            : CHAR;
  521.                               Var Result        : LONGINT       );
  522.  
  523. Procedure CRC32Buffer(        Var Buf;
  524.                                   Count         : WORD;
  525.                               Var Result        : LONGINT       );
  526.  
  527. {-------------------}
  528. { Soundex functions }
  529. {-------------------}
  530.  
  531. Function  SoundexPack(            S             : STRING        ) : WORD;
  532.  
  533. Function  SoundexUnPack(          W             : WORD          ) : STRING;
  534.  
  535. Function  SoundexStr(             S             : STRING        ) : STRING;
  536.  
  537. {----------------------------------}
  538. { Pointer / Pointer math functions }
  539. {----------------------------------}
  540.  
  541. Function  PtrToLin(               Ptr           : POINTER       ) : LONGINT;
  542.  
  543. Function  LinToPtr(               Lin           : LONGINT       ) : POINTER;
  544.  
  545. Function  PtrAdd(                 OrigPtr       : POINTER;
  546.                                   AddOfs        : LONGINT       ) : POINTER;
  547.  
  548. Function  PtrSub(                 OrigPtr       : POINTER;
  549.                                   SubOfs        : LONGINT       ) : POINTER;
  550.  
  551. Function  PtrDiff(                A             : POINTER;
  552.                                   B             : POINTER       ) : LONGINT;
  553.  
  554.  
  555. {--------------------------------}
  556. { "inline" / low-level functions }
  557. {--------------------------------}
  558.  
  559. Procedure FarCall(                Proc          : POINTER       );
  560.  
  561.  
  562. Procedure SetJump(                JumpInfo      : PJumpInfo     );
  563.  
  564.  
  565. Procedure LongJump(               JumpInfo      : PJumpInfo     );
  566.  
  567.  
  568. Procedure EnableInts;
  569.  
  570. Procedure DisableInts;
  571.  
  572. Procedure PushWord(               W             : WORD          );
  573.  
  574. Procedure PushLong(               L             : LONGINT       );
  575.  
  576. Procedure PushPtr(                P             : POINTER       );
  577.  
  578. Function  PopWord : WORD;
  579. Function  PopLong : LONGINT;
  580. Function  PopPtr  : POINTER;
  581.  
  582.  
  583. {----------------}
  584. { Misc functions }
  585. {----------------}
  586.  
  587. Procedure BufferSRByte(    Buffer         : POINTER;
  588.                            BuffSize       : WORD;
  589.                            ByteToLookfor  : BYTE;
  590.                            ReplaceWith    : BYTE      );
  591.  
  592. Function  GetNextTwirlyChar : CHAR;
  593.  
  594.  
  595.  
  596. {════════════════════════════════════════════════════════════════════════════}
  597.  
  598.  
  599. IMPLEMENTATION
  600.  
  601. Var
  602.  
  603.   StartClock : REAL;
  604.  
  605.  
  606. (*-
  607.  
  608. [FUNCTION]
  609.  
  610. Function  ValidByte(                 S         : STRING  ) : BOOLEAN;
  611.  
  612. [PARAMETERS]
  613.  
  614. S           String representing a byte value
  615.  
  616. [RETURNS]
  617.  
  618. Whether that string did represent a byte value
  619.  
  620. [DESCRIPTION]
  621.  
  622. Returns whether or not the given String represents a Valid Byte
  623. Value.
  624.  
  625. [SEE-ALSO]
  626.  
  627. ValidInt      ValidLong     ValidFlot    ValidSci
  628. ValidHexByte  ValidHexWord  ValidHex
  629.  
  630. [EXAMPLE]
  631.  
  632. BEGIN
  633.  
  634.   WriteLn( ValidByte( '123' ) );  { TRUE  }
  635.   WriteLn( ValidByte( '345' ) );  { FALSE }
  636.   WriteLn( ValidByte( 'abc' ) );  { FALSE }
  637.  
  638. END;
  639.  
  640. -*)
  641.  
  642.  
  643. Function ValidByte(          S         : STRING       ) : BOOLEAN;
  644.  
  645. Var
  646.  
  647.   B : BYTE;
  648.   E : INTEGER;
  649.  
  650. BEGIN
  651.  
  652.   Val( S, B, E );
  653.   ValidByte := E = 0;
  654.  
  655. END;  { ValidByte }
  656.  
  657. {────────────────────────────────────────────────────────────────────────────}
  658.  
  659. (*-
  660.  
  661. [FUNCTION]
  662.  
  663. Function  ValidInt(                  S         : STRING  ) : BOOLEAN;
  664.  
  665. [PARAMETERS]
  666.  
  667. S           String representing a Signed Integer value (Word)
  668.  
  669. [RETURNS]
  670.  
  671. Whether that string did represent a signed integer value
  672.  
  673. [DESCRIPTION]
  674.  
  675. Returns whether or not the given String represents a Valid
  676. Integer Value.
  677.  
  678. [SEE-ALSO]
  679.  
  680. ValidByte
  681. ValidLong
  682. ValidFloat
  683. ValidSci
  684. ValidHexByte
  685. ValidHexWord
  686. ValidHex
  687.  
  688. [EXAMPLE]
  689.  
  690. BEGIN
  691.  
  692.   WriteLn( ValidInt( '12345'  ) );  { TRUE  }
  693.   WriteLn( ValidInt( '123456' ) );  { FALSE }
  694.   WriteLn( ValidInt( 'abcdef' ) );  { FALSE }
  695.  
  696. END;
  697.  
  698. -*)
  699.  
  700.  
  701. Function ValidInt(           S         : STRING       ) : BOOLEAN;
  702.  
  703. Var
  704.  
  705.   I : INTEGER;
  706.   E : INTEGER;
  707.  
  708. BEGIN
  709.  
  710.   Val( S, I, E );
  711.   ValidInt := E = 0;
  712.  
  713. END;  { ValidInt }
  714.  
  715. {────────────────────────────────────────────────────────────────────────────}
  716.  
  717. (*-
  718.  
  719. [FUNCTION]
  720.  
  721. Function  ValidLong(                 S         : STRING  ) : BOOLEAN;
  722.  
  723. [PARAMETERS]
  724. S           String representing a Signed Longint value (Double Word)
  725.  
  726. [RETURNS]
  727.  
  728. Whether that string did represent a signed longint value
  729.  
  730. [DESCRIPTION]
  731.  
  732. Returns whether or not the given String represents a Valid
  733. Long Integer Value.
  734.  
  735. [SEE-ALSO]
  736.  
  737. ValidByte
  738. ValidInt
  739. ValidFloat
  740. ValidSci
  741. ValidHexByte
  742. ValidHexWord
  743. ValidHex
  744.  
  745. [EXAMPLE]
  746.  
  747. BEGIN
  748.  
  749.   WriteLn( ValidLong( '12345678'     ) );  { TRUE }
  750.   WriteLn( ValidLong( '999999999999' ) );  { FALSE }
  751.   WriteLn( ValidLong( 'abcdefgh'     ) );  { FALSE }
  752.  
  753. END;
  754.  
  755. -*)
  756.  
  757.  
  758. Function ValidLong(          S         : STRING       ) : BOOLEAN;
  759.  
  760. Var
  761.  
  762.   L : LONGINT;
  763.   E : INTEGER;
  764.  
  765. BEGIN
  766.  
  767.   Val( S, L, E );
  768.   ValidLong := E = 0;
  769.  
  770. END;  { ValidLong }
  771.  
  772. {────────────────────────────────────────────────────────────────────────────}
  773.  
  774. (*-
  775.  
  776. [FUNCTION]
  777.  
  778. Function  ValidFloat(                S         : STRING  ) : BOOLEAN;
  779.  
  780. [PARAMETERS]
  781.  
  782. S           String value representing a floating point value
  783.  
  784. [RETURNS]
  785.  
  786. Whether that string did represent a floating point value
  787.  
  788. [DESCRIPTION]
  789.  
  790. Returns whether or not the given String represents a Valid
  791. Floating Point Value.
  792.  
  793. [SEE-ALSO]
  794.  
  795. ValidByte
  796. ValidInt
  797. ValidLong
  798. ValidSci
  799. ValidHexByte
  800. ValidHexWord
  801. ValidHex
  802.  
  803. [EXAMPLE]
  804.  
  805. BEGIN
  806.  
  807.   WriteLn( ValidFloat( '123.456' ) );  { TRUE  }
  808.   WriteLn( ValidFloat( 'abcdefg' ) );  { FALSE }
  809.  
  810. END;
  811.  
  812. -*)
  813.  
  814. Function ValidFloat(         S         : STRING       ) : BOOLEAN;
  815.  
  816. Var
  817.  
  818.   R : REAL;
  819.   E : INTEGER;
  820.  
  821. BEGIN
  822.  
  823.   Val( S, R, E );
  824.   ValidFloat := E = 0;
  825.  
  826. END;  { ValidFloat }
  827.  
  828. {────────────────────────────────────────────────────────────────────────────}
  829.  
  830. (*-
  831.  
  832. [FUNCTION]
  833.  
  834. Function  ValidSci(                  S         : STRING  ) : BOOLEAN;
  835.  
  836. [PARAMETERS]
  837.  
  838. S           String representing a floating point value in scientific
  839.             notation
  840.  
  841. [RETURNS]
  842.  
  843. Whether that string did represent a floating point value in scientific
  844. notation
  845.  
  846. [DESCRIPTION]
  847.  
  848. Returns whether or not the given String represents a Valid
  849. Scientific Notation Floating Point Value.
  850.  
  851. [SEE-ALSO]
  852.  
  853. ValidByte
  854. ValidInt
  855. ValidLong
  856. ValidFloat
  857. ValidHexByte
  858. ValidHexWord
  859. ValidHex
  860.  
  861. [EXAMPLE]
  862.  
  863. BEGIN
  864.  
  865.   WriteLn( ValidSci( '1.234E10' ) );  { TRUE  }
  866.   WriteLn( ValidSci( '12.34E10' ) );  { TRUE  }
  867.   WriteLn( ValidSci( '1.234E99' ) );  { FALSE }
  868.   WriteLn( ValidSci( '1.234X10' ) );  { FALSE }
  869.   WriteLn( ValidSci( '12345678' ) );  { TRUE  }
  870.   WriteLn( ValidSci( 'abcdefgh' ) );  { FALSE }
  871.  
  872. END;
  873.  
  874. -*)
  875.  
  876. Function ValidSci(           S         : STRING       ) : BOOLEAN;
  877.  
  878. Var
  879.  
  880.   R : REAL;
  881.   E : INTEGER;
  882.  
  883. BEGIN
  884.  
  885.   Val( S, R, E );
  886.   ValidSci := E = 0;
  887.  
  888. END;  { ValidSci }
  889.  
  890. {────────────────────────────────────────────────────────────────────────────}
  891.  
  892. (*-
  893.  
  894. [FUNCTION]
  895.  
  896. Function  ValidHexByte(              S         : STRING  ) : BOOLEAN;
  897.  
  898. [PARAMETERS]
  899.  
  900. S           String representing Byte value in hex
  901.  
  902. [RETURNS]
  903.  
  904. Whether that string did represent a byte value in hex
  905.  
  906. [DESCRIPTION]
  907.  
  908. Returns whether or not the given String represents a Valid
  909. Byte in Hexadecimal format.
  910.  
  911. [SEE-ALSO]
  912.  
  913. ValidByte
  914. ValidInt
  915. ValidLong
  916. ValidFloat
  917. ValidSci
  918. ValidHexWord
  919. ValidHex
  920.  
  921. [EXAMPLE]
  922.  
  923. BEGIN
  924.  
  925.   WriteLn( Valid( '1A'   ) );  { TRUE  }
  926.   WriteLn( Valid( 'Ff'   ) );  { TRUE  }
  927.   WriteLn( Valid( '1A2b' ) );  { FALSE }
  928.   WriteLn( Valid( 'zyx'  ) );  { FALSE }
  929.   WriteLn( Valid( '2'    ) );  { TRUE  }
  930.  
  931. END;
  932.  
  933. -*)
  934.  
  935.  
  936. Function ValidHexByte(       S         : STRING       ) : BOOLEAN;
  937.  
  938. Const
  939.  
  940.   HexTable = '0123456789ABCDEF';
  941.  
  942. Var
  943.  
  944.   OK : BOOLEAN;
  945.   I  : INTEGER;
  946.   L  : INTEGER;
  947.  
  948. BEGIN
  949.  
  950.   If Byte(S[0]) = 1 Then
  951.     S := '0' + S;
  952.  
  953.   I  := 1;
  954.   L  := Byte(S[0]);
  955.   OK := L = 2;
  956.  
  957.   While ( I <= L ) AND OK Do
  958.   BEGIN
  959.  
  960.     OK := Pos( UpCase(S[I]), HexTable ) > 0;
  961.     Inc( I );
  962.  
  963.   END;
  964.  
  965.   ValidHexByte := OK;
  966.  
  967. END;  { ValidHexByte }
  968.  
  969. {────────────────────────────────────────────────────────────────────────────}
  970.  
  971. (*-
  972.  
  973. [FUNCTION]
  974.  
  975. Function  ValidHexWord(              S         : STRING  ) : BOOLEAN;
  976.  
  977. [PARAMETERS]
  978.  
  979. S           String representing a Word value in hex
  980.  
  981. [RETURNS]
  982.  
  983. Whether that string did represent a word value in hex
  984.  
  985. [DESCRIPTION]
  986.  
  987. Returns whether or not the given String represents a Valid
  988. Word in Hexadecimal format.
  989.  
  990. [SEE-ALSO]
  991.  
  992. ValidByte
  993. ValidInt
  994. ValidLong
  995. ValidFloat
  996. ValidSci
  997. ValidHexByte
  998. ValidHex
  999.  
  1000. [EXAMPLE]
  1001.  
  1002. BEGIN
  1003.  
  1004.   WriteLn( ValidHexWord( '1A2B'  ) );  { TRUE  }
  1005.   WriteLn( ValidHexWord( 'FFFf'  ) );  { TRUE  }
  1006.   WriteLn( ValidHexWord( '12345' ) );  { FALSE }
  1007.   WriteLn( ValidHexWord( 'zyxw'  ) );  { FALSE }
  1008.   WriteLn( ValidHexWord( '12'    ) );  { TRUE  }
  1009.  
  1010. END;
  1011.  
  1012. -*)
  1013.  
  1014. Function ValidHexWord(       S         : STRING       ) : BOOLEAN;
  1015.  
  1016. Const
  1017.  
  1018.   HexTable = '0123456789ABCDEF';
  1019.  
  1020. Var
  1021.  
  1022.   OK : BOOLEAN;
  1023.   I  : INTEGER;
  1024.   L  : INTEGER;
  1025.  
  1026. BEGIN
  1027.  
  1028.   OK := S <> '';
  1029.  
  1030.   While OK AND ( Byte(S[0]) < 4 ) Do
  1031.     S := '0' + S;
  1032.  
  1033.   I  := 1;
  1034.   L  := Byte(S[0]);
  1035.   OK := L = 4;
  1036.  
  1037.   While ( I <= L ) and OK Do
  1038.   BEGIN
  1039.  
  1040.     OK := Pos( UpCase(S[I]), HexTable ) > 0;
  1041.     Inc(I);
  1042.  
  1043.   END;
  1044.  
  1045.   ValidHexWord := OK;
  1046.  
  1047. END;  { ValidHexWord }
  1048.  
  1049. {────────────────────────────────────────────────────────────────────────────}
  1050.  
  1051. (*-
  1052.  
  1053. [FUNCTION]
  1054.  
  1055. Function  ValidHex(                  S         : STRING  ) : BOOLEAN;
  1056.  
  1057. [PARAMETERS]
  1058.  
  1059. S           String representing a Word value in hex
  1060.  
  1061. [RETURNS]
  1062.  
  1063. Whether that string did represent a word value in hex
  1064.  
  1065. [DESCRIPTION]
  1066.  
  1067. Returns whether or not the given String represents a Valid
  1068. value in Hexadecimal format.  This function doesn't consider
  1069. length to be of consideration.  It simply checks that throughout
  1070. the entire length of the string, every character is within the
  1071. valid range of a Hex character.
  1072.  
  1073. [SEE-ALSO]
  1074.  
  1075. ValidByte
  1076. ValidInt
  1077. ValidLong
  1078. ValidFloat
  1079. ValidSci
  1080. ValidHexByte
  1081. ValidHex
  1082.  
  1083. [EXAMPLE]
  1084.  
  1085. BEGIN
  1086.  
  1087.   WriteLn( ValidHex( '1D'      ) );  { TRUE  }
  1088.   WriteLn( ValidHex( '15DF'    ) );  { TRUE  }
  1089.   WriteLn( ValidHex( 'zwyvx'   ) );  { FALSE }
  1090.   WriteLn( ValidHex( '153FD85' ) );  { TRUE  }
  1091.  
  1092. END;
  1093.  
  1094. -*)
  1095.  
  1096.  
  1097. Function ValidHex(           S         : STRING       ) : BOOLEAN;
  1098.  
  1099. Const
  1100.  
  1101.   HexTable = '0123456789ABCDEF';
  1102.  
  1103. Var
  1104.  
  1105.   OK : BOOLEAN;
  1106.   I  : INTEGER;
  1107.   L  : INTEGER;
  1108.  
  1109. BEGIN
  1110.  
  1111.   OK := S <> '';
  1112.   I  := 1;
  1113.   L  := Byte(S[0]);
  1114.  
  1115.   While ( I <= L ) and OK Do
  1116.   BEGIN
  1117.  
  1118.     OK := Pos( UpCase(S[I]), HexTable ) > 0;
  1119.     Inc(I);
  1120.  
  1121.   END;
  1122.  
  1123.   ValidHex := OK;
  1124.  
  1125. END;  { ValidHex }
  1126.  
  1127. {────────────────────────────────────────────────────────────────────────────}
  1128.  
  1129. (*-
  1130.  
  1131. [FUNCTION]
  1132.  
  1133. Function  IsAlpha(                   C         : CHAR    ) : BOOLEAN;
  1134.  
  1135. [PARAMETERS]
  1136.  
  1137. Source character to be tested.
  1138.  
  1139. [RETURNS]
  1140.  
  1141. Was this character an Alphabetic Character?
  1142.  
  1143. [DESCRIPTION]
  1144.  
  1145. Test char to ensure that it is an alphabetic char and returns the result.
  1146. An alphabetic char is defined as... all alphabetic chars (both upper
  1147. and lower case) including foreign language inflections.
  1148.  
  1149. [SEE-ALSO]
  1150.  
  1151. IsNum
  1152. IsAlphaNum
  1153. IsUpCase
  1154. IsLoCase
  1155. IsGrammar
  1156. IsCtrl
  1157. IsBorder
  1158. IsLang
  1159. IsSymbol
  1160.  
  1161. [EXAMPLE]
  1162.  
  1163. BEGIN
  1164.  
  1165.   WriteLn( IsAlpha( 'a' ) );  { TRUE  }
  1166.   WriteLn( IsAlpha( 'A' ) );  { TRUE  }
  1167.   WriteLn( IsAlpha( '8' ) );  { FALSE }
  1168.   WriteLn( IsAlpha( '-' ) );  { FALSE }
  1169.   WriteLn( IsAlpha( 'ë' ) );  { TRUE  - Note: It includes Foreign Text! }
  1170.   WriteLn( IsAlpha( 'Æ' ) );  { TRUE  }
  1171.  
  1172. END;
  1173.  
  1174. -*)
  1175.  
  1176. {----------------------------------------------------------}
  1177. {             Function IsAlpha                             }
  1178. {----------------------------------------------------------}
  1179. { IN:  C (CHAR) source character to be tested              }
  1180. { OUT: (BOOLEAN) was this char an alpha character?         }
  1181. { Included in this set are all Foreign Language Text Chars }
  1182. {----------------------------------------------------------}
  1183.  
  1184. Function IsAlpha(            C         : CHAR         ) : BOOLEAN;
  1185.  
  1186. BEGIN
  1187.  
  1188.   IsAlpha := ( (Byte( C ) >= $41 ) AND    { A }
  1189.                (Byte( C ) <= $5A ) ) OR   { Z }
  1190.  
  1191.              ( (Byte( C ) >= $61 ) AND    { a }
  1192.                (Byte( C ) <= $7A ) ) OR   { z }
  1193.  
  1194.              ( (Byte( C ) >= $80 ) AND    { Ç }
  1195.                (Byte( C ) <= $AF ) ) OR   { Ü }
  1196.  
  1197.              ( (Byte( C ) >= $E0 ) AND    { á }
  1198.                (Byte( C ) <= $F1 ) );     { º }
  1199.  
  1200. END;
  1201.  
  1202. {────────────────────────────────────────────────────────────────────────────}
  1203.  
  1204. (*-
  1205.  
  1206. [FUNCTION]
  1207.  
  1208. Function  IsNum(                     C         : CHAR    ) : BOOLEAN;
  1209.  
  1210. [PARAMETERS]
  1211.  
  1212. C           Source Character to be tested.
  1213.  
  1214. [RETURNS]
  1215.  
  1216. Whether that character did represent a numeric char
  1217.  
  1218. [DESCRIPTION]
  1219.  
  1220. Test char to ensure that it is a numeric char and returns the result.
  1221. A numeric char is defined as... all chars from ASCII xx to ASCII xx
  1222.  
  1223. [SEE-ALSO]
  1224.  
  1225. IsAlpha
  1226. IsAlphaNum
  1227. IsUpCase
  1228. IsLoCase
  1229. IsGrammar
  1230. IsCtrl
  1231. IsBorder
  1232. IsLang
  1233. IsSymbol
  1234.  
  1235. [EXAMPLE]
  1236.  
  1237. BEGIN
  1238.  
  1239.   WriteLn( IsNum( '4' ) );  { TRUE  }
  1240.   WriteLn( IsNum( 'K' ) );  { FALSE }
  1241.   WriteLn( IsNum( '#' ) );  { FALSE }
  1242.  
  1243. END;
  1244.  
  1245. -*)
  1246.  
  1247. Function IsNum(              C         : CHAR         ) : BOOLEAN;
  1248.  
  1249. BEGIN
  1250.  
  1251.   IsNum := ( ( Byte( C ) >= $30 ) AND   { 0 }
  1252.              ( Byte( C ) <= $39 ) );    { 9 }
  1253.  
  1254. END;
  1255.  
  1256. {────────────────────────────────────────────────────────────────────────────}
  1257.  
  1258. (*-
  1259.  
  1260. [FUNCTION]
  1261.  
  1262. Function  IsAlphaNum(                C         : CHAR    ) : BOOLEAN;
  1263.  
  1264. [PARAMETERS]
  1265.  
  1266. C           Source Character character to be tested
  1267.  
  1268. [RETURNS]
  1269.  
  1270. Whether that character did represent an alpha-numeric char
  1271.  
  1272. [DESCRIPTION]
  1273.  
  1274. Tests char to ensure that it is alpha-numeric and returns result.
  1275. An alpha-numeric char is defined as... all numeric and alphbetic
  1276. chars (both upper and lower case) including foreign language inflections.
  1277.  
  1278. [SEE-ALSO]
  1279.  
  1280. IsAlpha
  1281. IsNum
  1282. IsUpCase
  1283. IsLoCase
  1284. IsGrammar
  1285. IsCtrl
  1286. IsBorder
  1287. IsLang
  1288. IsSymbol
  1289.  
  1290. [EXAMPLE]
  1291.  
  1292. BEGIN
  1293.  
  1294.   WriteLn( IsAlphaNum( 'a' ) );  { TRUE  }
  1295.   WriteLn( IsAlphaNum( 'A' ) );  { TRUE  }
  1296.   WriteLn( IsAlphaNum( ' ' ) );  { FALSE }
  1297.   WriteLn( IsAlphaNum( '4' ) );  { TRUE  }
  1298.   WriteLn( IsAlphaNum( '&' ) );  { FALSE }
  1299.   WriteLn( IsAlphaNum( 'ü' ) );  { TRUE  }
  1300.  
  1301. END;
  1302.  
  1303. -*)
  1304.  
  1305. Function IsAlphaNum(         C         : CHAR         ) : BOOLEAN;
  1306.  
  1307. BEGIN
  1308.  
  1309.   IsAlphaNum := ( (Byte( C ) >= $30 ) AND     { 0 }
  1310.                   (Byte( C ) <= $39 ) ) OR    { 9 }
  1311.  
  1312.                 ( (Byte( C ) >= $41 ) AND     { A }
  1313.                   (Byte( C ) <= $5A ) ) OR    { Z }
  1314.  
  1315.                 ( (Byte( C ) >= $61 ) AND     { a }
  1316.                   (Byte( C ) <= $7A ) ) OR    { z }
  1317.  
  1318.                 ( (Byte( C ) >= $80 ) AND     { Ç }
  1319.                   (Byte( C ) <= $AF ) ) OR    { » }
  1320.  
  1321.                 ( (Byte( C ) >= $E0 ) AND     { α }
  1322.                   (Byte( C ) <= $F1 ) );      { ± }
  1323.  
  1324. END;
  1325.  
  1326. {────────────────────────────────────────────────────────────────────────────}
  1327.  
  1328. (*-
  1329.  
  1330. [FUNCTION]
  1331.  
  1332. Function  IsUpCase(                  C         : CHAR    ) : BOOLEAN;
  1333.  
  1334. [PARAMETERS]
  1335.  
  1336. C           Source Character to be tested
  1337.  
  1338. [RETURNS]
  1339.  
  1340. Whether that character did represent an upper case char of any language
  1341.  
  1342. [DESCRIPTION]
  1343.  
  1344. Tests char to ensure that it is an upper case char (whether English or
  1345. Foreign Inflection) and returns result.
  1346.  
  1347. [SEE-ALSO]
  1348.  
  1349. IsAlpha
  1350. IsNum
  1351. IsAlphaNum
  1352. IsLoCase
  1353. IsGrammar
  1354. IsCtrl
  1355. IsBorder
  1356. IsLang
  1357. IsSymbol
  1358.  
  1359. [EXAMPLE]
  1360.  
  1361. BEGIN
  1362.  
  1363.   WriteLn( IsUpCase( 'A' ) );  { TRUE  }
  1364.   WriteLn( IsUpCase( 'a' ) );  { FALSE }
  1365.   WriteLn( IsUpCase( 'ü' ) );  { FALSE }
  1366.   WriteLn( IsUpCase( 'Æ' ) );  { TRUE  }
  1367.   WriteLn( IsUpCase( '%' ) );  { FALSE }
  1368.   WriteLn( IsUpCase( '3' ) );  { FALSE }
  1369.  
  1370. END;
  1371.  
  1372. -*)
  1373.  
  1374.  
  1375. Function IsUpCase(           C         : CHAR         ) : BOOLEAN;
  1376.  
  1377. BEGIN
  1378.  
  1379.     IsUpCase := ( ( Byte( C ) >= $41 ) AND         { A }
  1380.                       ( Byte( C ) <= $5A ) ) OR      { Z }
  1381.  
  1382.             ( ( Byte( C ) >= $80 ) AND         { Ç }
  1383.               ( Byte( C ) <= $9F ) ) OR      { ƒ }
  1384.  
  1385.               ( Byte( C ) = $F0 );           { ≡ }
  1386.  
  1387. END;
  1388.  
  1389. {────────────────────────────────────────────────────────────────────────────}
  1390.  
  1391. (*-
  1392.  
  1393. [FUNCTION]
  1394.  
  1395. Function  IsLoCase(                  C         : CHAR    ) : BOOLEAN;
  1396.  
  1397. [PARAMETERS]
  1398.  
  1399. C           Source Character to be tested
  1400.  
  1401. [RETURNS]
  1402.  
  1403. Whether that character did represent a lower case char in any language.
  1404.  
  1405. [DESCRIPTION]
  1406.  
  1407. Tests char to ensure that it is a lower case char (whether English or
  1408. Foreign Imflection) and returns result.
  1409.  
  1410. [SEE-ALSO]
  1411.  
  1412. IsAlpha
  1413. IsNum
  1414. IsAlphaNum
  1415. IsUpCase
  1416. IsGrammar
  1417. IsCtrl
  1418. IsBorder
  1419. IsLang
  1420. IsSymbol
  1421.  
  1422. [EXAMPLE]
  1423.  
  1424. BEGIN
  1425.  
  1426.   WriteLn( IsUpCase( 'A' ) );  { FALSE }
  1427.   WriteLn( IsUpCase( 'a' ) );  { TRUE  }
  1428.   WriteLn( IsUpCase( 'í' ) );  { TRUE  }
  1429.   WriteLn( IsUpCase( 'Æ' ) );  { FALSE }
  1430.   WriteLn( IsUpCase( '%' ) );  { FALSE }
  1431.   WriteLn( IsUpCase( '3' ) );  { FALSE }
  1432.  
  1433. END;
  1434.  
  1435. -*)
  1436.  
  1437.  
  1438. Function IsLoCase(           C         : CHAR         ) : BOOLEAN;
  1439.  
  1440. BEGIN
  1441.  
  1442.     IsLoCase := ( ( Byte( C ) <= $61 ) AND         { a }
  1443.                       ( Byte( C ) >= $7A ) ) OR      { z }
  1444.  
  1445.             ( ( Byte( C ) >= $A0 ) AND         { á }
  1446.               ( Byte( C ) <= $AF ) ) OR      { » }
  1447.  
  1448.             ( ( Byte( C ) >= $E0 ) AND         { α }
  1449.               ( Byte( C ) <= $EF ) ) OR      { ∩ }
  1450.  
  1451.               ( Byte( C ) = $F1 );         { ± }
  1452.  
  1453. END;
  1454.  
  1455. {────────────────────────────────────────────────────────────────────────────}
  1456.  
  1457. (*-
  1458.  
  1459. [FUNCTION]
  1460.  
  1461. Function  IsGrammar(                 C         : CHAR    ) : BOOLEAN;
  1462.  
  1463. [PARAMETERS]
  1464.  
  1465. C           Source Character to be tested
  1466.  
  1467. [RETURNS]
  1468.  
  1469. Whether that character did represent a grammar char
  1470.  
  1471. [DESCRIPTION]
  1472.  
  1473. Tests char to ensure that it is a grammar char and returns result.
  1474. This includes all standard grammar symbols as well as all math and
  1475. currency symbols.
  1476.  
  1477. [SEE-ALSO]
  1478.  
  1479. IsAlpha
  1480. IsNum
  1481. IsAlphaNum
  1482. IsUpCase
  1483. IsLoCase
  1484. IsCtrl
  1485. IsBorder
  1486. IsLang
  1487. IsSymbol
  1488.  
  1489. [EXAMPLE]
  1490.  
  1491. BEGIN
  1492.  
  1493.   WriteLn( IsGrammar( '.' ) );  { TRUE  }
  1494.   WriteLn( IsGrammar( '!' ) );  { TRUE  }
  1495.   WriteLn( IsGrammar( 'd' ) );  { FALSE }
  1496.   WriteLn( IsGrammar( '6' ) );  { FALSE }
  1497.   WriteLn( IsGrammar( '&' ) );  { TRUE  }
  1498.   WriteLn( IsGrammar( '/' ) );  { TRUE  }
  1499.  
  1500. END;
  1501.  
  1502. -*)
  1503.  
  1504.  
  1505. Function IsGrammar(          C         : CHAR         ) : BOOLEAN;
  1506.  
  1507. BEGIN
  1508.  
  1509.   IsGrammar := ( (Byte( C ) >= $21 ) AND    { ! }
  1510.                  (Byte( C ) <= $2F ) ) OR   { / }
  1511.  
  1512.                ( (Byte( C ) >= $3A ) AND    { : }
  1513.                  (Byte( C ) <= $40 ) ) OR   { @ }
  1514.  
  1515.                ( (Byte( C ) >= $5B ) AND    { [ }
  1516.                  (Byte( C ) <= $60 ) ) OR   { ` }
  1517.  
  1518.                ( (Byte( C ) >= $7B ) AND    { { }
  1519.                  (Byte( C ) <= $7E ) ) OR   { ~ }
  1520.  
  1521.            ( (Byte( C ) >= $9B ) AND    {  }
  1522.          (Byte( C ) <= $9F ) ) OR   {  }
  1523.  
  1524.            (  Byte( C ) =  $A8 )   OR   {  }
  1525.  
  1526.            ( (Byte( C ) >= $AB ) AND    {  }
  1527.          (Byte( C ) <= $AF ) );     {  }
  1528.  
  1529. END;
  1530.  
  1531. {────────────────────────────────────────────────────────────────────────────}
  1532.  
  1533. (*-
  1534.  
  1535. [FUNCTION]
  1536.  
  1537. Function  IsCtrl(                    C         : CHAR    ) : BOOLEAN;
  1538.  
  1539. [PARAMETERS]
  1540.  
  1541. C           Source Character to be tested.
  1542.  
  1543. [RETURNS]
  1544.  
  1545. Whether that character did represent a control character
  1546.  
  1547. [DESCRIPTION]
  1548.  
  1549. Tests char to ensure that it is a control char and returns the result.
  1550. A control char is defined as all chars below the ASCII value of 32.
  1551.  
  1552. [SEE-ALSO]
  1553.  
  1554. IsAlpha
  1555. IsNum
  1556. IsAlphaNum
  1557. IsUpCase
  1558. IsLoCase
  1559. IsGrammar
  1560. IsBorder
  1561. IsLang
  1562. IsSymbol
  1563.  
  1564. [EXAMPLE]
  1565.  
  1566. BEGIN
  1567.  
  1568.   WriteLn( IsCtrl( #13 ) );  { TRUE  }
  1569.   WriteLn( IsCtrl( #26 ) );  { TRUE  }
  1570.   WriteLn( IsCtrl( #32 ) );  { FALSE }
  1571.   WriteLn( IsCtrl( #97 ) );  { FALSE }
  1572.  
  1573. END;
  1574.  
  1575. -*)
  1576.  
  1577.  
  1578. Function IsCtrl(             C         : CHAR         ) : BOOLEAN;
  1579.  
  1580. BEGIN
  1581.  
  1582.   IsCtrl := ( Byte( C ) < $20 );
  1583.  
  1584. END;
  1585.  
  1586. {────────────────────────────────────────────────────────────────────────────}
  1587.  
  1588. (*-
  1589.  
  1590. [FUNCTION]
  1591.  
  1592. Function  IsBorder(                  C         : CHAR    ) : BOOLEAN;
  1593.  
  1594. [PARAMETERS]
  1595.  
  1596. C           Source Character to be tested.
  1597.  
  1598. [RETURNS]
  1599.  
  1600. Whether that character did represent a border character.
  1601.  
  1602. [DESCRIPTION]
  1603.  
  1604. Tests char to ensure that it is a border char and returns the result.
  1605. A border char is defined as all line drawing chars as well as
  1606. non-graphic text chars (vertical bar,plus, and dash) in addition
  1607. to solid boxes.
  1608.  
  1609. Except where the ASCII value is below 128, these chars are represented
  1610. as those that extend and touch the adjacent chars.
  1611.  
  1612. [SEE-ALSO]
  1613.  
  1614. IsAlpha
  1615. IsNum
  1616. IsAlphaNum
  1617. IsUpCase
  1618. IsLoCase
  1619. IsGrammar
  1620. IsCtrl
  1621. IsLang
  1622. IsSymbol
  1623.  
  1624. [EXAMPLE]
  1625.  
  1626. BEGIN
  1627.  
  1628.   WriteLn( IsBorder( '╔' ) );  { TRUE  }
  1629.   WriteLn( IsBorder( '┼' ) );  { TRUE  }
  1630.   WriteLn( IsBorder( 'a' ) );  { FALSE }
  1631.   WriteLn( IsBorder( '7' ) );  { FALSE }
  1632.   WriteLn( IsBorder( '█' ) );  { TRUE  }
  1633.   WriteLn( IsBorder( '&' ) );  { FALSE }
  1634.   WriteLn( IsBorder( '-' ) );  { TRUE  - Text Mode Borders }
  1635.   WriteLn( IsBorder( '|' ) );  { TRUE  }
  1636.   WriteLn( IsBorder( '+' ) );  { TRUE  }
  1637.  
  1638. END;
  1639.  
  1640. -*)
  1641.  
  1642.  
  1643. Function IsBorder(           C         : CHAR         ) : BOOLEAN;
  1644.  
  1645. BEGIN
  1646.  
  1647.   IsBorder := ( (Byte( C ) >= $B0 ) AND     { ░ }
  1648.                 (Byte( C ) <= $DF ) ) OR    { ▀ }
  1649.  
  1650.                 (Byte( C )  = $A9 ) OR      { ⌐ }
  1651.  
  1652.                 (Byte( C )  = $AA );        { ¬ }
  1653.  
  1654. END;
  1655.  
  1656. {────────────────────────────────────────────────────────────────────────────}
  1657.  
  1658. (*-
  1659.  
  1660. [FUNCTION]
  1661.  
  1662. Function  IsLang(                    C         : CHAR    ) : BOOLEAN;
  1663.  
  1664. [PARAMETERS]
  1665.  
  1666. C           Source Character to be tested.
  1667.  
  1668. [RETURNS]
  1669.  
  1670. Whether that character did represent a Foreign Language character.
  1671.  
  1672. [DESCRIPTION]
  1673.  
  1674. Test char to ensure that it is a language char and returns the result.
  1675. A language char is defined as all Foreign Language Alphbetic chars
  1676. (essentially those alpha chars containing foreign language inflections)
  1677.  
  1678. [SEE-ALSO]
  1679.  
  1680. IsAlpha
  1681. IsNum
  1682. IsAlphaNum
  1683. IsUpCase
  1684. IsLoCase
  1685. IsGrammar
  1686. IsCtrl
  1687. IsBorder
  1688. IsSymbol
  1689.  
  1690. [EXAMPLE]
  1691.  
  1692. BEGIN
  1693.  
  1694.   WriteLn( IsLang( 'Ä' ) );  { TRUE  }
  1695.   WriteLn( IsLang( 'ü' ) );  { TRUE  }
  1696.   WriteLn( IsLang( 'a' ) );  { FALSE }
  1697.   WriteLn( IsLang( 'Q' ) );  { FALSE }
  1698.   WriteLn( IsLang( '6' ) );  { FALSE }
  1699.   WriteLn( IsLang( '&' ) );  { FALSE }
  1700.   WriteLn( IsLang( '╔' ) );  { FALSE }
  1701.  
  1702. END;
  1703.  
  1704. -*)
  1705.  
  1706.  
  1707. Function IsLang(             C         : CHAR         ) : BOOLEAN;
  1708.  
  1709. BEGIN
  1710.  
  1711.   IsLang := ( ( Byte( C ) >= $80 ) AND    { Ç }
  1712.               ( Byte( C ) <= $9A ) ) OR   { Ü }
  1713.  
  1714.             ( ( Byte( C ) >= $A0 ) AND    { á }
  1715.               ( Byte( C ) <= $A7 ) );     { º }
  1716.  
  1717. END;
  1718.  
  1719. {────────────────────────────────────────────────────────────────────────────}
  1720.  
  1721. (*-
  1722.  
  1723. [FUNCTION]
  1724.  
  1725. Function  IsSymbol(                  C         : CHAR    ) : BOOLEAN;
  1726.  
  1727. [PARAMETERS]
  1728.  
  1729. C           Character representing a symbol char
  1730.  
  1731. [RETURNS]
  1732.  
  1733. Whether that character did represent a symbol char
  1734.  
  1735. [DESCRIPTION]
  1736.  
  1737. Tests char to ensure that it is a symbol char and returns the result.
  1738. A border char is defined as all chars excluding the following:
  1739. Numeric, Alphabetic (both upper and lower case), all grammar chars,
  1740. all border chars, all control characters, and all foreign language
  1741. chars.  Basically all misc chars not used by any of the previous tests
  1742. and definitions.
  1743.  
  1744. [SEE-ALSO]
  1745.  
  1746. IsAlpha
  1747. IsNum
  1748. IsAlphaNum
  1749. IsUpCase
  1750. IsLoCase
  1751. IsGrammar
  1752. IsCtrl
  1753. IsBorder
  1754. IsLang
  1755.  
  1756. [EXAMPLE]
  1757.  
  1758. BEGIN
  1759.  
  1760.   WriteLn( IsSymbol( '≤' ) );  { TRUE  }
  1761.   WriteLn( IsSymbol( 'A' ) );  { FALSE }
  1762.   WriteLn( IsSymbol( '6' ) );  { FALSE }
  1763.   WriteLn( IsSymbol( '#' ) );  { FALSE }
  1764.   WriteLn( IsSymbol( '√' ) );  { TRUE  }
  1765.   WriteLn( IsSymbol( '╔' ) );  { FALSE }
  1766.   WriteLn( IsSymbol( '≈' ) );  { TRUE  }
  1767.  
  1768. END;
  1769.  
  1770. -*)
  1771.  
  1772.  
  1773. Function IsSymbol(           C         : CHAR         ) : BOOLEAN;
  1774.  
  1775. BEGIN
  1776.  
  1777.   IsSymbol := ( Byte( C ) <= $1F ) OR
  1778.               ( Byte( C ) >= $E0 );
  1779.  
  1780. END;
  1781.  
  1782. {────────────────────────────────────────────────────────────────────────────}
  1783.  
  1784. (*-
  1785.  
  1786. [FUNCTION]
  1787.  
  1788. Function IntToBase(                  Base      : BYTE;
  1789.                                      Int       : LONGINT    ) : STRING;
  1790.  
  1791. [PARAMETERS]
  1792.  
  1793. Base        Base to convert to
  1794. Int         Decimal integer to convert
  1795.  
  1796. [RETURNS]
  1797.  
  1798. String representation of integer value in the specified base
  1799.  
  1800. [DESCRIPTION]
  1801.  
  1802. Converts a decimal integer into a string representation of the integer
  1803. in the specified base.  Digits are used in the order 0..9..A..Z
  1804.  
  1805. [SEE-ALSO]
  1806.  
  1807. StrToInt
  1808.  
  1809. [EXAMPLE]
  1810.  
  1811. VAR
  1812.   S : STRING;
  1813.  
  1814. BEGIN
  1815.  
  1816.   S := IntToBase( 17, 10 );
  1817.  
  1818.   { S = 17 }
  1819.  
  1820.   S := IntToBase( 2, 7 );
  1821.  
  1822.   { S = 111 }
  1823.  
  1824.   S := IntToBase( 16, 255 );
  1825.  
  1826.   { S = FF }
  1827.  
  1828.   S := IntToBase( 36, 36 );
  1829.  
  1830.   { S = '10' }
  1831.  
  1832.   S := IntToBase( 36, 36*36 );
  1833.  
  1834.   { S = '100' }
  1835.  
  1836.   S := IntToBase( 36, 35 );
  1837.  
  1838.   { S = Z }
  1839.  
  1840.   S := IntToBase( 13, 13+1 );
  1841.  
  1842.   { S = '11' }
  1843.  
  1844.  
  1845.  
  1846. END;
  1847.  
  1848. -*)
  1849.  
  1850.  
  1851. Function IntToBase(                  Base      : BYTE;
  1852.                                      Int       : LONGINT    ) : STRING;
  1853.  
  1854. Const
  1855.  
  1856.   TDecBase : Array[0..36] of Char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  1857.  
  1858. Var
  1859.   S : STRING;
  1860.   T : STRING;
  1861.   Z : INTEGER;
  1862.  
  1863. BEGIN
  1864.   S := '';
  1865.   While Int <> 0 Do
  1866.   BEGIN
  1867.     S   := S + TDecBase[ Int MOD Base ];
  1868.     Int := Int DIV Base;
  1869.   END;
  1870.  
  1871.   T[0] := S[0];
  1872.  
  1873.   For Z := Length( S ) Downto 1 Do
  1874.     T[ Length(S)-Z+1 ] := S[ Z ];
  1875.  
  1876.   IntToBase := T;
  1877.  
  1878. END; { IntToBase }
  1879.  
  1880.  
  1881. {────────────────────────────────────────────────────────────────────────────}
  1882.  
  1883. (*-
  1884.  
  1885. [FUNCTION]
  1886.  
  1887. Function BaseToInt(                  Base      : BYTE;
  1888.                                      S         : STRING     ) : LONGINT;
  1889.  
  1890. [PARAMETERS]
  1891.  
  1892. Base        Base to convert from
  1893. Int         String representation of a value in base "base"
  1894.  
  1895. [RETURNS]
  1896.  
  1897. decimal integer equivalent of "S" from the specified base
  1898.  
  1899. [DESCRIPTION]
  1900.  
  1901. Converts a string representation of a value in the specified base to
  1902. a decimal integer.  Digits are used in the order 0..9..A..Z
  1903.  
  1904. [SEE-ALSO]
  1905.  
  1906. StrToInt
  1907.  
  1908. [EXAMPLE]
  1909.  
  1910. VAR
  1911.   Z : INTEGER;
  1912.  
  1913. BEGIN
  1914.  
  1915.   Z := BaseToInt( 36, '10' );
  1916.  
  1917.   { Z = 36 }
  1918.  
  1919.   Z := BaseToInt( 36, '100' );
  1920.  
  1921.   { Z = 1296 (36*36) }
  1922.  
  1923.   Z := BaseToInt( 13, '11' );
  1924.  
  1925.   { Z = 14 (13+1) }
  1926.  
  1927.  
  1928. END;
  1929.  
  1930. -*)
  1931.  
  1932.  
  1933. Function BaseToInt(                  Base      : BYTE;
  1934.                                      S         : STRING     ) : LONGINT;
  1935.  
  1936. Const
  1937.  
  1938.   TDecBase : Array[0..36] of Char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  1939.  
  1940. Var
  1941.  
  1942.   DigitVal : LONGINT;
  1943.   Z        : INTEGER;
  1944.   Res      : LONGINT;
  1945.  
  1946. BEGIN
  1947.  
  1948.   Digitval := 1;
  1949.   Res      := 0;
  1950.  
  1951.   For Z := Length( S ) Downto 1 Do
  1952.   BEGIN
  1953.  
  1954.     Res := Res + ( (Pos( S[Z], TDecBase )-1) * DigitVal );
  1955.  
  1956.     DigitVal := Digitval * Base;
  1957.  
  1958.   END;
  1959.  
  1960.   BaseToInt := Res;
  1961.  
  1962. END;
  1963.  
  1964.  
  1965. {────────────────────────────────────────────────────────────────────────────}
  1966.  
  1967. (*-
  1968.  
  1969. [FUNCTION]
  1970.  
  1971. Function  BaseToBase(             InBase        : BYTE;
  1972.                                   InVal         : STRING;
  1973.                                   OutBase       : BYTE       ) : STRING;
  1974.  
  1975. [PARAMETERS]
  1976.  
  1977. inBase      Base to convert from
  1978. inval       String representation of a value in base "inbase"
  1979. outBase     Base to convert to
  1980.  
  1981. [RETURNS]
  1982.  
  1983. "inval" converted from original base "inbase" to "outbase"
  1984.  
  1985. [DESCRIPTION]
  1986.  
  1987. Converts a string representation of a value in the specified base "inbase"
  1988. to a string representation of the same value in "outbase".
  1989.  
  1990. [SEE-ALSO]
  1991.  
  1992. StrToInt
  1993.  
  1994. [EXAMPLE]
  1995.  
  1996.  
  1997.    { to convert a hex-based value into a binary value }
  1998.  
  1999.    S := BaseToBase( 16, 'FF', 2 );
  2000.  
  2001.    { S now equals '11111111' }
  2002.  
  2003.  
  2004.  
  2005. -*)
  2006.  
  2007.  
  2008. Function  BaseToBase(             InBase        : BYTE;
  2009.                                   InVal         : STRING;
  2010.                                   OutBase       : BYTE       ) : STRING;
  2011.  
  2012. BEGIN
  2013.  
  2014.   BaseToBase := IntToBase( OutBase, BaseToInt( InBase, InVal ) );
  2015.  
  2016. END;
  2017.  
  2018. {────────────────────────────────────────────────────────────────────────────}
  2019.  
  2020.  
  2021.  
  2022. (*-
  2023.  
  2024. [FUNCTION]
  2025.  
  2026. Function  IntToStr(                  L         : LONGINT ) : STRING;
  2027.  
  2028. [PARAMETERS]
  2029.  
  2030. L           Longint value to convert to string
  2031.  
  2032. [RETURNS]
  2033.  
  2034. String representation of integer value
  2035.  
  2036. [DESCRIPTION]
  2037.  
  2038. Converts an integer value into a string
  2039.  
  2040. [SEE-ALSO]
  2041.  
  2042. StrToInt
  2043.  
  2044. [EXAMPLE]
  2045.  
  2046. VAR
  2047.   S : STRING;
  2048.  
  2049. BEGIN
  2050.  
  2051.   S := IntToStr( 12345 );
  2052.  
  2053.   { S = '12345' }
  2054.  
  2055. END;
  2056.  
  2057. -*)
  2058.  
  2059.  
  2060. Function  IntToStr(                  L         : LONGINT ) : STRING;
  2061.  
  2062. Var
  2063.  
  2064.   Result : STRING;
  2065.  
  2066. BEGIN
  2067.  
  2068.   Str( L, Result );
  2069.  
  2070.   IntToSTr := Result;
  2071.  
  2072. END;
  2073.  
  2074. {────────────────────────────────────────────────────────────────────────────}
  2075.  
  2076. (*-
  2077.  
  2078. [FUNCTION]
  2079.  
  2080. Function  StrToInt(                  S         : STRING  ) : LONGINT;
  2081.  
  2082. [PARAMETERS]
  2083.  
  2084. S           String to convert to integer value
  2085.  
  2086. [RETURNS]
  2087.  
  2088. Integer representation of string.  If Error then result is Zero.
  2089.  
  2090. [DESCRIPTION]
  2091.  
  2092. Converts a string into an integer value.
  2093.  
  2094. [SEE-ALSO]
  2095.  
  2096. IntToStr
  2097.  
  2098. [EXAMPLE]
  2099.  
  2100. VAR
  2101.   L : LONGINT;
  2102.  
  2103. BEGIN
  2104.  
  2105.   L := StrToInt( '4312' );
  2106.  
  2107.   { L = 4312 }
  2108.  
  2109. END;
  2110.  
  2111. -*)
  2112.  
  2113. {----------------------------------------------------------}
  2114. {             Function StrToInt                            }
  2115. {----------------------------------------------------------}
  2116. { IN:  S (STRING) string to convert                        }
  2117. { OUT: (LONGINT) numeric representation of string          }
  2118. { Converts a string to a numeric value                     }
  2119. {----------------------------------------------------------}
  2120.  
  2121. Function  StrToInt(                  S         : STRING  ) : LONGINT;
  2122.  
  2123. Var
  2124.  
  2125.   Error  : INTEGER;
  2126.   Number : LONGINT;
  2127.  
  2128. BEGIN
  2129.  
  2130.   Val( S, Number, Error );
  2131.   StrToInt := Number;
  2132.  
  2133. END;
  2134.  
  2135.  
  2136. {────────────────────────────────────────────────────────────────────────────}
  2137.  
  2138. (*-
  2139.  
  2140. [FUNCTION]
  2141.  
  2142. Function  RealToStr(                 R         : REAL;
  2143.                                      Field     : INTEGER;
  2144.                                      Decimals  : INTEGER  ) : STRING;
  2145.  
  2146. [PARAMETERS]
  2147.  
  2148. R           Floating point value to convert to string
  2149. Field       Desired final width of string
  2150. Decimals    Desired number of decimal places to use in string
  2151.  
  2152. [RETURNS]
  2153.  
  2154. String representation of Floating point value
  2155.  
  2156. [DESCRIPTION]
  2157.  
  2158. Converts a floating point value into a string using the given string
  2159. width and decimal places.
  2160.  
  2161. [SEE-ALSO]
  2162.  
  2163. StrToReal
  2164.  
  2165. [EXAMPLE]
  2166.  
  2167. VAR
  2168.   S : STRING;
  2169.  
  2170. BEGIN
  2171.  
  2172.   S := RealToStr( 1.5, 8, 4 );
  2173.  
  2174.   { S = '  1.5000' }
  2175.  
  2176. END;
  2177.  
  2178. -*)
  2179.  
  2180. Function  RealToStr(                 R         : REAL;
  2181.                                      Field     : INTEGER;
  2182.                                      Decimals  : INTEGER  ) : STRING;
  2183.  
  2184. Var
  2185.  
  2186.   Result: STRING;
  2187.  
  2188. BEGIN
  2189.  
  2190.   Str( R : Field : Decimals, Result );
  2191.  
  2192.   RealToStr := Result;
  2193.  
  2194. END;   { Of RealToStr }
  2195.  
  2196. {────────────────────────────────────────────────────────────────────────────}
  2197.  
  2198. (*-
  2199.  
  2200. [FUNCTION]
  2201.  
  2202. Function  StrToReal(                 S         : STRING  ) : REAL;
  2203.  
  2204. [PARAMETERS]
  2205.  
  2206. S           String to convert to a floating point value
  2207.  
  2208. [RETURNS]
  2209.  
  2210. Floating point representation of string.
  2211.  
  2212. [DESCRIPTION]
  2213.  
  2214. Converts a string into a floating point value.
  2215. If Error then result is Zero.
  2216.  
  2217. NOTE: This Function does NOT take care of Leading or Trailing
  2218. Spaces or other Symbols.  This MUST be taken care of by the
  2219. caller.  All data must be prepared for immediate use.
  2220.  
  2221. [SEE-ALSO]
  2222.  
  2223. RealToStr
  2224.  
  2225. [EXAMPLE]
  2226.  
  2227. VAR
  2228.   R : REAL;
  2229.  
  2230. BEGIN
  2231.  
  2232.   R := StrToReal( '1.5' );
  2233.  
  2234.   { R = 1.5 }
  2235.  
  2236. END;
  2237.  
  2238. -*)
  2239.  
  2240.  
  2241. Function  StrToReal(                 S         : STRING  ) : REAL;
  2242.  
  2243. Var
  2244.  
  2245.   R     : REAL;
  2246.   Error : INTEGER;
  2247.  
  2248. BEGIN
  2249.  
  2250.   Val( S, R, Error );
  2251.  
  2252.   StrToReal := R;
  2253.  
  2254. END;   { Of StrToReal }
  2255.  
  2256. {────────────────────────────────────────────────────────────────────────────}
  2257.  
  2258. (*-
  2259.  
  2260. [FUNCTION]
  2261.  
  2262. Function  SciToStr(                  R         : REAL    ) : STRING;
  2263.  
  2264. [PARAMETERS]
  2265.  
  2266. S           Floating point value to convert to string in scientific notation
  2267.  
  2268. [RETURNS]
  2269.  
  2270. String representation of floating point value using scientific notation
  2271.  
  2272. [DESCRIPTION]
  2273.  
  2274. Converts a floating point value into a string using scientific notation.
  2275.  
  2276. [SEE-ALSO]
  2277.  
  2278. StrToSci
  2279.  
  2280. [EXAMPLE]
  2281.  
  2282. VAR
  2283.   R : REAL;
  2284.   S : STRING;
  2285.  
  2286. BEGIN
  2287.  
  2288.   R := 1.25E2;  { 125 }
  2289.   S := SciToStr( R );
  2290.  
  2291.   { S = '1.25E2' }
  2292.  
  2293. END;
  2294.  
  2295. -*)
  2296.  
  2297.  
  2298. Function  SciToStr(                  R         : REAL    ) : STRING;
  2299.  
  2300. Var
  2301.  
  2302.   S : STRING;
  2303.  
  2304. BEGIN
  2305.  
  2306.   Str( R, S );
  2307.   SciToStr := S;
  2308.  
  2309. END;
  2310.  
  2311. {────────────────────────────────────────────────────────────────────────────}
  2312.  
  2313. (*-
  2314.  
  2315. [FUNCTION]
  2316.  
  2317. Function  StrToSci(                  S         : STRING  ) : REAL;
  2318.  
  2319. [PARAMETERS]
  2320.  
  2321. S           String in scientific notation to convert to floating point value
  2322.  
  2323. [RETURNS]
  2324.  
  2325. Floating point representation of string.  If Error then result is Zero.
  2326.  
  2327. [DESCRIPTION]
  2328.  
  2329. Converts string of scientific notatation value to a floating point value.
  2330. If Error then floating point is Zero.
  2331.  
  2332. [SEE-ALSO]
  2333.  
  2334. SciToStr
  2335.  
  2336. [EXAMPLE]
  2337.  
  2338. VAR
  2339.   R : REAL;
  2340.  
  2341. BEGIN
  2342.  
  2343.   R := StrToSci( '1.25E2' );
  2344.  
  2345.   { R = 1.25E2 or 125 }
  2346.  
  2347. END;
  2348.  
  2349. -*)
  2350.  
  2351.  
  2352. Function  StrToSci(                  S         : STRING  ) : REAL;
  2353.  
  2354. Var
  2355.  
  2356.   R : REAL;
  2357.   I : INTEGER;
  2358.  
  2359. BEGIN
  2360.  
  2361.   Val( S, R, I );
  2362.   StrToSci := R;
  2363.  
  2364. END;
  2365.  
  2366. {────────────────────────────────────────────────────────────────────────────}
  2367.  
  2368. (*-
  2369.  
  2370. [FUNCTION]
  2371.  
  2372. Function  IntToText(                 L         : LONGINT ) : ST80;
  2373.  
  2374. [PARAMETERS]
  2375.  
  2376. L           Integer value to convert to text string
  2377.  
  2378. [RETURNS]
  2379.  
  2380. Text String representation of integer value.
  2381.  
  2382. [DESCRIPTION]
  2383.  
  2384. Converts integer value into text form.  Handles all values into the
  2385. Billions.  The limiting factor is that the returned string is only
  2386. 80 chars long and thus will clip any further text.
  2387.  
  2388. [SEE-ALSO]
  2389.  
  2390.  
  2391. [EXAMPLE]
  2392.  
  2393. VAR
  2394.   S : STRING;
  2395.  
  2396. BEGIN
  2397.  
  2398.   S := IntToText( 10 );
  2399.   { S now equals "Ten" }
  2400.  
  2401.   S := IntToText( 1,234,000 );
  2402.  
  2403.   { S equals "One Million, Two Hundred Thirty Four Thousand" }
  2404.  
  2405. -*)
  2406.  
  2407.  
  2408. Function  IntToText(                 L         : LONGINT  ) : ST80;
  2409.  
  2410. Var
  2411.  
  2412.   S,ST,
  2413.   S1,S2,S3 : STRING;
  2414.   Thousand,
  2415.   x,y,z    : INTEGER;
  2416.   Neg      : BOOLEAN;
  2417.  
  2418. BEGIN
  2419.  
  2420.   S        := '';
  2421.   ST       := '';
  2422.   Thousand := 0;
  2423.  
  2424.   Neg := FALSE;
  2425.  
  2426.   If ( L < 0 ) Then
  2427.   BEGIN
  2428.  
  2429.     Neg := TRUE;
  2430.     L   := L * -1;
  2431.  
  2432.   END;
  2433.  
  2434.   Repeat
  2435.  
  2436.     x :=   L MOD 10;
  2437.     y := ( L MOD 100 )  DIV 10;
  2438.     z := ( L MOD 1000 ) DIV 100;
  2439.  
  2440.     S1 := '';
  2441.     S2 := '';
  2442.     S3 := '';
  2443.  
  2444.     Case z Of
  2445.       1 : S1 := 'One';
  2446.       2 : S1 := 'Two';
  2447.       3 : S1 := 'Three';
  2448.       4 : S1 := 'Four';
  2449.       5 : S1 := 'Five';
  2450.       6 : S1 := 'Six';
  2451.       7 : S1 := 'Seven';
  2452.       8 : S1 := 'Eight';
  2453.       9 : S1 := 'Nine';
  2454.     END;
  2455.  
  2456.     If (y = 1) Then
  2457.     BEGIN
  2458.  
  2459.       Case x Of
  2460.         0 : S2 := 'Ten';
  2461.         1 : S2 := 'Eleven';
  2462.         2 : S2 := 'Twelve';
  2463.         3 : S2 := 'Thirteen';
  2464.         4 : S2 := 'Fourteen';
  2465.         5 : S2 := 'Fifteen';
  2466.         6 : S2 := 'Sixteen';
  2467.         7 : S2 := 'Seventeen';
  2468.         8 : S2 := 'Eighteen';
  2469.         9 : S2 := 'Nineteen';
  2470.       END;
  2471.  
  2472.     END
  2473.     Else
  2474.     BEGIN
  2475.  
  2476.       Case x Of
  2477.         1 : S3 := 'One';
  2478.         2 : S3 := 'Two';
  2479.         3 : S3 := 'Three';
  2480.         4 : S3 := 'Four';
  2481.         5 : S3 := 'Five';
  2482.         6 : S3 := 'Six';
  2483.         7 : S3 := 'Seven';
  2484.         8 : S3 := 'Eight';
  2485.         9 : S3 := 'Nine';
  2486.       END;
  2487.  
  2488.       Case y Of
  2489.         2 : S2 := 'Twenty';
  2490.         3 : S2 := 'Thirty';
  2491.         4 : S2 := 'Forty';
  2492.         5 : S2 := 'Fifty';
  2493.         6 : S2 := 'Sixty';
  2494.         7 : S2 := 'Seventy';
  2495.         8 : S2 := 'Eighty';
  2496.         9 : S2 := 'Ninety';
  2497.       END;
  2498.  
  2499.     END;
  2500.  
  2501.     If ( S1 <> '' ) Then
  2502.       ST := S1 + ' Hundred'
  2503.     Else
  2504.       ST := '';
  2505.  
  2506.     If ( S2 <> '' ) Then
  2507.     BEGIN
  2508.  
  2509.       If ( ST <> '' ) Then
  2510.         ST := ST + ' ' + S2
  2511.       Else
  2512.         ST := S2;
  2513.  
  2514.     END;
  2515.  
  2516.     If ( S3 <> '' ) Then
  2517.     BEGIN
  2518.  
  2519.       If ( ST <> '' ) Then
  2520.         ST := ST + ' ' + S3
  2521.       Else
  2522.         ST := S3;
  2523.  
  2524.     END;
  2525.  
  2526.     If ( ST <> '' ) Then
  2527.     BEGIN
  2528.  
  2529.       Case Thousand Of
  2530.         0 : ST := ST;
  2531.         1 : ST := ST + ' Thousand';
  2532.         2 : ST := ST + ' Million';
  2533.         3 : ST := ST + ' Billion';
  2534.       END;
  2535.  
  2536.       If ( S <> '' ) Then
  2537.         S := ST + ', ' + S
  2538.       Else
  2539.         S := ST;
  2540.  
  2541.     END;
  2542.  
  2543.     L := L DIV 1000;
  2544.     Inc(Thousand);
  2545.  
  2546.   Until L = 0;
  2547.  
  2548.   If ( S = '' ) Then
  2549.     S := 'Zero'
  2550.   Else
  2551.     If Neg Then
  2552.       S := 'Negative ' + S;
  2553.  
  2554.   IntToText := S;
  2555.  
  2556. END;   { Of IntToText }
  2557.  
  2558. {────────────────────────────────────────────────────────────────────────────}
  2559.  
  2560. (*-
  2561.  
  2562. [FUNCTION]
  2563.  
  2564. Function  LongToDollars(             L         : LONGINT ) : REAL;
  2565.  
  2566. [PARAMETERS]
  2567.  
  2568. L           Currency Value in Cents
  2569.  
  2570. [RETURNS]
  2571.  
  2572. Currency Value in Dollars.  (Pennies now represented as fractions)
  2573.  
  2574. [DESCRIPTION]
  2575.  
  2576. Converts an integer penny amount into a floating point dollar amount
  2577.  
  2578. [SEE-ALSO]
  2579.  
  2580. DollarsToLong
  2581.  
  2582. [EXAMPLE]
  2583.  
  2584. VAR
  2585.   R : REAL;
  2586.  
  2587. BEGIN
  2588.  
  2589.   R := LongToDollars( 12500 );
  2590.  
  2591.   { R = 125.00 }
  2592.  
  2593. END;
  2594.  
  2595. -*)
  2596.  
  2597.  
  2598. Function  LongToDollars(             L         : LONGINT  ) : REAL;
  2599.  
  2600. Var
  2601.  
  2602.   R : REAL;
  2603.  
  2604. BEGIN
  2605.  
  2606.   R             := L;
  2607.   LongToDollars := R * 0.01;
  2608.  
  2609. END;
  2610.  
  2611. {────────────────────────────────────────────────────────────────────────────}
  2612.  
  2613. (*-
  2614.  
  2615. [FUNCTION]
  2616.  
  2617. Function  DollarsToLong(             R         : REAL    ) : LONGINT;
  2618.  
  2619. [PARAMETERS]
  2620.  
  2621. R           Currency Value in Dollars
  2622.  
  2623. [RETURNS]
  2624.  
  2625. Currency Value in Cents.  (Dollars now represented as 100 Pennies)
  2626.  
  2627. [DESCRIPTION]
  2628.  
  2629. Converts a floating point dollar amount into an integer penny amount
  2630.  
  2631. [SEE-ALSO]
  2632.  
  2633. LongToDollars
  2634.  
  2635. [EXAMPLE]
  2636.  
  2637. VAR
  2638.   L : LONGINT;
  2639.  
  2640. BEGIN
  2641.  
  2642.   L := DollarsToLong( 125.00 );
  2643.  
  2644.   { L = 12500 }
  2645.  
  2646. END;
  2647.  
  2648. -*)
  2649.  
  2650.  
  2651. Function  DollarsToLong(             R         : REAL    ) : LONGINT;
  2652.  
  2653. BEGIN
  2654.  
  2655.   DollarsToLong := Round( R * 100.0 );
  2656.  
  2657. END;
  2658.  
  2659. {────────────────────────────────────────────────────────────────────────────}
  2660.  
  2661. (*-
  2662.  
  2663. [FUNCTION]
  2664.  
  2665. Function  BoolToStr(              Bool          : BOOLEAN;
  2666.                                   TrueStr       : STRING;
  2667.                                   FalseStr      : STRING        ) : STRING;
  2668.  
  2669. [PARAMETERS]
  2670.  
  2671. Bool        boolean value to test
  2672. TrueStr     String to return if "bool" is TRUE
  2673. FalseStr    String to return if "bool" is false
  2674.  
  2675. [RETURNS]
  2676.  
  2677. Boolean as a string (either "TrueStr" or "FalseStr")
  2678.  
  2679. [DESCRIPTION]
  2680.  
  2681. This function converts the boolean value to a string.  If "Bool" is
  2682. true, the function will return "TrueStr".  If Bool is false, the
  2683. functionwill return "FalseStr".
  2684.  
  2685. [SEE-ALSO]
  2686.  
  2687. BoolToYN
  2688. BoolToOnOff
  2689.  
  2690. [EXAMPLE]
  2691.  
  2692.   WriteLN( BoolToStr( TRUE, 'On', 'Off' );
  2693.  
  2694. END;
  2695.  
  2696. -*)
  2697.  
  2698.  
  2699. Function  BoolToStr(              Bool          : BOOLEAN;
  2700.                                   TrueStr       : STRING;
  2701.                                   FalseStr      : STRING        ) : STRING;
  2702.  
  2703.  
  2704. BEGIN
  2705.  
  2706.  If Bool=TRUE Then
  2707.    BoolToStr := TrueStr
  2708.  Else
  2709.    BoolToStr := FalseStr;
  2710.  
  2711. END;
  2712.  
  2713. {────────────────────────────────────────────────────────────────────────────}
  2714.  
  2715. (*-
  2716.  
  2717. [FUNCTION]
  2718.  
  2719. Function BoolToYN(                Bool          : BOOLEAN       ) : STRING;
  2720.  
  2721. [PARAMETERS]
  2722.  
  2723. Bool        boolean value to test
  2724.  
  2725. [RETURNS]
  2726.  
  2727. Boolean as a string (either "Yes" or "No")
  2728.  
  2729. [DESCRIPTION]
  2730.  
  2731. This function converts the boolean value to a string.  If "Bool" is
  2732. true, the function will return "Yes".  If Bool is false, the
  2733. functionwill return "No".
  2734.  
  2735. [SEE-ALSO]
  2736.  
  2737. BoolToStr
  2738. BoolToOnOff
  2739.  
  2740. [EXAMPLE]
  2741.  
  2742.   WriteLN( BoolToYN( TRUE ) );
  2743.  
  2744. END;
  2745.  
  2746. -*)
  2747.  
  2748.  
  2749. Function BoolToYN(                Bool          : BOOLEAN       ) : STRING;
  2750.  
  2751. BEGIN
  2752.  
  2753.   If Bool=TRUE Then
  2754.     BoolToYN := 'Yes'
  2755.   Else
  2756.     BoolToYn := 'No';
  2757.  
  2758. END;
  2759.  
  2760. {────────────────────────────────────────────────────────────────────────────}
  2761.  
  2762.  
  2763. (*-
  2764.  
  2765. [FUNCTION]
  2766.  
  2767. Function BoolToOnOff(             Bool          : BOOLEAN       ) : STRING;
  2768.  
  2769. [PARAMETERS]
  2770.  
  2771. Bool        boolean value to test
  2772.  
  2773. [RETURNS]
  2774.  
  2775. Boolean as a string (either "On" or "Off")
  2776.  
  2777. [DESCRIPTION]
  2778.  
  2779. This function converts the boolean value to a string.  If "Bool" is
  2780. true, the function will return "On".  If Bool is false, the
  2781. functionwill return "Off".
  2782.  
  2783. [SEE-ALSO]
  2784.  
  2785. BoolToStr
  2786. BoolToOnOff
  2787.  
  2788. [EXAMPLE]
  2789.  
  2790.   WriteLN( BoolToOnOff( TRUE ) );
  2791.  
  2792. END;
  2793.  
  2794. -*)
  2795.  
  2796. Function BoolToOnOff(             Bool          : BOOLEAN       ) : STRING;
  2797.  
  2798. BEGIN
  2799.  
  2800.   If Bool=TRUE Then
  2801.     BoolToOnOff:= 'On'
  2802.   Else
  2803.     BoolToOnOff := 'Off';
  2804.  
  2805. END;
  2806.  
  2807.  
  2808. {────────────────────────────────────────────────────────────────────────────}
  2809.  
  2810.  
  2811. Function  IntToBigNum(            L             : LONGINT       ) : STRING;
  2812.  
  2813. BEGIN
  2814.  
  2815.   IntToBigNum := IntToBase( 36, L );
  2816.  
  2817. END;
  2818.  
  2819.  
  2820. {────────────────────────────────────────────────────────────────────────────}
  2821.  
  2822.  
  2823. Function  BigNumToInt(            S             : STRING        ) : LONGINT;
  2824.  
  2825.  
  2826. BEGIN
  2827.  
  2828.   BigNumToInt := BaseToInt( 36, S );
  2829.  
  2830. END;
  2831.  
  2832.  
  2833. {────────────────────────────────────────────────────────────────────────────}
  2834.  
  2835. (*-
  2836.  
  2837. [FUNCTION]
  2838.  
  2839. Function  CharToHex(                 C         : SHORTINT) : ST80;
  2840.  
  2841. [PARAMETERS]
  2842.  
  2843. C           Signed Byte (SHORTINT) value to convert to a hex string
  2844.  
  2845. [RETURNS]
  2846.  
  2847. Hex string representation of signed byte value
  2848.  
  2849. [DESCRIPTION]
  2850.  
  2851. Converts a Signed Byte (Shortint) value into a hexadecimal string
  2852.  
  2853. [SEE-ALSO]
  2854.  
  2855. ByteToHex
  2856. IntToHex
  2857. WordToHex
  2858. PtrToHex
  2859. LongToHex
  2860. HexToChar
  2861. HexToByte
  2862. HexToInt
  2863. HexToWord
  2864. HexToLong
  2865.  
  2866. [EXAMPLE]
  2867.  
  2868. VAR
  2869.   S : STRING;
  2870.  
  2871. BEGIN
  2872.  
  2873.   S := CharToHex( #32 );
  2874.  
  2875.   { S = '20' (Hex of 32) }
  2876.  
  2877. END;
  2878.  
  2879. -*)
  2880.  
  2881.  
  2882. Function  CharToHex(                 C         : SHORTINT ) : ST80;
  2883.  
  2884. Var
  2885.  
  2886.   S : ST80;
  2887.  
  2888. BEGIN
  2889.  
  2890.   CharToHex := TDecHex[ ( C AND $F0 ) SHR 4 ] + TDecHex[ C AND $0F ];
  2891.  
  2892. END;
  2893.  
  2894. {────────────────────────────────────────────────────────────────────────────}
  2895.  
  2896. (*-
  2897.  
  2898. [FUNCTION]
  2899.  
  2900. Function  ByteToHex(                 B         : BYTE    ) : ST80;
  2901.  
  2902. [PARAMETERS]
  2903.  
  2904. B           Unsigned Byte value to convert to a hex string
  2905.  
  2906. [RETURNS]
  2907.  
  2908. Hex string representation of byte value
  2909.  
  2910. [DESCRIPTION]
  2911.  
  2912. Converts an Unsigned Byte Value into a Hexadecimal String
  2913.  
  2914. [SEE-ALSO]
  2915.  
  2916. CharToHex
  2917. IntToHex
  2918. WordToHex
  2919. PtrToHex
  2920. LongToHex
  2921. HexToChar
  2922. HexToByte
  2923. HexToInt
  2924. HexToWord
  2925. HexToLong
  2926.  
  2927. [EXAMPLE]
  2928.  
  2929. VAR
  2930.   S : STRING;
  2931.  
  2932. BEGIN
  2933.  
  2934.   S := ByteToHex( #32 );
  2935.  
  2936.   { S = '20' (Hex of 32) }
  2937.  
  2938. END;
  2939.  
  2940. -*)
  2941.  
  2942.  
  2943. Function  ByteToHex(                 B         : BYTE     ) : ST80;
  2944.  
  2945. BEGIN
  2946.  
  2947.   ByteToHex := TDecHex[(B AND $F0) SHR 4] + TDecHex[B AND $0F];
  2948.  
  2949. END;
  2950.  
  2951. {────────────────────────────────────────────────────────────────────────────}
  2952.  
  2953. (*-
  2954.  
  2955. [FUNCTION]
  2956.  
  2957. Function  IntToHex(                  I         : INTEGER ) : ST80;
  2958.  
  2959. [PARAMETERS]
  2960.  
  2961. I           Signed Word (INTEGER) value to convert to a hex string
  2962.  
  2963. [RETURNS]
  2964.  
  2965. Hex string representation of signed word value
  2966.  
  2967. [DESCRIPTION]
  2968.  
  2969. Converts a Signed Word (INTEGER) value into a hexadecimal string
  2970.  
  2971. [SEE-ALSO]
  2972.  
  2973. CharToHex
  2974. ByteToHex
  2975. WordToHex
  2976. PtrToHex
  2977. LongToHex
  2978. HexToChar
  2979. HexToByte
  2980. HexToInt
  2981. HexToWord
  2982. HexToLong
  2983.  
  2984. [EXAMPLE]
  2985.  
  2986. VAR
  2987.   S : STRING;
  2988.  
  2989. BEGIN
  2990.  
  2991.   S := IntToHex( -32000 );
  2992.  
  2993.   { S = '8300' }
  2994.  
  2995. END;
  2996.  
  2997. -*)
  2998.  
  2999.  
  3000. Function  IntToHex(                  I         : INTEGER  ) : ST80;
  3001.  
  3002. BEGIN
  3003.  
  3004.   IntToHex := CharToHex( I SHR 8 ) + ByteToHex( I AND $FF );
  3005.  
  3006. END;
  3007.  
  3008. {────────────────────────────────────────────────────────────────────────────}
  3009.  
  3010. (*-
  3011.  
  3012. [FUNCTION]
  3013.  
  3014. Function  WordToHex(                 W         : WORD    ) : ST80;
  3015.  
  3016. [PARAMETERS]
  3017.  
  3018. W           Unsigned Word to convert to a hex string
  3019.  
  3020. [RETURNS]
  3021.  
  3022. Hex string representation of word value
  3023.  
  3024. [DESCRIPTION]
  3025.  
  3026. Converts an Unsigned Word into a hexadecimal string
  3027.  
  3028. [SEE-ALSO]
  3029.  
  3030. CharToHex
  3031. ByteToHex
  3032. IntToHex
  3033. PtrToHex
  3034. LongToHex
  3035. HexToChar
  3036. HexToByte
  3037. HexToInt
  3038. HexToWord
  3039. HexToLong
  3040.  
  3041. [EXAMPLE]
  3042.  
  3043. VAR
  3044.   S : STRING;
  3045.  
  3046. BEGIN
  3047.  
  3048.   S := WordToHex( 50000 );
  3049.  
  3050.   { S = 'C350' }
  3051.  
  3052. END;
  3053.  
  3054. -*)
  3055.  
  3056.  
  3057. Function  WordToHex(                 W         : WORD     ) : ST80;
  3058.  
  3059. BEGIN
  3060.  
  3061.   WordTohex := ByteToHex( W SHR 8 ) + ByteToHex( W AND $FF );
  3062.  
  3063. END;
  3064.  
  3065. {────────────────────────────────────────────────────────────────────────────}
  3066.  
  3067. (*-
  3068.  
  3069. [FUNCTION]
  3070.  
  3071. Function  PtrToHex(                  P         : POINTER ) : ST80;
  3072.  
  3073. [PARAMETERS]
  3074.  
  3075. P           Pointer to convert to a hex string
  3076.  
  3077. [RETURNS]
  3078.  
  3079. Hex string representation of pointer value
  3080.  
  3081. [DESCRIPTION]
  3082.  
  3083. Converts a Pointer into a hexadecimal string (both segment and offset)
  3084.  
  3085. [SEE-ALSO]
  3086.  
  3087. CharToHex
  3088. ByteToHex
  3089. IntToHex
  3090. WordToHex
  3091. LongToHex
  3092. HexToChar
  3093. HexToByte
  3094. HexToInt
  3095. HexToWord
  3096. HexToLong
  3097.  
  3098. [EXAMPLE]
  3099.  
  3100. VAR
  3101.   P : POINTER;
  3102.   S : STRING;
  3103.  
  3104. BEGIN
  3105.  
  3106.   P := Ptr($A000,0);
  3107.   S := PtrToHex( P );
  3108.  
  3109.   { S = 'A000:0000' }
  3110.  
  3111. END;
  3112. -*)
  3113.  
  3114. {----------------------------------------------------------}
  3115. {             Function PtrToHex                            }
  3116. {----------------------------------------------------------}
  3117. { IN:  P (POINTER) pointer to value                        }
  3118. { OUT: (ST80) hex string                                   }
  3119. { Converts value pointed to into a hex string              }
  3120. {----------------------------------------------------------}
  3121.  
  3122. Function  PtrToHex(                  P         : POINTER  ) : ST80;
  3123.  
  3124. BEGIN
  3125.  
  3126.   PtrToHex := WordToHex( Seg(P^) ) + ':' + WordToHex( Ofs(P^) );
  3127.  
  3128. END;
  3129.  
  3130. {────────────────────────────────────────────────────────────────────────────}
  3131.  
  3132. (*-
  3133.  
  3134. [FUNCTION]
  3135.  
  3136. Function  LongToHex(                 L         : LONGINT ) : ST80;
  3137.  
  3138. [PARAMETERS]
  3139.  
  3140. L           Signed Double Word (LONGINT) Value to convert to a hex string
  3141.  
  3142. [RETURNS]
  3143.  
  3144. Hex string representation of Longint value
  3145.  
  3146. [DESCRIPTION]
  3147.  
  3148. Converts a Signed Double Word (LONGINT) into a hexadecimal string
  3149.  
  3150. [SEE-ALSO]
  3151.  
  3152. CharToHex
  3153. ByteToHex
  3154. IntToHex
  3155. WordToHex
  3156. PtrToHex
  3157. HexToChar
  3158. HexToByte
  3159. HexToInt
  3160. HexToWord
  3161. HexToLong
  3162.  
  3163. [EXAMPLE]
  3164.  
  3165. VAR
  3166.   S : STRING;
  3167.  
  3168. BEGIN
  3169.  
  3170.   S := LongToHex( 123456789 );
  3171.  
  3172.   { S = '075BCD15' }
  3173.  
  3174. END;
  3175.  
  3176. -*)
  3177.  
  3178.  
  3179. Function  LongToHex(                 L         : LONGINT  ) : ST80;
  3180.  
  3181. BEGIN
  3182.  
  3183.   LongToHex := IntToHex( L SHR 16 ) + WordToHex( L AND $FFFF );
  3184.  
  3185. END;
  3186.  
  3187. {────────────────────────────────────────────────────────────────────────────}
  3188.  
  3189. (*-
  3190.  
  3191. [FUNCTION]
  3192.  
  3193. Function DecToHexStr(                S         : STRING   ) : STRING;
  3194.  
  3195. [PARAMETERS]
  3196.  
  3197. S           Decimal Value in String Format
  3198.  
  3199. [RETURNS]
  3200.  
  3201. Hexidecimal Value String
  3202.  
  3203. [DESCRIPTION]
  3204.  
  3205. Converts a Decimal Value String into a Hexidecimal Value String.
  3206. The Result is 8 Characters Long.  The Caller must strip the any
  3207. Leading Zeros to the desired size.
  3208.  
  3209. [SEE-ALSO]
  3210.  
  3211. CharToHex
  3212. ByteToHex
  3213. IntToHex
  3214. WordToHex
  3215. PtrToHex
  3216. HexToChar
  3217. HexToByte
  3218. HexToInt
  3219. HexToWord
  3220. HexToLong
  3221. HexToDecStr
  3222.  
  3223. [EXAMPLE]
  3224.  
  3225. VAR
  3226.   S : STRING;
  3227.  
  3228. BEGIN
  3229.  
  3230.   S := '1234';
  3231.   S := DecToHexStr( S );
  3232.  
  3233.   { S = '000004D2' - Caller Must Strip Leading Zeros if desired }
  3234.  
  3235. END;
  3236.  
  3237. -*)
  3238.  
  3239. Function DecToHexStr(                S         : STRING   ) : STRING;
  3240.  
  3241. BEGIN
  3242.  
  3243.   DecToHexStr := LongToHex( StrToInt( S ) );
  3244.  
  3245. END;
  3246.  
  3247. (*
  3248. Var
  3249.  
  3250.   Index     : WORD;
  3251.   NextIndex : WORD;
  3252.   Count     : WORD;
  3253.   L1        : BYTE;
  3254.   L2        : BYTE;
  3255.  
  3256.   S2        : STRING;
  3257.   Result    : LONGINT;
  3258.   ResultHex : STRING;
  3259.  
  3260. BEGIN
  3261.  
  3262.   NextIndex := 1;
  3263.   Index := NextIndex;
  3264.  
  3265.   REPEAT
  3266.  
  3267.     While ( Index <= Byte(S[0]) ) AND
  3268.           ( NOT IsNum(S[Index]) ) Do
  3269.       Inc( Index );
  3270.  
  3271.     If Index <= Byte(S[0]) Then
  3272.     BEGIN
  3273.  
  3274.       Count := Index;
  3275.       While ( Count < Byte(S[0]) ) AND
  3276.             ( IsNum(S[Succ(Count)]) ) Do
  3277.         Inc( Count );
  3278.  
  3279.       NextIndex := Succ(Count);
  3280.  
  3281.       {------------------------------------------------}
  3282.       { Perform conversion between Index and NextIndex }
  3283.       {------------------------------------------------}
  3284.  
  3285.       S2 := CopyStr( S, Index, NextIndex - Index );
  3286.  
  3287.       Result    := StrToInt( S2 );
  3288.       ResultHex := LongToHex( Result );
  3289.  
  3290.       While ( Byte(ResultHex[0]) > 1 ) AND
  3291.             ( ResultHex[1] = '0' ) Do
  3292.         Delete( ResultHex, 1, 1 );
  3293.  
  3294.       Delete( S, Index, NextIndex - Index );
  3295.       Insert( ResultHex, S, Index );
  3296.  
  3297.       {-----}
  3298.  
  3299.       Inc( Index, Byte(ResultHex[0]) );
  3300.  
  3301.     END;
  3302.  
  3303.   UNTIL (Index > Byte(S[0]));
  3304.  
  3305.   DecToHexStr := S;
  3306.  
  3307. END;
  3308. *)
  3309.  
  3310. {────────────────────────────────────────────────────────────────────────────}
  3311.  
  3312. (*-
  3313.  
  3314. [FUNCTION]
  3315.  
  3316. Function HexToDecStr(                S         : STRING   ) : STRING;
  3317.  
  3318. [PARAMETERS]
  3319.  
  3320. S           Hexadecimal Value in String Format
  3321.  
  3322. [RETURNS]
  3323.  
  3324. Decimal Value String
  3325.  
  3326. [DESCRIPTION]
  3327.  
  3328. Converts a Hexadecimal Value String into a Decimal Longint Value String.
  3329.  
  3330. [SEE-ALSO]
  3331.  
  3332. CharToHex
  3333. ByteToHex
  3334. IntToHex
  3335. WordToHex
  3336. PtrToHex
  3337. HexToChar
  3338. HexToByte
  3339. HexToInt
  3340. HexToWord
  3341. HexToLong
  3342. DecToHexStr
  3343.  
  3344. [EXAMPLE]
  3345.  
  3346. VAR
  3347.   S : STRING;
  3348.  
  3349. BEGIN
  3350.  
  3351.   S := '04D2';
  3352.   S := HexToDecStr( S );
  3353.  
  3354.   { S = '1234', Caller must Strip to Size Desired }
  3355.  
  3356. END;
  3357.  
  3358. -*)
  3359.  
  3360. Function HexToDecStr(                S         : STRING   ) : STRING;
  3361.  
  3362. BEGIN
  3363.  
  3364.   HexToDecStr := IntToStr( HexToLong( S ) );
  3365.  
  3366. END;
  3367.  
  3368. {────────────────────────────────────────────────────────────────────────────}
  3369.  
  3370. (*-
  3371.  
  3372. [FUNCTION]
  3373.  
  3374. Function  HexToChar(                 S         : ST80    ) : SHORTINT;
  3375.  
  3376. [PARAMETERS]
  3377.  
  3378. S           String representation of signed byte hex value
  3379.  
  3380. [RETURNS]
  3381.  
  3382. Signed byte value represented by hex string
  3383.  
  3384. [DESCRIPTION]
  3385.  
  3386. Converts a hexadecimal string representation of a signed byte into
  3387. a signed byte value.  If Error then value is Zero.
  3388.  
  3389. [SEE-ALSO]
  3390.  
  3391. CharToHex
  3392. ByteToHex
  3393. IntToHex
  3394. WordToHex
  3395. PtrToHex
  3396. LongToHex
  3397. HexToByte
  3398. HexToInt
  3399. HexToWord
  3400. HexToLong
  3401.  
  3402. [EXAMPLE]
  3403.  
  3404. VAR
  3405.   I : SHORTINT;
  3406.  
  3407. BEGIN
  3408.  
  3409.   I := HexToChar( '80' );
  3410.  
  3411.   { I = -128 }
  3412.  
  3413. END;
  3414.  
  3415. -*)
  3416.  
  3417.  
  3418. Function  HexToChar(                 S         : ST80    ) : SHORTINT;
  3419.  
  3420. Var
  3421.  
  3422.   I : INTEGER;
  3423.   B : SHORTINT;
  3424.  
  3425. BEGIN
  3426.  
  3427.   While Byte( S[0] ) < 2 Do
  3428.     S := '0' + S;
  3429.  
  3430.   S[1] := UpCase( S[1] );
  3431.   S[2] := UpCase( S[2] );
  3432.  
  3433.   I := 0;
  3434.  
  3435.   While ( S[2] <> TDecHex[I] ) AND ( I < 16 ) Do
  3436.     Inc(I);
  3437.  
  3438.   If ( I > 15 ) Then
  3439.     I := 0;
  3440.  
  3441.   B := I;
  3442.   I := 0;
  3443.  
  3444.   While ( S[1] <> TDecHex[I] ) AND ( I < 16 ) Do
  3445.     Inc(I);
  3446.  
  3447.   If ( I > 15 ) Then
  3448.     I := 0;
  3449.  
  3450.   B := ( I SHL 4 ) + B;
  3451.   HexToChar := B;
  3452.  
  3453. END;
  3454.  
  3455. {────────────────────────────────────────────────────────────────────────────}
  3456.  
  3457. (*-
  3458.  
  3459. [FUNCTION]
  3460.  
  3461. Function  HexToByte(                 S         : ST80    ) : BYTE;
  3462.  
  3463. [PARAMETERS]
  3464.  
  3465. S           String representation of byte hex value
  3466.  
  3467. [RETURNS]
  3468.  
  3469. Byte represented by hex string.
  3470.  
  3471. [DESCRIPTION]
  3472.  
  3473. Converts a hexadecimal string representation of a byte into a byte value.
  3474. If Error then value is Zero.
  3475.  
  3476. [SEE-ALSO]
  3477.  
  3478. CharToHex
  3479. ByteToHex
  3480. IntToHex
  3481. WordToHex
  3482. PtrToHex
  3483. LongToHex
  3484. HexToChar
  3485. HexToInt
  3486. HexToWord
  3487. HexToLong
  3488.  
  3489. [EXAMPLE]
  3490.  
  3491. VAR
  3492.   B : BYTE;
  3493.  
  3494. BEGIN
  3495.  
  3496.   B := HexToByte( '80' );
  3497.  
  3498.   { B = 128 }
  3499.  
  3500. END;
  3501.  
  3502. -*)
  3503.  
  3504.  
  3505. Function  HexToByte(                 S         : ST80    ) : BYTE;
  3506.  
  3507. Var
  3508.  
  3509.   I : INTEGER;
  3510.   B : BYTE;
  3511.  
  3512. BEGIN
  3513.  
  3514.   While Byte( S[0] ) < 2 Do
  3515.     S := '0' + S;
  3516.  
  3517.   S[1] := UpCase( S[1] );
  3518.   S[2] := UpCase( S[2] );
  3519.  
  3520.   I := 0;
  3521.  
  3522.   While ( S[1] <> TDecHex[I] ) and ( I < 16 ) Do
  3523.     Inc(I);
  3524.  
  3525.   If ( I > 15 ) Then
  3526.     I := 0;
  3527.  
  3528.   B := I SHL 4;
  3529.   I := 0;
  3530.  
  3531.   While ( S[2] <> TDecHex[I] ) and ( I < 16 ) Do
  3532.     Inc(I);
  3533.  
  3534.   If ( I > 15 ) Then
  3535.     I := 0;
  3536.  
  3537.   B := B + I;
  3538.   HexToByte:=B;
  3539.  
  3540. END;
  3541.  
  3542. {────────────────────────────────────────────────────────────────────────────}
  3543.  
  3544. (*-
  3545.  
  3546. [FUNCTION]
  3547.  
  3548. Function  HexToInt(                  S         : ST80    ) : INTEGER;
  3549.  
  3550. [PARAMETERS]
  3551.  
  3552. S           String representation of integer hex value
  3553.  
  3554. [RETURNS]
  3555.  
  3556. Integer represented by hex string
  3557.  
  3558. [DESCRIPTION]
  3559.  
  3560. Converts a hexadecimal string representation of an integer (signed word)
  3561. into an integer value.  If Error then value is Zero.
  3562.  
  3563. [SEE-ALSO]
  3564.  
  3565. CharToHex
  3566. ByteToHex
  3567. IntToHex
  3568. WordToHex
  3569. PtrToHex
  3570. LongToHex
  3571. HexToChar
  3572. HexToByte
  3573. HexToWord
  3574. HexToLong
  3575.  
  3576. [EXAMPLE]
  3577.  
  3578. VAR
  3579.   I : INTEGER;
  3580.  
  3581. BEGIN
  3582.  
  3583.   I := HexToInt( '8300' );
  3584.  
  3585.   { I = -32000 }
  3586.  
  3587. END;
  3588.  
  3589. -*)
  3590.  
  3591.  
  3592. Function  HexToInt(                  S         : ST80    ) : INTEGER;
  3593.  
  3594. BEGIN
  3595.  
  3596.   While Byte( S[0] ) < 4 Do
  3597.     S := '0' + S;
  3598.  
  3599.   HexToInt := ( Word( HexToByte( S[1] + S[2] ) ) SHL 8 ) +
  3600.                       HexToByte( S[3] + S[4] );
  3601. END;
  3602.  
  3603. {────────────────────────────────────────────────────────────────────────────}
  3604.  
  3605. (*-
  3606.  
  3607. [FUNCTION]
  3608.  
  3609. Function  HexToWord(                 S         : ST80    ) : WORD;
  3610.  
  3611. [PARAMETERS]
  3612.  
  3613. S           String representation of a word hex value
  3614.  
  3615. [RETURNS]
  3616.  
  3617. Word represented by hex string
  3618.  
  3619. [DESCRIPTION]
  3620.  
  3621. Converts a hexadecimal string representation of a word into a word value.
  3622. If Error then value is Zero.
  3623.  
  3624. [SEE-ALSO]
  3625.  
  3626. CharToHex
  3627. ByteToHex
  3628. IntToHex
  3629. WordToHex
  3630. PtrToHex
  3631. LongToHex
  3632. HexToChar
  3633. HexToByte
  3634. HexToInt
  3635. HexToLong
  3636.  
  3637. [EXAMPLE]
  3638.  
  3639. VAR
  3640.   W : WORD;
  3641.  
  3642. BEGIN
  3643.  
  3644.   W := HexToWord( 'C350' );
  3645.  
  3646.   { W = 50000 }
  3647.  
  3648. END;
  3649.  
  3650. -*)
  3651.  
  3652.  
  3653. Function  HexToWord(                 S         : ST80    ) : WORD;
  3654.  
  3655. BEGIN
  3656.  
  3657.   While Byte( S[0] ) < 4 Do
  3658.     S:='0'+ S;
  3659.  
  3660.   HexToWord := ( Word( HexToByte( S[1] + S[2] ) ) SHL 8 ) +
  3661.                        HexToByte( S[3] + S[4] );
  3662. END;
  3663.  
  3664. {────────────────────────────────────────────────────────────────────────────}
  3665.  
  3666. (*-
  3667.  
  3668. [FUNCTION]
  3669.  
  3670. Function  HexToLong(                 S         : ST80    ) : LONGINT;
  3671.  
  3672. [PARAMETERS]
  3673.  
  3674. S           String representation of longint hex value (double word)
  3675.  
  3676. [RETURNS]
  3677.  
  3678. Longint represented by hex string
  3679.  
  3680. [DESCRIPTION]
  3681.  
  3682. Converts a hexadecimal string representation of a longint (signed double
  3683. word) into a longint value.  If Error then value is Zero.
  3684.  
  3685. [SEE-ALSO]
  3686.  
  3687. CharToHex
  3688. ByteToHex
  3689. IntToHex
  3690. WordToHex
  3691. PtrToHex
  3692. LongToHex
  3693. HexToChar
  3694. HexToByte
  3695. HexToInt
  3696. HexToWord
  3697.  
  3698. [EXAMPLE]
  3699.  
  3700. VAR
  3701.   L : LONGINT;
  3702.  
  3703. BEGIN
  3704.  
  3705.   L := HexToLong( '075BCD15' );
  3706.  
  3707.   { L = 123456789 }
  3708.  
  3709. END;
  3710.  
  3711.  
  3712. -*)
  3713.  
  3714.  
  3715. Function  HexToLong(                 S         : ST80    ) : LONGINT;
  3716.  
  3717. BEGIN
  3718.  
  3719.   While Byte( S[0] ) < 8 Do
  3720.     S := '0' + S;
  3721.  
  3722.   HexToLong:=  ( HexToWord( S[1] + S[2] + S[3] + S[4] ) SHL 16 )+
  3723.                  HexToWord( S[5] + S[6] + S[7] + S[8] );
  3724.  
  3725. END;
  3726.  
  3727. {────────────────────────────────────────────────────────────────────────────}
  3728.  
  3729. (*-
  3730.  
  3731. [FUNCTION]
  3732.  
  3733. Function  ByteToBin(                 B         : BYTE    ) : ST80;
  3734.  
  3735. [PARAMETERS]
  3736.  
  3737. B           Byte value to convert to a binary string
  3738.  
  3739. [RETURNS]
  3740.  
  3741. Binary string representation of byte value
  3742.  
  3743. [DESCRIPTION]
  3744.  
  3745. Converts a byte value into a binary string
  3746.  
  3747. [SEE-ALSO]
  3748.  
  3749. IntToBin
  3750. WordToBin
  3751. LongToBin
  3752. BinToChar
  3753. BinToByte
  3754. BinToInt
  3755. BinToWord
  3756. BinToLong
  3757.  
  3758. [EXAMPLE]
  3759.  
  3760. VAR
  3761.   S : STRING;
  3762.  
  3763. BEGIN
  3764.  
  3765.   S := ByteToBin( 125 );
  3766.  
  3767.   { S = '01111101' }
  3768.  
  3769. END;
  3770.  
  3771. -*)
  3772.  
  3773.  
  3774. Function  ByteToBin(                 B         : BYTE    ) : ST80;
  3775.  
  3776. Var
  3777.  
  3778.   S : STRING;
  3779.  
  3780. BEGIN
  3781.  
  3782.   ASM
  3783.  
  3784.     {--------------------------}
  3785.     { Make ES:DI Point to S[1] }
  3786.     {--------------------------}
  3787.  
  3788.     PUSH SS
  3789.     POP  ES
  3790.     LEA  DI, S+1
  3791.  
  3792.     {-----------------------}
  3793.     { setup other registers }
  3794.     {-----------------------}
  3795.  
  3796.     CLD                  { Clear the direction          }
  3797.     MOV  BL, 128          { Start at the highest bit     }
  3798.     MOV  CX, 8            { do 8-bits                    }
  3799.     MOV  AH, '0'          { put ASCII values in regs for }
  3800.     MOV  BH, '1'          { performance...               }
  3801.  
  3802.     {------------------}
  3803.     { The Actual Loop: }
  3804.     {------------------}
  3805.  
  3806.    @@1:
  3807.  
  3808.     MOV  AL, BH           { Set AL to the default ('1')  }
  3809.     TEST B, BL           { Q: Is this bit a 1?          }
  3810.     JNE  @@2              {  Y: Move on                  }
  3811.     MOV  AL, AH           {  N: Set Al to '0'            }
  3812.  
  3813.    @@2:
  3814.  
  3815.     STOSB                { Store AL at ES:DI, inc DI    }
  3816.     SHR  BL,1            { Test the next lowest bit     }
  3817.     LOOP @@1             { loop back to @@1             }
  3818.  
  3819.     {-------------------------------}
  3820.     { Setup the Strings length byte }
  3821.     {-------------------------------}
  3822.  
  3823.     MOV  byte PTR [S], 8
  3824.  
  3825.   END;
  3826.  
  3827.   ByteToBin := S;
  3828.  
  3829. END;
  3830.  
  3831. {────────────────────────────────────────────────────────────────────────────}
  3832.  
  3833. (*-
  3834.  
  3835. [FUNCTION]
  3836.  
  3837. Function  IntToBin(                  I         : INTEGER ) : ST80;
  3838.  
  3839. [PARAMETERS]
  3840.  
  3841. I           Integer (signed word) value to convert to a binary string
  3842.  
  3843. [RETURNS]
  3844.  
  3845. Binary string representation of integer value.
  3846.  
  3847. [DESCRIPTION]
  3848.  
  3849. Converts a integer (signed word) value into a binary string
  3850.  
  3851. [SEE-ALSO]
  3852.  
  3853. ByteToBin
  3854. WordToBin
  3855. LongToBin
  3856. BinToChar
  3857. BinToByte
  3858. BinToInt
  3859. BinToWord
  3860. BinToLong
  3861.  
  3862. [EXAMPLE]
  3863.  
  3864. VAR
  3865.   S : STRING;
  3866.  
  3867. BEGIN
  3868.  
  3869.   S := IntToBin( -32000 );
  3870.  
  3871.   { S = '1000001100000000' }
  3872.  
  3873. END;
  3874.  
  3875. -*)
  3876.  
  3877.  
  3878. Function  IntToBin(                  I         : INTEGER ) : ST80;
  3879.  
  3880. BEGIN
  3881.  
  3882.   IntToBin := ByteToBin( I SHR 8 ) + ByteToBin( I AND $FF );
  3883.  
  3884. END;
  3885.  
  3886. {────────────────────────────────────────────────────────────────────────────}
  3887.  
  3888. (*-
  3889.  
  3890. [FUNCTION]
  3891.  
  3892. Function  WordToBin(                 W         : WORD    ) : ST80;
  3893.  
  3894. [PARAMETERS]
  3895.  
  3896. W           Word value to convert to a binary string
  3897.  
  3898. [RETURNS]
  3899.  
  3900. Binary string representation of word value
  3901.  
  3902. [DESCRIPTION]
  3903.  
  3904. Converts a word value into a binary string
  3905.  
  3906. [SEE-ALSO]
  3907.  
  3908. ByteToBin
  3909. IntToBin
  3910. LongToBin
  3911. BinToChar
  3912. BinToByte
  3913. BinToInt
  3914. BinToWord
  3915. BinToLong
  3916.  
  3917. [EXAMPLE]
  3918.  
  3919. VAR
  3920.   S : STRING;
  3921.  
  3922. BEGIN
  3923.  
  3924.   S := WordToBin( 50000 );
  3925.  
  3926.   { S = '1100001101010000' }
  3927.  
  3928. END;
  3929.  
  3930. -*)
  3931.  
  3932.  
  3933. Function  WordToBin(                 W         : WORD    ) : ST80;
  3934.  
  3935. BEGIN
  3936.  
  3937.   WordToBin := ByteToBin( W SHR 8 ) + ByteToBin( W AND $FF );
  3938.  
  3939. END;
  3940.  
  3941. {────────────────────────────────────────────────────────────────────────────}
  3942.  
  3943. (*-
  3944.  
  3945. [FUNCTION]
  3946.  
  3947. Function  LongToBin(                 L         : LONGINT ) : ST80;
  3948.  
  3949. [PARAMETERS]
  3950.  
  3951. L           Longint (signed double word) value to convert to binary string
  3952.  
  3953. [RETURNS]
  3954.  
  3955. Binary string representation of Longint
  3956.  
  3957. [DESCRIPTION]
  3958.  
  3959. Converts a longint (signed double word) value into a binary string
  3960.  
  3961. [SEE-ALSO]
  3962.  
  3963. ByteToBin
  3964. IntToBin
  3965. WordToBin
  3966. BinToChar
  3967. BinToByte
  3968. BinToInt
  3969. BinToWord
  3970. BinToLong
  3971.  
  3972. [EXAMPLE]
  3973.  
  3974. VAR
  3975.   S : STRING;
  3976.  
  3977. BEGIN
  3978.  
  3979.   S := LongToBin( 123456789 );
  3980.  
  3981.   { S = '00000111010110111100110100010101' }
  3982.  
  3983. END;
  3984.  
  3985. -*)
  3986.  
  3987.  
  3988. Function  LongToBin(                 L         : LONGINT ) : ST80;
  3989.  
  3990. BEGIN
  3991.  
  3992.   LongToBin := IntToBin( L SHR 16 ) + WordToBin( L AND $FFFF );
  3993.  
  3994. END;
  3995.  
  3996. {────────────────────────────────────────────────────────────────────────────}
  3997.  
  3998. (*-
  3999.  
  4000. [FUNCTION]
  4001.  
  4002. Function  BinToChar(                 S         : ST80    ) : SHORTINT;
  4003.  
  4004. [PARAMETERS]
  4005.  
  4006. S           Binary string to convert to a signed byte value
  4007.  
  4008. [RETURNS]
  4009.  
  4010. Signed byte value of binary string
  4011.  
  4012. [DESCRIPTION]
  4013.  
  4014. Converts a binary string into a signed byte value.
  4015. If Error then value is Zero.
  4016.  
  4017. [SEE-ALSO]
  4018.  
  4019. ByteToBin
  4020. IntToBin
  4021. WordToBin
  4022. LongToBin
  4023. BinToByte
  4024. BinToInt
  4025. BinToWord
  4026. BinToLong
  4027.  
  4028. [EXAMPLE]
  4029.  
  4030. VAR
  4031.   I : SHORTINT;
  4032.  
  4033. BEGIN
  4034.  
  4035.   I := BinToChar( '10000000' );
  4036.   { I = -128 }
  4037.  
  4038. END;
  4039.  
  4040. -*)
  4041.  
  4042.  
  4043. Function  BinToChar(                 S         : ST80    ) : SHORTINT;
  4044.  
  4045. Var
  4046.  
  4047.   C : SHORTINT;
  4048.   I : INTEGER;
  4049.  
  4050. BEGIN
  4051.  
  4052.   While Byte( S[0] ) < 8 Do
  4053.     S := '0' + S;
  4054.  
  4055.   C := 0;
  4056.   For I := 7 DownTo 1 Do
  4057.   BEGIN
  4058.  
  4059.     If S[ 8-I ] = '1' Then
  4060.       C := C OR ($1 SHL I);
  4061.  
  4062.   END;
  4063.  
  4064.   BinToChar := C;
  4065.  
  4066. END;
  4067.  
  4068. {────────────────────────────────────────────────────────────────────────────}
  4069.  
  4070. (*-
  4071.  
  4072. [FUNCTION]
  4073.  
  4074. Function  BinToByte(                 S         : ST80    ) : BYTE;
  4075.  
  4076. [PARAMETERS]
  4077.  
  4078. S           Binary string to convert to a byte value
  4079.  
  4080. [RETURNS]
  4081.  
  4082. Byte value of binary string
  4083.  
  4084. [DESCRIPTION]
  4085.  
  4086. Converts a binary string into an unsigned byte value.
  4087. If Error then value is Zero.
  4088.  
  4089. [SEE-ALSO]
  4090.  
  4091. ByteToBin
  4092. IntToBin
  4093. WordToBin
  4094. LongToBin
  4095. BinToChar
  4096. BinToInt
  4097. BinToWord
  4098. BinToLong
  4099.  
  4100. [EXAMPLE]
  4101.  
  4102. VAR
  4103.   B : BYTE;
  4104.  
  4105. BEGIN
  4106.  
  4107.   B := BinToChar( '10000000' );
  4108.   { B = 128 }
  4109.  
  4110. END;
  4111.  
  4112. -*)
  4113.  
  4114.  
  4115. Function  BinToByte(                 S         : ST80    ) : BYTE;
  4116.  
  4117. Var
  4118.  
  4119.   B : BYTE;
  4120.   I : INTEGER;
  4121.  
  4122. BEGIN
  4123.  
  4124.   While Byte( S[0] ) < 8 Do
  4125.     S := '0' + S;
  4126.  
  4127.   B := 0;
  4128.   For I := 7 DownTo 0 Do
  4129.   BEGIN
  4130.  
  4131.     If S[ 8-I ] = '1' Then
  4132.       B := B OR ($1 SHL I);
  4133.  
  4134.   END;
  4135.  
  4136.   BinToByte := B;
  4137.  
  4138. END;
  4139.  
  4140. {────────────────────────────────────────────────────────────────────────────}
  4141.  
  4142. (*-
  4143.  
  4144. [FUNCTION]
  4145.  
  4146. Function  BinToInt(                  S         : ST80    ) : INTEGER;
  4147.  
  4148. [PARAMETERS]
  4149.  
  4150. S           Binary string to convert to an integer (signed word) value
  4151.  
  4152. [RETURNS]
  4153.  
  4154. Integer value of binary string
  4155.  
  4156. [DESCRIPTION]
  4157.  
  4158. Converts a binary string into an integer value.
  4159. If Error then value is Zero.
  4160.  
  4161. [SEE-ALSO]
  4162.  
  4163. ByteToBin
  4164. IntToBin
  4165. WordToBin
  4166. LongToBin
  4167. BinToChar
  4168. BinToByte
  4169. BinToWord
  4170. BinToLong
  4171.  
  4172. [EXAMPLE]
  4173.  
  4174. VAR
  4175.   I : INTEGER;
  4176.  
  4177. BEGIN
  4178.  
  4179.   I := BinToInt( '1000001100000000' );
  4180.  
  4181.   { I := -32000 }
  4182.  
  4183. END;
  4184.  
  4185. -*)
  4186.  
  4187.  
  4188. Function  BinToInt(                  S         : ST80    ) : INTEGER;
  4189.  
  4190. BEGIN
  4191.  
  4192.   While Byte( S[0] ) < 16 Do
  4193.     S := '0' + S;
  4194.  
  4195.   BinToInt := ( Word( BinToChar( Copy( S, 1, 8 ) ) SHL 8 ) +
  4196.                       BinToByte( Copy( S, 8, 8 ) ) );
  4197.  
  4198. END;
  4199.  
  4200. {────────────────────────────────────────────────────────────────────────────}
  4201.  
  4202. (*-
  4203.  
  4204. [FUNCTION]
  4205.  
  4206. Function  BinToWord(                 S         : ST80    ) : WORD;
  4207.  
  4208. [PARAMETERS]
  4209.  
  4210. S           Binary string to convert to a word value
  4211.  
  4212. [RETURNS]
  4213.  
  4214. Word value of binary string
  4215.  
  4216. [DESCRIPTION]
  4217.  
  4218. Converts a binary string into a word value.
  4219. If Error then value is Zero.
  4220.  
  4221. [SEE-ALSO]
  4222.  
  4223. ByteToBin
  4224. IntToBin
  4225. WordToBin
  4226. LongToBin
  4227. BinToChar
  4228. BinToByte
  4229. BinToInt
  4230. BinToLong
  4231.  
  4232. [EXAMPLE]
  4233.  
  4234. VAR
  4235.   W : WORD;
  4236.  
  4237. BEGIN
  4238.  
  4239.   W := BinToWord( '1100001101010000' );
  4240.  
  4241.   { W = 50000 }
  4242.  
  4243. END;
  4244.  
  4245. -*)
  4246.  
  4247.  
  4248. Function  BinToWord(                 S         : ST80    ) : WORD;
  4249.  
  4250. BEGIN
  4251.  
  4252.   While Byte( S[0] ) < 16 Do
  4253.     S := '0' + S;
  4254.  
  4255.   BinToWord := ( Word( BinToByte( Copy( S, 1, 8 ) ) SHL 8 ) +
  4256.                        BinToByte( Copy( S, 8, 8 ) ) );
  4257.  
  4258. END;
  4259.  
  4260. {────────────────────────────────────────────────────────────────────────────}
  4261.  
  4262. (*-
  4263.  
  4264. [FUNCTION]
  4265.  
  4266. Function  BinToLong(                 S         : ST80    ) : LONGINT;
  4267.  
  4268. [PARAMETERS]
  4269.  
  4270. S           Binary String to convert to a longint (signed double word) value
  4271.  
  4272. [RETURNS]
  4273.  
  4274. Longint value of binary string
  4275.  
  4276. [DESCRIPTION]
  4277.  
  4278. Converts a binary string into a longint value.
  4279. If Error then value is Zero.
  4280.  
  4281. [SEE-ALSO]
  4282.  
  4283. ByteToBin
  4284. IntToBin
  4285. WordToBin
  4286. LongToBin
  4287. BinToChar
  4288. BinToByte
  4289. BinToInt
  4290. BinToWord
  4291.  
  4292. [EXAMPLE]
  4293.  
  4294. VAR
  4295.   L : LONGINT;
  4296.  
  4297. BEGIN
  4298.  
  4299.   L := BinToLong( '00000111010110111100110100010101' );
  4300.  
  4301.   { L = 123456789 }
  4302.  
  4303. END;
  4304.  
  4305. -*)
  4306.  
  4307.  
  4308. Function  BinToLong(                 S         : ST80    ) : LONGINT;
  4309.  
  4310. BEGIN
  4311.  
  4312.   While Byte( S[0] ) < 16 Do
  4313.     S := '0' + S;
  4314.  
  4315.   BinToLong := ( LongInt( BinToWord( Copy( S, 1, 8 ) ) SHL 16 ) +
  4316.                           BinToWord( Copy( S, 8, 8 ) ) );
  4317.  
  4318. END;
  4319.  
  4320. {────────────────────────────────────────────────────────────────────────────}
  4321.  
  4322. (*-
  4323.  
  4324. [FUNCTION]
  4325.  
  4326. Function  DecToBCD(                  Decimal   : BYTE    ) : BYTE;
  4327.  
  4328. [PARAMETERS]
  4329.  
  4330. Decimal     Decimal Byte value (ranging from 0 to 99) to convert to a
  4331.             BCD byte value.
  4332.  
  4333. [RETURNS]
  4334.  
  4335. BCD value of Decimal byte value.
  4336.  
  4337. [DESCRIPTION]
  4338.  
  4339. Converts a decimal value ranging from 0 to 99 to Binary Coded Decimal
  4340. Format as a byte.
  4341.  
  4342. [SEE-ALSO]
  4343.  
  4344. BCDtoDec
  4345. ByteToBCD
  4346. BCDtoByte
  4347. WordToBCD
  4348. BCDtoWord
  4349.  
  4350. [EXAMPLE]
  4351.  
  4352. VAR
  4353.   B : BYTE;
  4354.  
  4355. BEGIN
  4356.  
  4357.   B := DecToBCD( 14 );
  4358.  
  4359.   { B = $14 }
  4360.  
  4361. END;
  4362.  
  4363. -*)
  4364.  
  4365.  
  4366. Function  DectoBCD(                  Decimal   : BYTE    ) : BYTE;
  4367.  
  4368. Assembler;
  4369. ASM
  4370.  
  4371.   MOV  AL, Decimal
  4372.  
  4373.   XOR  AH, AH      {prepare 16 bit division     }
  4374.   MOV  DH, 10      {work in decimal system      }
  4375.   DIV  DH          {divide AX by 10             }
  4376.  
  4377.   MOV  CL, 4
  4378.   SHL  AL, CL      {shift quotient left 4 places}
  4379.  
  4380.   OR   AL, AH      {OR remainder                }
  4381.  
  4382. END;
  4383.  
  4384. {────────────────────────────────────────────────────────────────────────────}
  4385.  
  4386. (*-
  4387.  
  4388. [FUNCTION]
  4389.  
  4390. Function  BCDtoDec(                  Bcd       : BYTE    ) : BYTE;
  4391.  
  4392. [PARAMETERS]
  4393.  
  4394. Bcd         BCD Byte value (ranging 00h - 99h) to convert to a decimal
  4395.             byte value.
  4396.  
  4397. [RETURNS]
  4398.  
  4399. Decimal byte value of BCD byte value.
  4400.  
  4401. [DESCRIPTION]
  4402.  
  4403. Converts a BCD byte value ranging fron 00h to 99h to a decimal byte value
  4404.  
  4405. [SEE-ALSO]
  4406.  
  4407. DecToBCD
  4408. ByteToBCD
  4409. BCDtoByte
  4410. WordToBCD
  4411. BCDtoWord
  4412.  
  4413. [EXAMPLE]
  4414.  
  4415. VAR
  4416.   B : BYTE;
  4417.  
  4418. BEGIN
  4419.  
  4420.   B := BCDtoDec( $14 );
  4421.  
  4422.   { B = 14 }
  4423.  
  4424. END;
  4425.  
  4426. -*)
  4427.  
  4428.  
  4429. Function  BCDtoDec(                  Bcd       : BYTE    ) : BYTE;
  4430.  
  4431. Assembler;
  4432. ASM
  4433.  
  4434.   MOV  DL, Bcd
  4435.   MOV  AL, DL      {transmit value to AL     }
  4436.  
  4437.   MOV  CL, 4
  4438.   SHR  AL, CL      {shift 4 places right     }
  4439.  
  4440.   XOR  AH, AH      {set AH to 0              }
  4441.   MOV  DH, 10      {process in decimal system}
  4442.   MUL  DH          {multiply AX by 10        }
  4443.   MOV  DH, DL      {transmit DL to DH        }
  4444.   AND  DH, $0F     {set hi-nibble in DH to 0 }
  4445.   ADD  AL, DH      {add AL and DH            }
  4446.  
  4447. END;
  4448.  
  4449. {────────────────────────────────────────────────────────────────────────────}
  4450.  
  4451. (*-
  4452.  
  4453. [FUNCTION]
  4454.  
  4455. Function  ByteToBCD(                 Decimal   : BYTE    ) : WORD;
  4456.  
  4457. [PARAMETERS]
  4458.  
  4459. Decimal     Decimal byte value (ranging from 0 to 255) to convert to
  4460.             a BCD word value
  4461.  
  4462. [RETURNS]
  4463.  
  4464. BCD word value of decimal byte value.
  4465.  
  4466. [DESCRIPTION]
  4467.  
  4468. Converts a Decimal byte value ranging from 0 to 255 to Binary Coded
  4469. Decimal format as a word.
  4470.  
  4471. [SEE-ALSO]
  4472.  
  4473. DecToBCD
  4474. BCDtoDec
  4475. BCDtoByte
  4476. WordToBCD
  4477. BCDtoWord
  4478.  
  4479. [EXAMPLE]
  4480.  
  4481. VAR
  4482.   W : WORD;
  4483.  
  4484. BEGIN
  4485.  
  4486.   W := ByteToBCD( 255 );
  4487.  
  4488.   { W = $0255 }
  4489.  
  4490. END;
  4491.  
  4492. -*)
  4493.  
  4494.  
  4495. Function  ByteToBCD(                 Decimal   : BYTE    ) : WORD;
  4496.  
  4497. BEGIN
  4498.  
  4499.   ByteToBCD := DecToBCD( Decimal DIV 100 ) SHL 8 +
  4500.                DecToBCD( Decimal MOD 100 );
  4501.  
  4502. END;
  4503.  
  4504. {────────────────────────────────────────────────────────────────────────────}
  4505.  
  4506. (*-
  4507.  
  4508. [FUNCTION]
  4509.  
  4510. Function  BCDtoByte(                 Bcd       : WORD    ) : BYTE;
  4511.  
  4512. [PARAMETERS]
  4513.  
  4514. Bcd         BCD Word value (ranging from 0000h to 0255h) to convert to
  4515.             a decimal byte value.
  4516.  
  4517. [RETURNS]
  4518.  
  4519. Decimal byte value of BCD word value.
  4520.  
  4521. [DESCRIPTION]
  4522.  
  4523. Converts a BCD word value ranging from 0000h to 0255h to a decimal byte
  4524. value.
  4525.  
  4526. [SEE-ALSO]
  4527.  
  4528. DecToBCD
  4529. BCDtoDec
  4530. ByteToBCD
  4531. WordToBCD
  4532. BCDtoWord
  4533.  
  4534. [EXAMPLE]
  4535.  
  4536. VAR
  4537.   B : BYTE;
  4538.  
  4539. BEGIN
  4540.  
  4541.   B := BCDtoByte( $0255 );
  4542.  
  4543.   { B = 255 }
  4544.  
  4545. END;
  4546.  
  4547. -*)
  4548.  
  4549.  
  4550. Function  BCDtoByte(                 Bcd       : WORD    ) : BYTE;
  4551.  
  4552. BEGIN
  4553.  
  4554.   BCDtoByte := BCDtoDec( Hi(Bcd) ) * 100 + BCDtoDec( Lo(Bcd) );
  4555.  
  4556. END;
  4557.  
  4558. {────────────────────────────────────────────────────────────────────────────}
  4559.  
  4560. (*-
  4561.  
  4562. [FUNCTION]
  4563.  
  4564. Function  WordToBCD(                 Decimal   : WORD    ) : LONGINT;
  4565.  
  4566. [PARAMETERS]
  4567.  
  4568. Decimal     Decimal word value (ranging from 0 to 65535) to convert to
  4569.             a BCD longint value
  4570.  
  4571. [RETURNS]
  4572.  
  4573. BCD longint value of decimal word value
  4574.  
  4575. [DESCRIPTION]
  4576.  
  4577. Converts a Decimal word value ranging from 0 to 65535 to Binary Coded
  4578. Decimal format as a longint.
  4579.  
  4580. [SEE-ALSO]
  4581.  
  4582. DecToBCD
  4583. BCDtoDec
  4584. ByteToBCD
  4585. BCDtoByte
  4586. BCDtoWord
  4587.  
  4588. [EXAMPLE]
  4589.  
  4590. VAR
  4591.   L : LONGINT;
  4592.  
  4593. BEGIN
  4594.  
  4595.   L := WordToBCD( 54321 );
  4596.  
  4597.   { L = $00054321 }
  4598.  
  4599. END;
  4600.  
  4601. -*)
  4602.  
  4603.  
  4604. Function  WordToBCD(                 Decimal   : WORD    ) : LONGINT;
  4605.  
  4606. BEGIN
  4607.  
  4608.   Decimal := Decimal MOD 100000000;
  4609.  
  4610.   WordToBCD := LONGINT( DecToBCD( ( Decimal DIV 1000000 ) MOD 100 ) ) SHL 24 +
  4611.                LONGINT( DecToBCD( ( Decimal DIV 10000 ) MOD 100 ) ) SHL 16 +
  4612.                LONGINT( DecToBCD( ( Decimal DIV 100 ) MOD 100 ) ) SHL  8 +
  4613.                         DecToBCD( Decimal MOD 100 );
  4614. END;
  4615.  
  4616. {────────────────────────────────────────────────────────────────────────────}
  4617.  
  4618. (*-
  4619.  
  4620. [FUNCTION]
  4621.  
  4622. Function  BCDtoWord(                 Bcd       : LONGINT ) : WORD;
  4623.  
  4624. [PARAMETERS]
  4625.  
  4626. Bcd         BCD longint value (ranging from 00000000h to 00065535h) to
  4627.             convert to a decimal word value
  4628.  
  4629. [RETURNS]
  4630.  
  4631. Decimal word value of BCD longint value
  4632.  
  4633. [DESCRIPTION]
  4634.  
  4635. Converts a BCD longint value ranging fron 00000000h to 00065536h to a
  4636. decimal word value.
  4637.  
  4638. [SEE-ALSO]
  4639.  
  4640. DecToBCD
  4641. BCDtoDec
  4642. ByteToBCD
  4643. BCDtoByte
  4644. WordToBCD
  4645.  
  4646. [EXAMPLE]
  4647.  
  4648. VAR
  4649.   W : WORD;
  4650.  
  4651. BEGIN
  4652.  
  4653.   W := BCDtoWord( $00054321 );
  4654.  
  4655.   { W = 54321 }
  4656.  
  4657. END;
  4658.  
  4659. -*)
  4660.  
  4661.  
  4662. Function  BCDtoWord(                 Bcd       : LONGINT ) : WORD;
  4663.  
  4664. BEGIN
  4665.  
  4666.   BCDtoWord := BCDtoDec( ( Bcd SHL 24 ) AND $FF ) * 1000000 +
  4667.                BCDtoDec( ( Bcd SHL 16 ) AND $FF ) * 10000 +
  4668.                BCDtoDec( ( Bcd SHL  8 ) AND $FF ) * 100 +
  4669.                BCDtoDec(   Bcd AND $FF );
  4670.  
  4671. END;
  4672.  
  4673. {────────────────────────────────────────────────────────────────────────────}
  4674.  
  4675.  
  4676.  
  4677. (*-
  4678.  
  4679. [FUNCTION]
  4680.  
  4681. Function  FastCompare(           Var Buf1;
  4682.                                  Var Buf2;
  4683.                                      Count     : WORD    ) : WORD;
  4684.  
  4685. [PARAMETERS]
  4686.  
  4687. Buffer1     VAR Address of First Buffer (Generic Type)
  4688. Buffer2     VAR Address of Second Buffer (Generic Type)
  4689. Count       Number of bytes in each buffer
  4690.  
  4691. [RETURNS]
  4692.  
  4693. Whether or not the provided Buffers were the same (0=Same, $FFFF=Not)
  4694.  
  4695. [DESCRIPTION]
  4696.  
  4697. This function compares two data buffers and returns a non-zero value
  4698. if the buffers data does not compare.  It doesn't indicate which byte
  4699. index the miscompare exists, just that it did.  If the data in both
  4700. buffers are alike the result is Zero.  This Operation is Optimized in
  4701. Assembly for the fastest possible Comparison.
  4702.  
  4703. [SEE-ALSO]
  4704.  
  4705. Compare
  4706. CompareSmaller
  4707. CompareBufByte
  4708.  
  4709. [EXAMPLE]
  4710.  
  4711. TYPE
  4712.   TBuff = ARRAY[1..10] of BYTE;
  4713.  
  4714. VAR
  4715.   B1,B2 : TBuff;
  4716.   W     : WORD;
  4717.  
  4718. BEGIN
  4719.  
  4720.   FillChar( B1, SizeOf( B1 ), 4 );
  4721.   FillChar( B2, SizeOf( B2 ), 4 );
  4722.  
  4723.   B2[7] := 49;  { Force MisCompare }
  4724.  
  4725.   W := FastCompare( B1, B2, SizeOf( TBuff ) );
  4726.  
  4727.   { W = $FFFF  - MisCompared! }
  4728.  
  4729. END;
  4730.  
  4731. -*)
  4732.  
  4733.  
  4734. Function  FastCompare(           Var Buf1;
  4735.                                  Var Buf2;
  4736.                                      Count     : WORD    ) : WORD;
  4737. Assembler;
  4738. ASM
  4739.  
  4740.   PUSH DS
  4741.  
  4742.   LES  DI, [Buf1]
  4743.   LDS  SI, [Buf2]
  4744.   MOV  CX, [Count]
  4745.  
  4746.   CLD
  4747.   REPZ CMPSB
  4748.  
  4749.   JNZ  @1
  4750.   XOR  AX, AX
  4751.   JMP  @2
  4752.  
  4753.  @1:
  4754.   MOV  AX, $FFFF
  4755.  
  4756.  @2:
  4757.  
  4758.   POP  DS
  4759.  
  4760. END;
  4761.  
  4762. {────────────────────────────────────────────────────────────────────────────}
  4763.  
  4764. (*-
  4765.  
  4766. [FUNCTION]
  4767.  
  4768. Function  Compare(               Var Buf1;
  4769.                                  Var Buf2;
  4770.                                      Count     : WORD    ) : WORD;
  4771.  
  4772. [PARAMETERS]
  4773.  
  4774. Buf1        VAR Address of First Buffer (Generic Type)
  4775. Buf2        VAR Address of Second Buffer (Generic Type)
  4776. Count       Number of bytes in each buffer (Max = $FFFE bytes)
  4777.  
  4778. [RETURNS]
  4779.  
  4780. Index of First Miscompared Byte in Buffers, 0 if Buffers the Same
  4781.  
  4782. [DESCRIPTION]
  4783.  
  4784. This function compares two data buffers and returns a non-zero value
  4785. if the buffer's data does not compare.  This number will be the index
  4786. of the first byte miscompared between the two bufffers or Zero if the
  4787. buffers were alike.  This Operation is Optimized in Assembly for the
  4788. fastests possible Comparison.
  4789.  
  4790. [SEE-ALSO]
  4791.  
  4792. FastCompare
  4793. CompareSmaller
  4794. CompareBufByte
  4795.  
  4796. [EXAMPLE]
  4797.  
  4798. TYPE
  4799.   TBuff = ARRAY[1..10] of BYTE;
  4800.  
  4801. VAR
  4802.   B1,B2 : TBuff;
  4803.   W     : WORD;
  4804.  
  4805. BEGIN
  4806.  
  4807.   FillChar( B1, SizeOf( B1 ), 4 );
  4808.   FillChar( B2, SizeOf( B2 ), 4 );
  4809.  
  4810.   B2[7] := 49;  { Force MisCompare }
  4811.  
  4812.   W := Compare( B1, B2, SizeOf( TBuff ) );
  4813.  
  4814.   { W = 7  - MisCompare Index! }
  4815.  
  4816. END;
  4817.  
  4818. -*)
  4819.  
  4820.  
  4821. Function  Compare(               Var Buf1;
  4822.                                  Var Buf2;
  4823.                                      Count     : WORD    ) : WORD;
  4824. Assembler;
  4825. ASM
  4826.  
  4827.   PUSH DS
  4828.  
  4829.   LES  DI, Buf1
  4830.   LDS  SI, Buf2
  4831.   MOV  CX, Count
  4832.  
  4833.   CLD
  4834.   REPE CMPSB
  4835.  
  4836.   JNE  @1
  4837.  
  4838.   XOR  AX, AX
  4839.   JMP  @2
  4840.  
  4841.  @1:
  4842.   MOV  AX, Count
  4843.   SUB  AX, CX
  4844.  
  4845.  @2:
  4846.  
  4847.   POP  DS
  4848.  
  4849. END;
  4850.  
  4851. {────────────────────────────────────────────────────────────────────────────}
  4852.  
  4853. (*-
  4854.  
  4855. [FUNCTION]
  4856.  
  4857. Function  CompareSmaller(        Var Buf1;
  4858.                                  Var Buf2;
  4859.                                      Count     : WORD    ) : SHORTINT;
  4860.  
  4861. [PARAMETERS]
  4862.  
  4863. Buf1        VAR Address of First Buffer (Generic Type)
  4864. Buf2        VAR Address of Second Buffer (Generic Type)
  4865. Count       Number of bytes in each buffer (Max = $FFFE bytes)
  4866.  
  4867. [RETURNS]
  4868.  
  4869. Which Buffer Data contains the Smaller Value or if they Match
  4870.   -1 if first is smaller than the second buffer
  4871.    0 if they are the same
  4872.    1 if first is bigger than the second buffer
  4873.  
  4874. [DESCRIPTION]
  4875.  
  4876. This function tests two buffers to see which Buffer Data contains a smaller
  4877. value.  At the first Miscompare, the one with the lesser Value is indicated
  4878. with a non-zero value (-1 if the 1st Buffer byte is smaller than the 2nd,
  4879. 1 if the 1st Buffer byte is greater than the 2nd, or 0 [Zero] if they are
  4880. both the same).
  4881.  
  4882. [SEE-ALSO]
  4883.  
  4884. FastCompare
  4885. Compare
  4886. CompareBufByte
  4887.  
  4888. [EXAMPLE]
  4889.  
  4890. TYPE
  4891.   TBuff = ARRAY[1..10] of BYTE;
  4892.  
  4893. VAR
  4894.   B1,B2 : TBuff;
  4895.   I     : INTEGER;
  4896.  
  4897. BEGIN
  4898.  
  4899.   FillChar( B1, SizeOf( B1 ), 4 );
  4900.   FillChar( B2, SizeOf( B2 ), 4 );
  4901.  
  4902.   B2[7] := 49;  { Force MisCompare }
  4903.  
  4904.   I := CompareSmaller( B1, B2, SizeOf( TBuff ) );
  4905.  
  4906.   { I = -1  - MisCompare, 1st Buffer Smaller! }
  4907.  
  4908. END;
  4909.  
  4910. -*)
  4911.  
  4912.  
  4913. Function  CompareSmaller(        Var Buf1;
  4914.                                  Var Buf2;
  4915.                                      Count     : WORD    ) : SHORTINT;
  4916.  
  4917. Assembler;
  4918. ASM
  4919.  
  4920.   PUSH DS
  4921.  
  4922.   MOV  CX, Count      {!^!must take into account segment fix-ups here!}
  4923.   LES  DI, Buf1
  4924.   ADD  DI, Count
  4925.   LDS  SI, Buf2
  4926.   ADD  SI, Count
  4927.  
  4928.  @START:
  4929.  
  4930.   DEC  DI
  4931.   DEC  SI
  4932.  
  4933.   MOV  BL, ES:[DI]
  4934.   MOV  BH, DS:[SI]
  4935.   CMP  BL, BH
  4936.   JB   @LESSER
  4937.   JA   @GREATER
  4938.  
  4939.   LOOP @START
  4940.  
  4941.  @FINISH:
  4942.  
  4943.   XOR  AL, AL
  4944.   JMP  @EXIT
  4945.  
  4946.  @LESSER:
  4947.  
  4948.   MOV  AL, $FF
  4949.   JMP  @EXIT
  4950.  
  4951.  @GREATER:
  4952.  
  4953.   MOV  AL, $01
  4954.  
  4955.  @EXIT:
  4956.  
  4957.   POP  DS
  4958.  
  4959. END;
  4960.  
  4961. {────────────────────────────────────────────────────────────────────────────}
  4962.  
  4963. (*-
  4964.  
  4965. [FUNCTION]
  4966.  
  4967. Function  CompareBufByte(        Var Buff;
  4968.                                      Count     : WORD;
  4969.                                      B         : BYTE    ) : WORD;
  4970.  
  4971. [PARAMETERS]
  4972.  
  4973. Buff        VAR Address of Buffer (Generic Type)
  4974. Count       Number of bytes in each buffer (Max = $FFFE byte)
  4975. B           Comparison byte
  4976.  
  4977. [RETURNS]
  4978.  
  4979. Index of First Miscompared byte in Buffer, 0 if Buffer all data matches
  4980. Compare Byte
  4981.  
  4982. [DESCRIPTION]
  4983.  
  4984. Compares a buffer with a byte value to determine whether or not all bytes
  4985. in that buffer are the same as the comparison byte.  Returns Zero if all
  4986. buffer data bytes match the compare byte, otherwise returns the index
  4987. into the buffer of the miscompare.
  4988.  
  4989. [SEE-ALSO]
  4990.  
  4991. FastCompare
  4992. Compare
  4993. CompareSmaller
  4994.  
  4995. [EXAMPLE]
  4996.  
  4997. TYPE
  4998.   TBuffer = ARRAY[1..512] of BYTE;
  4999.  
  5000. VAR
  5001.   B : TBuffer;
  5002.   C : BYTE;
  5003.   W : WORD;
  5004.  
  5005. BEGIN
  5006.  
  5007.   { COMPARE MATCH }
  5008.  
  5009.   FillChar( B, 512, #30 );
  5010.   C := #30;
  5011.   W := CompareBufByte( B, 512, C );
  5012.  
  5013.   { W will now equal 0 (Comparison Match) }
  5014.  
  5015.   { COMPARE MISMATCH }
  5016.  
  5017.   B[274] := $FF;  { Just to make sure Doesn't Compare }
  5018.   W := CompareBufByte( B, 512, C );
  5019.  
  5020.   { W will now Equal 274 (Index of Mismatch) }
  5021.  
  5022. END.
  5023.  
  5024. TYPE
  5025.   TBuff = ARRAY[1..10] of BYTE;
  5026.  
  5027. VAR
  5028.   Buf : TBuff;
  5029.   B   : BYTE;
  5030.   W   : WORD;
  5031.  
  5032. BEGIN
  5033.  
  5034.   FillChar( Bur, SizeOf( TBuff ), 4 );
  5035.   Buf[7] := 49;  { Force MisCompare! }
  5036.  
  5037.   W := CompareSmaller( Buf, SizeOf( TBuff ), $04 );
  5038.  
  5039.   { W = 7  - MisCompare Index! }
  5040.  
  5041. END;
  5042.  
  5043. -*)
  5044.  
  5045. Function  CompareBufByte(        Var Buff;
  5046.                                      Count     : WORD;
  5047.                                      B         : BYTE    ) : WORD;
  5048. Assembler;
  5049. ASM
  5050.  
  5051.   LES  DI, Buff         { make da es:di --> da buff  }
  5052.   MOV  CX, Count        { make cx         = da count }
  5053.   MOV  AL, B            { make al         = byte to compare to }
  5054.  
  5055.   CLD                   { go ever forward }
  5056.   REPE SCASB            { repeat while equal - compare to accumulator }
  5057.  
  5058.   JNE  @1               { if they were not equal, go on to @2 ... }
  5059.  
  5060.   XOR  AX, AX           { make ax = 0   ( "equal" flag ) }
  5061.   JMP  @2               { git on outa here }
  5062.  
  5063.  @1:
  5064.   MOV  AX, Count        { convert value to offset of miscompare }
  5065.   SUB  AX, CX           { ... }
  5066.  
  5067.  @2:
  5068.  
  5069. END;
  5070.  
  5071.  
  5072. {────────────────────────────────────────────────────────────────────────────}
  5073.  
  5074. (*-
  5075.  
  5076. [FUNCTION]
  5077.  
  5078. Function  CompareBufWord(        Var Buff;
  5079.                                      Count     : WORD;
  5080.                                      W         : WORD    ) : WORD;
  5081.  
  5082. [PARAMETERS]
  5083.  
  5084. Buff        VAR Address of Buffer (Generic Type)
  5085. Count       Number of Words in each buffer (Max of $FFFE bytes)
  5086. W           2-Byte Comparison Value
  5087.  
  5088. [RETURNS]
  5089.  
  5090. Word Index of First Miscompared Word in Buffer, 0 if Buffer all data
  5091. matches the 2-Byte Compare Value (a Word)
  5092.  
  5093. [DESCRIPTION]
  5094.  
  5095. Compares a buffer with a 2-Byte value (a WORD) to determine whether or
  5096. not all Words in that buffer are the same as the comparison byte.
  5097. Returns Zero if all buffer data words match the compare word, otherwise
  5098. returns the Word Index into the buffer of the miscompare.
  5099.  
  5100. [SEE-ALSO]
  5101.  
  5102. FastCompare
  5103. Compare
  5104. CompareSmaller
  5105.  
  5106. [EXAMPLE]
  5107.  
  5108. TYPE
  5109.   TBuffer = ARRAY[1..256] of BYTE;
  5110.  
  5111. VAR
  5112.   B : TBuffer;
  5113.   C : BYTE;
  5114.   W : WORD;
  5115.  
  5116. BEGIN
  5117.  
  5118.   { COMPARE MATCH }
  5119.  
  5120.   FillChar( B, SizeOf( TBuffer ), #30 );
  5121.   C := #30;
  5122.   W := CompareBufByte( B, 256, C );
  5123.  
  5124.   { W will now equal 0 (Comparison Match) }
  5125.  
  5126.   { COMPARE MISMATCH }
  5127.  
  5128.   B[137] := $FF;  { Just to make sure Doesn't Compare }
  5129.   W := CompareBufByte( B, 256, C );
  5130.  
  5131.   { W will now Equal 137 (Index of Mismatch) }
  5132.  
  5133. END.
  5134.  
  5135. -*)
  5136.  
  5137. Function  CompareBufWord(        Var Buff;
  5138.                                      Count     : WORD;
  5139.                                      W         : WORD    ) : WORD;
  5140. Assembler;
  5141. ASM
  5142.  
  5143.   LES  DI, Buff         { make da es:di --> da buff  }
  5144.   MOV  CX, Count        { make cx         = da count }
  5145.   MOV  AX, W            { make ax         = word to compare to }
  5146.  
  5147.   CLD                   { go ever forward }
  5148.   REPE SCASW            { repeat while equal - compare to accumulator }
  5149.  
  5150.   JNE  @1               { if they were not equal, go on to @2 ... }
  5151.  
  5152.   XOR  AX, AX           { make ax = 0   ( "equal" flag ) }
  5153.   JMP  @2               { git on outa here }
  5154.  
  5155.  @1:
  5156.   MOV  AX, Count        { convert value to offset of miscompare }
  5157.   SUB  AX, CX           { ... }
  5158.  
  5159.  @2:
  5160.  
  5161. END;
  5162.  
  5163.  
  5164. {────────────────────────────────────────────────────────────────────────────}
  5165.  
  5166. (*-
  5167.  
  5168. [FUNCTION]
  5169.  
  5170. Function  LookupByte(                 InByte   : BYTE;
  5171.                                       Count    : WORD;
  5172.                                   Var LTable;
  5173.                                   Var OutByte  : BYTE              ) : BOOLEAN;
  5174.  
  5175. [PARAMETERS]
  5176.  
  5177. InByte      Source Byte to look up in Table
  5178. Count       Number of entries in the lookup table
  5179. LTable      Address of the lookup table
  5180. OutByte     Byte indentified by source byte in table
  5181.  
  5182. [RETURNS]
  5183.  
  5184. TRUE if the source byte was found in the table, FALSE if one was not.
  5185.  
  5186. [DESCRIPTION]
  5187.  
  5188. This function allow a quick lookup of a 2-byte record (the first byte
  5189. being the lookup key and the 2nd byte being the data to find).  The
  5190. actual record is set up as in the example below.  It is an array of
  5191. translation records (see example).
  5192.  
  5193. You pass in a prepared lookup table and ask it to find the data
  5194. associated with a specific "key".  This can be useful for such actions
  5195. as translation tables for error codes, etc.
  5196.  
  5197. [SEE-ALSO]
  5198.  
  5199. LookupWord
  5200.  
  5201. [EXAMPLE]
  5202.  
  5203. Type
  5204.   TTableRec = RECORD
  5205.     Key  : BYTE;
  5206.     Data : BYTE;
  5207.   END;
  5208.  
  5209.   TTable = Array[1..6] of TTableRec;
  5210.  
  5211. VAR
  5212.   T : TTable;
  5213.   B : BYTE;
  5214.  
  5215. BEGIN
  5216.  
  5217.   T[1].Key :=  0;   T[1].Data := 14;
  5218.   T[2].Key :=  3;   T[2].Data := 12;
  5219.   T[3].Key :=  7;   T[3].Data := 54;
  5220.   T[4].Key := 12;   T[4].Data :=  2;
  5221.   T[5].Key := 14;   T[5].Data :=  7;
  5222.   T[6].Key := 15;   T[6].Data :=  9;
  5223.  
  5224.   If LookupByte( 12, 6, @T, B ) Then
  5225.     WriteLn( 'Item Found in Table.  Data=',B )
  5226.   Else
  5227.     WriteLn( 'Item NOT Found in Table.' );
  5228.  
  5229.   {------------------------------------------------}
  5230.   { Output would be "Item Found in Table.  Data=2" }
  5231.   {------------------------------------------------}
  5232.  
  5233. END.
  5234.  
  5235. -*)
  5236.  
  5237. Function  LookupByte(                 InByte   : BYTE;
  5238.                                       Count    : WORD;
  5239.                                   Var LTable;
  5240.                                   Var OutByte  : BYTE              ) : BOOLEAN;
  5241. Assembler;
  5242. ASM
  5243.  
  5244.   LES  DI, LTable           { make da es:di --> da buff  }
  5245.   MOV  CX, Count            { make cx         = da count }
  5246.   MOV  AL, InByte           { make al         = byte to compare to }
  5247.  
  5248.   CLD                       { go ever forward }
  5249.  
  5250.  @Startloop:
  5251.   SCASB                     { compare ES:[DI] to in byte }
  5252.   JE   @Found               { If equal, jump to @Found   }
  5253.   SCASB                     { otherwise skip the next byte }
  5254.   LOOP @StartLoop           { and loop de loop ... }
  5255.  
  5256.   MOV  AX, 0                { we fell outa the loop; set return to FALSE }
  5257.   JMP  @Outahere            { E.T. goes home... }
  5258.  
  5259.  @Found:
  5260.  
  5261.   PUSH DS                   { save the ever important data seg }
  5262.  
  5263.   MOV  AL, byte PTR ES:[DI] { get the outbyte from da table }
  5264.  
  5265.   LDS  SI, OutByte          { make DS:SI --> outbyte var }
  5266.   MOV  byte PTR DS:[SI], AL { store the outbyte }
  5267.  
  5268.   MOV  AL, 1                { set return value to TRUE }
  5269.  
  5270.   POP DS
  5271.  
  5272.  @Outahere:
  5273.  
  5274. END;
  5275.  
  5276. {────────────────────────────────────────────────────────────────────────────}
  5277.  
  5278. (*-
  5279.  
  5280. [FUNCTION]
  5281.  
  5282. Function  LookupWord(                 InWord   : WORD;
  5283.                                       Count    : WORD;
  5284.                                   Var LTable;
  5285.                                   Var OutWord  : WORD              ) : BOOLEAN;
  5286.  
  5287. [PARAMETERS]
  5288.  
  5289. InWord      Source word to look up in table
  5290. Count       Number of entries in the lookup table
  5291. LTable      Address of the lookup table
  5292. OutWord     Word indentified by source byte in table
  5293.  
  5294. [RETURNS]
  5295.  
  5296. TRUE if the source word was found in the table, FALSE if one was not.
  5297.  
  5298. [DESCRIPTION]
  5299.  
  5300. This function allow a quick lookup of a 4-byte record (the first word
  5301. being the lookup key and the second word being the data to find).  The
  5302. actual record is set up as in the example below.  It is an array of
  5303. translation records (see example).
  5304.  
  5305. You pass in a prepared lookup table and ask it to find the data
  5306. associated with a specific "key".  This can be useful for such actions
  5307. as translation tables for error codes, etc.
  5308.  
  5309. [SEE-ALSO]
  5310.  
  5311. LookupWord
  5312.  
  5313. [EXAMPLE]
  5314.  
  5315. TYPE
  5316.   TTableRec = RECORD
  5317.     Key  : WORD;
  5318.     Data : WORD;
  5319.   END;
  5320.  
  5321.   TTable = Array[1..6] of TTableRec;
  5322.  
  5323. VAR
  5324.   T : TTable;
  5325.   W : WORD;
  5326.  
  5327. BEGIN
  5328.  
  5329.   T[1].Key :=  0;   T[1].Data := 14;
  5330.   T[2].Key :=  3;   T[2].Data := 12;
  5331.   T[3].Key :=  7;   T[3].Data := 54;
  5332.   T[4].Key := 12;   T[4].Data :=  2;
  5333.   T[5].Key := 14;   T[5].Data :=  7;
  5334.   T[6].Key := 15;   T[6].Data :=  9;
  5335.  
  5336.   If LookupByte( 12, 6, @T, B ) Then
  5337.     WriteLn( 'Item Found in Table.  Data=',B )
  5338.   Else
  5339.     WriteLn( 'Item NOT Found in Table.' );
  5340.  
  5341.   {------------------------------------------------}
  5342.   { Output would be "Item Found in Table.  Data=2" }
  5343.   {------------------------------------------------}
  5344.  
  5345. END.
  5346.  
  5347. -*)
  5348.  
  5349. Function  LookupWord(                 InWord   : WORD;
  5350.                                       Count    : WORD;
  5351.                                   Var LTable;
  5352.                                   Var OutWord  : WORD              ) : BOOLEAN;
  5353. Assembler;
  5354. ASM
  5355.  
  5356.   LES  DI, LTable           { make da es:di --> da buff  }
  5357.   MOV  CX, Count            { make cx         = da count }
  5358.   MOV  AX, InWord           { make al         = word to compare to }
  5359.  
  5360.   CLD                       { go ever forward }
  5361.  
  5362.  @Startloop:
  5363.   SCASW                     { compare ES:[DI] to in byte }
  5364.   JE   @Found               { If equal, jump to @Found   }
  5365.   SCASW                     { otherwise skip the next byte }
  5366.   LOOP @StartLoop           { and loop de loop ... }
  5367.  
  5368.   MOV  AX, 0                { we fell outa the loop; set return to FALSE }
  5369.   JMP  @Outahere            { E.T. goes home... }
  5370.  
  5371.  @Found:
  5372.  
  5373.   PUSH DS                   { save the ever important data seg }
  5374.  
  5375.   MOV  AX, word PTR ES:[DI] { get the outword from da table }
  5376.  
  5377.   LDS  SI, OutWord          { make DS:SI --> outword var }
  5378.   MOV  word PTR DS:[SI], AX { store the outword }
  5379.  
  5380.   MOV  AL, 1                { set return value to TRUE }
  5381.  
  5382.   POP DS
  5383.  
  5384.  @Outahere:
  5385.  
  5386. END;
  5387.  
  5388.  
  5389. {────────────────────────────────────────────────────────────────────────────}
  5390.  
  5391. (*-
  5392.  
  5393. [FUNCTION]
  5394.  
  5395. Procedure SwapBuffers(           Var Buf1;
  5396.                                  Var Buf2;
  5397.                                      Count     : WORD    );
  5398.  
  5399. [PARAMETERS]
  5400.  
  5401. Buf1        VAR Address of First buffer of data
  5402. Buf2        VAR Address of Second buffer of data
  5403. Count       Number of bytes to swap
  5404.  
  5405. [RETURNS]
  5406.  
  5407. (None)
  5408.  
  5409. [DESCRIPTION]
  5410.  
  5411. Swaps a given number of bytes between two types/untyped buffers.
  5412.  
  5413. [SEE-ALSO]
  5414.  
  5415. [EXAMPLE]
  5416.  
  5417. TYPE
  5418.   TBuff = ARRAY[1..10] of BYTE;
  5419.  
  5420. VAR
  5421.   B1,B2 : TBuff;
  5422.  
  5423. BEGIN
  5424.  
  5425.   FillChar( B1, SizeOf( B1 ), 1 );
  5426.   FillChar( B2, SizeOf( B2 ), 2 );
  5427.  
  5428.   SwapBuffers( B1,B2, SizeOf( TBuff ) );
  5429.  
  5430.   { B1 now filled with 2's and B2 filled with 1's }
  5431.  
  5432. END;
  5433.  
  5434. -*)
  5435.  
  5436.  
  5437. Procedure SwapBuffers(           Var Buf1;
  5438.                                  Var Buf2;
  5439.                                      Count     : WORD    );
  5440. Assembler;
  5441. ASM
  5442.  
  5443.   PUSH DS
  5444.  
  5445.   LES  DI, Buf1
  5446.   LDS  SI, Buf2
  5447.   MOV  CX, Count
  5448.  
  5449.  @1:
  5450.   MOV  AL, [SI]
  5451.   MOV  BL, ES:[DI]
  5452.  
  5453.   MOV  [SI], BL
  5454.   MOV  ES:[DI], AL
  5455.  
  5456.   INC  SI
  5457.   INC  DI
  5458.  
  5459.   LOOP @1
  5460.  
  5461.   POP  DS
  5462.  
  5463. END;
  5464.  
  5465. {────────────────────────────────────────────────────────────────────────────}
  5466.  
  5467. (*-
  5468.  
  5469. [FUNCTION]
  5470.  
  5471. Procedure SwapWords(             Var A,
  5472.                                      B         : WORD    );
  5473.  
  5474. [PARAMETERS]
  5475.  
  5476. A           VAR First word to swap
  5477. B           VAR Second word to swap
  5478.  
  5479. [RETURNS]
  5480.  
  5481. (None)
  5482.  
  5483. [DESCRIPTION]
  5484.  
  5485. Executes a bufferless two-word swap
  5486.  
  5487. [SEE-ALSO]
  5488.  
  5489. SwapInts
  5490. SwapBytes
  5491.  
  5492. [EXAMPLE]
  5493.  
  5494. VAR
  5495.   W1,W2 : WORD;
  5496.  
  5497. BEGIN
  5498.  
  5499.   W1 := 5;
  5500.   W2 := 3;
  5501.  
  5502.   SwapWords( W1, W2 );
  5503.  
  5504.   { W1 = 3, W2 = 5 }
  5505.  
  5506. END;
  5507.  
  5508. -*)
  5509.  
  5510. Procedure SwapWords(             Var A,
  5511.                                      B         : WORD    );
  5512. Assembler;
  5513. ASM
  5514.  
  5515.   PUSH DS
  5516.  
  5517.  
  5518.   LDS  SI, A
  5519.   LES  DI, B
  5520.  
  5521.   MOV  AX, [DS:SI]
  5522.   MOV  BX, [ES:DI]
  5523.  
  5524.   MOV  word PTR ES:DI, AX
  5525.   MOV  word PTR DS:SI, BX
  5526.  
  5527.   POP  DS
  5528.  
  5529. END;
  5530.  
  5531. {────────────────────────────────────────────────────────────────────────────}
  5532.  
  5533. (*-
  5534.  
  5535. [FUNCTION]
  5536.  
  5537. Procedure SwapInts(              Var A,
  5538.                                      B         : INTEGER );
  5539.  
  5540. [PARAMETERS]
  5541.  
  5542. A           VAR First integer to swap
  5543. B           VAR Second integer to swap
  5544.  
  5545. [RETURNS]
  5546.  
  5547. (None)
  5548.  
  5549. [DESCRIPTION]
  5550.  
  5551. Executes a bufferless two-integer swap
  5552.  
  5553. [SEE-ALSO]
  5554.  
  5555. SwapWords
  5556. SwapBytes
  5557.  
  5558. [EXAMPLE]
  5559.  
  5560. VAR
  5561.   I1,I2 : INTEGER;
  5562.  
  5563. BEGIN
  5564.  
  5565.   I1 :=  5;
  5566.   I2 := -3;
  5567.  
  5568.   SwapInts( I1, I2 );
  5569.  
  5570.   { I1 = -3; I2 = 5 }
  5571.  
  5572. END;
  5573.  
  5574. -*)
  5575.  
  5576. Procedure SwapInts(              Var A,
  5577.                                      B         : INTEGER  );
  5578. Assembler;
  5579. ASM
  5580.  
  5581.   PUSH DS
  5582.  
  5583.   LDS  SI, A
  5584.   LES  DI, B
  5585.  
  5586.   MOV  AX, [DS:SI]
  5587.   MOV  BX, [ES:DI]
  5588.  
  5589.   MOV  word PTR ES:DI, AX
  5590.   MOV  word PTR DS:SI, BX
  5591.  
  5592.   POP  DS
  5593.  
  5594. END;
  5595.  
  5596. {────────────────────────────────────────────────────────────────────────────}
  5597.  
  5598. (*-
  5599.  
  5600. [FUNCTION]
  5601.  
  5602. Procedure SwapBytes(             Var A,
  5603.                                      B         : BYTE    );
  5604.  
  5605. [PARAMETERS]
  5606.  
  5607. A           VAR First byte to swap
  5608. B           VAR Second byte to swap
  5609.  
  5610. [RETURNS]
  5611.  
  5612. (None)
  5613.  
  5614. [DESCRIPTION]
  5615.  
  5616. Executes a Bufferless 2-Byte swap
  5617.  
  5618. [SEE-ALSO]
  5619.  
  5620. SwapWords
  5621. SwapInts
  5622.  
  5623. [EXAMPLE]
  5624.  
  5625. VAR
  5626.   B1,B2 : BYTE;
  5627.  
  5628. BEGIN
  5629.  
  5630.   B1 := 5;
  5631.   B2 := 3;
  5632.  
  5633.   SwapBytes( B1, B2 );
  5634.  
  5635.   { B1 = 3, B2 = 5 }
  5636.  
  5637. END;
  5638.  
  5639. -*)
  5640.  
  5641. Procedure SwapBytes(             Var A,
  5642.                                      B         : BYTE    );
  5643. Assembler;
  5644. ASM
  5645.  
  5646.   PUSH DS
  5647.  
  5648.   MOV  DS, word PTR [A+2]
  5649.   MOV  SI, word PTR [A]
  5650.  
  5651.   MOV  ES, word PTR [B+2]
  5652.   MOV  DI, word PTR [B]
  5653.  
  5654.   MOV  AL, [DS:SI]
  5655.   MOV  BL, [ES:DI]
  5656.  
  5657.   MOV  byte PTR ES:DI, AL
  5658.   MOV  byte PTR DS:SI, BL
  5659.  
  5660.   POP  DS
  5661.  
  5662. END;
  5663.  
  5664. {────────────────────────────────────────────────────────────────────────────}
  5665.  
  5666. (*-
  5667.  
  5668. [FUNCTION]
  5669.  
  5670. Function  GreaterInt(                A,
  5671.                                      B         : INTEGER ) : INTEGER;
  5672.  
  5673. [PARAMETERS]
  5674.  
  5675. A           First integer to compare
  5676. B           Second integer to compare
  5677.  
  5678. [RETURNS]
  5679.  
  5680. Greater of the two provided integer
  5681.  
  5682. [DESCRIPTION]
  5683.  
  5684. Compares two integer and returns the greater.
  5685.  
  5686. [SEE-ALSO]
  5687.  
  5688. GreaterWord
  5689. GreaterLong
  5690. LesserInt
  5691. LesserWord
  5692. LesserLong
  5693.  
  5694. [EXAMPLE]
  5695.  
  5696. VAR
  5697.   I1,I2,I3 : INTEGER;
  5698.  
  5699. BEGIN
  5700.  
  5701.   I1 :=  5;
  5702.   I2 := -3;
  5703.  
  5704.   I3 := GreaterInt( I1, I2 );
  5705.  
  5706.   { I3 = 5 }
  5707.  
  5708. END;
  5709.  
  5710. -*)
  5711.  
  5712. Function  GreaterInt(                A,
  5713.                                      B         : INTEGER  ) : INTEGER;
  5714.  
  5715. BEGIN
  5716.  
  5717.   If A > B Then
  5718.     GreaterInt := A
  5719.   Else
  5720.     GreaterInt := B;
  5721.  
  5722. END;
  5723.  
  5724. {────────────────────────────────────────────────────────────────────────────}
  5725.  
  5726. (*-
  5727.  
  5728. [FUNCTION]
  5729.  
  5730. Function  GreaterWord(               A,
  5731.                                      B         : WORD    ) : WORD;
  5732.  
  5733. [PARAMETERS]
  5734.  
  5735. A           First word to compare
  5736. B           Second word to compare
  5737.  
  5738. [RETURNS]
  5739.  
  5740. Greater of the two provided words
  5741.  
  5742. [DESCRIPTION]
  5743.  
  5744. Compares two words and returns the greater.
  5745.  
  5746. [SEE-ALSO]
  5747.  
  5748. GreaterInt
  5749. GreaterLong
  5750. LesserInt
  5751. LesserWord
  5752. LesserLong
  5753.  
  5754. [EXAMPLE]
  5755.  
  5756. VAR
  5757.   W1,W2,W3 : INTEGER;
  5758.  
  5759. BEGIN
  5760.  
  5761.   W1 := 5;
  5762.   W2 := 3;
  5763.  
  5764.   W3 := GreaterWord( W1, W2 );
  5765.  
  5766.   { W3 = 5 }
  5767.  
  5768. END;
  5769.  
  5770. -*)
  5771.  
  5772. Function  GreaterWord(               A,
  5773.                                      B         : WORD    ) : WORD;
  5774.  
  5775. Assembler;
  5776. ASM
  5777.  
  5778.   MOV  AX, A
  5779.   CMP  AX, B
  5780.   JAE  @ABOVE
  5781.   MOV  AX, B
  5782.  
  5783.  @ABOVE:
  5784.  
  5785. END;
  5786.  
  5787. {────────────────────────────────────────────────────────────────────────────}
  5788.  
  5789. (*-
  5790.  
  5791. [FUNCTION]
  5792.  
  5793. Function  GreaterLong(               A,
  5794.                                      B         : LONGINT ) : LONGINT;
  5795.  
  5796. [PARAMETERS]
  5797.  
  5798. A           First longint (signed double word) to compare
  5799. B           Second longint to compare
  5800.  
  5801. [RETURNS]
  5802.  
  5803. Greater of the two provided longints
  5804.  
  5805. [DESCRIPTION]
  5806.  
  5807. Compares two longints (signed double words) and returns the greater
  5808.  
  5809. [SEE-ALSO]
  5810.  
  5811. GreaterInt
  5812. GreaterWord
  5813. LesserInt
  5814. LesserWord
  5815. LesserLong
  5816.  
  5817. [EXAMPLE]
  5818.  
  5819. VAR
  5820.   L1,L2,L3 : INTEGER;
  5821.  
  5822. BEGIN
  5823.  
  5824.   L1 := 5;
  5825.   L2 := 3;
  5826.  
  5827.   L3 := GreaterLong( L1, L2 );
  5828.  
  5829.   { L3 = 5 }
  5830.  
  5831. END;
  5832.  
  5833. -*)
  5834.  
  5835. Function  GreaterLong(               A,
  5836.                                      B         : LONGINT  ) : LONGINT;
  5837.  
  5838. BEGIN
  5839.  
  5840.   If A > B Then
  5841.     GreaterLong := A
  5842.   Else
  5843.     GreaterLong := B;
  5844.  
  5845. END;
  5846.  
  5847. {────────────────────────────────────────────────────────────────────────────}
  5848.  
  5849. (*-
  5850.  
  5851. [FUNCTION]
  5852.  
  5853. Function  LesserInt(                 A,
  5854.                                      B         : INTEGER ) : INTEGER;
  5855.  
  5856. [PARAMETERS]
  5857.  
  5858. A           First integer to compare
  5859. B           Second integer to compare
  5860.  
  5861. [RETURNS]
  5862.  
  5863. Lesser of the two integers
  5864.  
  5865. [DESCRIPTION]
  5866.  
  5867. Compares two integers and returns the lesser
  5868.  
  5869. [SEE-ALSO]
  5870.  
  5871. GreaterInt
  5872. GreaterWord
  5873. GreaterLong
  5874. LesserWord
  5875. LesserLong
  5876.  
  5877. [EXAMPLE]
  5878.  
  5879. VAR
  5880.   I1,I2,I3 : INTEGER;
  5881.  
  5882. BEGIN
  5883.  
  5884.   I1 :=  5;
  5885.   I2 := -3;
  5886.  
  5887.   I3 := LesserLong( I1, I2 );
  5888.  
  5889.   { I3 = -3 }
  5890.  
  5891. END;
  5892.  
  5893. -*)
  5894.  
  5895. Function  LesserInt(                 A,
  5896.                                      B         : INTEGER  ) : INTEGER;
  5897.  
  5898. BEGIN
  5899.  
  5900.   If ( A < B ) Then
  5901.     LesserInt := A
  5902.   Else
  5903.     LesserInt := B;
  5904.  
  5905. END;
  5906.  
  5907. {────────────────────────────────────────────────────────────────────────────}
  5908.  
  5909. (*-
  5910.  
  5911. [FUNCTION]
  5912.  
  5913. Function  LesserWord(                A,
  5914.                                      B         : WORD    ) : WORD;
  5915.  
  5916. [PARAMETERS]
  5917.  
  5918. A           First word to compare
  5919. B           Second word to compare
  5920.  
  5921. [RETURNS]
  5922.  
  5923. Lesser of the two words
  5924.  
  5925. [DESCRIPTION]
  5926.  
  5927. Compares two words and returns the lesser
  5928.  
  5929. [SEE-ALSO]
  5930.  
  5931. GreaterInt
  5932. GreaterWord
  5933. GreaterLong
  5934. LesserInt
  5935. LesserLong
  5936.  
  5937. [EXAMPLE]
  5938.  
  5939. VAR
  5940.   W1,W2,W3 : WORD;
  5941.  
  5942. BEGIN
  5943.  
  5944.   W1 := 5;
  5945.   W2 := 3;
  5946.  
  5947.   W3 := LesserWord( W1, W2 );
  5948.  
  5949.   { W3 = 3 }
  5950.  
  5951. END;
  5952.  
  5953. -*)
  5954.  
  5955. Function  LesserWord(                A,
  5956.                                      B         : WORD    ) : WORD;
  5957. Assembler;
  5958. ASM
  5959.  
  5960.   MOV  AX, A
  5961.   MOV  BX, B
  5962.  
  5963.   CMP  AX, BX
  5964.   JNA  @2
  5965.  
  5966.   MOV  AX, BX
  5967.  
  5968.  @2:
  5969.  
  5970. END;
  5971.  
  5972. {────────────────────────────────────────────────────────────────────────────}
  5973.  
  5974. (*-
  5975.  
  5976. [FUNCTION]
  5977.  
  5978. Function  LesserLong(                A,
  5979.                                      B         : LONGINT ) : LONGINT;
  5980.  
  5981. [PARAMETERS]
  5982.  
  5983. A           First longint (double word) to compare
  5984. B           Second longint to compare
  5985.  
  5986. [RETURNS]
  5987.  
  5988. Lesser of the two longints
  5989.  
  5990. [DESCRIPTION]
  5991.  
  5992. Compares two longints (signed double words) and returns the lesser
  5993.  
  5994. [SEE-ALSO]
  5995.  
  5996. GreaterInt
  5997. GreaterWord
  5998. GreaterLong
  5999. LesserInt
  6000. LesserWord
  6001.  
  6002. [EXAMPLE]
  6003.  
  6004. VAR
  6005.   L1,L2,L3 : INTEGER;
  6006.  
  6007. BEGIN
  6008.  
  6009.   L1 := 5;
  6010.   L2 := 3;
  6011.  
  6012.   L3 := LesserLong( L1, L2 );
  6013.  
  6014.   { L3 = 3 }
  6015.  
  6016. END;
  6017.  
  6018. -*)
  6019.  
  6020. Function LesserLong(                 A,
  6021.                                      B         : LONGINT ) : LONGINT;
  6022.  
  6023. BEGIN
  6024.  
  6025.   If ( A < B ) Then
  6026.     LesserLong := A
  6027.   Else
  6028.     LesserLong := B;
  6029.  
  6030. END;  { LesserLong }
  6031.  
  6032. {────────────────────────────────────────────────────────────────────────────}
  6033.  
  6034. (*-
  6035.  
  6036. [FUNCTION]
  6037.  
  6038. Procedure FillWord(              Var Buf;
  6039.                                      Count     : WORD;
  6040.                                      Value     : WORD    );
  6041. [PARAMETERS]
  6042.  
  6043. Buf         VAR Address of untyped Buffer to fill
  6044. Count       Number of Words to Fill
  6045. Value       Word Value to fill Buffer with
  6046.  
  6047. [RETURNS]
  6048.  
  6049. Function : None
  6050. (Var     : [Buf] Buffer fill with Value)
  6051.  
  6052. [DESCRIPTION]
  6053.  
  6054. Takes an Untyped Buffer and fills it with a given Word Value "Value"
  6055. up to the number of Words given in "Count".  This is the same thing
  6056. as PASCAL's FillChar except it allows you to fill with 2-Byte Patterns
  6057. instead.
  6058.  
  6059. WARNING: Make sure Count Represents Buffer Size in Terms of 2-Byte
  6060. Words rather than simply the number of bytes of the Buffer.  Otherwise
  6061. this may result in a buffer overrun, potentially overwritting other
  6062. data in memory.
  6063.  
  6064. [SEE-ALSO]
  6065.  
  6066. FillLong
  6067.  
  6068. [EXAMPLE]
  6069.  
  6070. TYPE
  6071.   TBuff = ARRAY[1..12] of BYTE;
  6072.  
  6073. VAR
  6074.   B : TBuff;
  6075.  
  6076. BEGIN
  6077.  
  6078.   FillWord( B, SizeOf( B ) DIV 2, $1234 );
  6079.  
  6080.   { Entire Buffer (B) Filled with 2-Byte Value $1234 }
  6081.  
  6082. END;
  6083.  
  6084. -*)
  6085.  
  6086.  
  6087. Procedure FillWord(              Var Buf;
  6088.                                      Count     : WORD;
  6089.                                      Value     : WORD    );
  6090. Assembler;
  6091. ASM
  6092.  
  6093.   LES DI, Buf
  6094.   MOV AX, Value
  6095.   MOV CX, Count
  6096.  
  6097.   CLD
  6098.   REP STOSW
  6099.  
  6100. END;
  6101.  
  6102. {────────────────────────────────────────────────────────────────────────────}
  6103.  
  6104. (*-
  6105.  
  6106. Procedure FillLong(              Var Buf;
  6107.                                      Count     : WORD;
  6108.                                      Value     : LONGINT );
  6109. [PARAMETERS]
  6110.  
  6111. Buf         VAR Address of untyped Buffer to fill
  6112. Count       Number of Words to Fill
  6113. Value       Longint Value to fill Buffer with
  6114.  
  6115. [RETURNS]
  6116.  
  6117. Function : None
  6118. (Var     : [Buf] Buffer fill with Value)
  6119.  
  6120. [DESCRIPTION]
  6121.  
  6122. Takes an Untyped Buffer and fills it with a given Longint Value "Value"
  6123. up to the number of Longints given in "Count".  This is the same thing
  6124. as PASCAL's FillChar except it allows you to fill with 4-Byte Patterns
  6125. instead.
  6126.  
  6127. WARNING: Make sure Count Represents Buffer Size in Terms of 4-Byte
  6128. Words rather than simply the number of bytes of the Buffer.  Otherwise
  6129. this may result in a buffer overrun, potentially overwritting other
  6130. data in memory.
  6131.  
  6132. [SEE-ALSO]
  6133.  
  6134. FillWord
  6135.  
  6136. [EXAMPLE]
  6137.  
  6138. TYPE
  6139.   TBuff = ARRAY[1..12] of BYTE;
  6140.  
  6141. VAR
  6142.   B : TBuff;
  6143.  
  6144. BEGIN
  6145.  
  6146.   FillWord( B, SizeOf( B ) DIV 4, $12345678 );
  6147.  
  6148.   { Entire Buffer (B) Filled with 4-Byte Value $12345678 }
  6149.  
  6150. END;
  6151.  
  6152. -*)
  6153.  
  6154. Procedure FillLong(              Var Buf;
  6155.                                      Count     : WORD;
  6156.                                      Value     : LONGINT    );
  6157. Assembler;
  6158. ASM
  6159.  
  6160.   LES DI, Buf
  6161.   MOV AX, Word(Value)
  6162.   MOV BX, Word(Value+2)
  6163.   MOV CX, Count
  6164.  
  6165.   CLD
  6166.  
  6167. @@1:
  6168.  
  6169.   STOSW           { store the lower word   }
  6170.   XCHG AX,BX      { exchange low/high word }
  6171.   STOSW           { store the high  word   }
  6172.   XCHG AX,BX      { swap em back           }
  6173.  
  6174.   LOOP @@1        { loop de loop ...       }
  6175.  
  6176. END;
  6177.  
  6178.  
  6179. {────────────────────────────────────────────────────────────────────────────}
  6180.  
  6181. (*-
  6182.  
  6183. [FUNCTION]
  6184.  
  6185. Procedure RebootMachine(             WarmBoot : BOOLEAN );
  6186.  
  6187. [PARAMETERS]
  6188.  
  6189. WarmBoot   TRUE to warmboot machine,
  6190.            FALSE to coldboot (do post and memory checks)
  6191.  
  6192.  
  6193. [RETURNS]
  6194.  
  6195. (None)
  6196.  
  6197. [DESCRIPTION]
  6198.  
  6199. Reboots the system.
  6200.  
  6201. NOTE:  On AT and compatible machines, the keyboard controler is wired
  6202. to the CPUs reboot line.  In this routine we reboot the machine by
  6203. telling the keyboard controller to "wiggle" the reboot line.  This is
  6204. the same thing that the code at $FFFF:0 does.  We program the reboot
  6205. directly instead of jumping to $FFFF:0 to avoid any DPMI calls that
  6206. would be otherwise necessary in protected mode / Windows.
  6207.  
  6208. [SEE-ALSO]
  6209.  
  6210. [EXAMPLE]
  6211.  
  6212.  
  6213. BEGIN
  6214.  
  6215.   WriteLn( 'Ready to Reboot your System.' );
  6216.   WriteLn( 'Press "W" to WarmBoot, otherwise will Coldboot' );
  6217.  
  6218.   RebootMachine( UpCase( ReadKey ) = 'W' );
  6219.  
  6220. END;
  6221.  
  6222. -*)
  6223.  
  6224.  
  6225. Procedure RebootMachine(   WarmBoot : BOOLEAN );
  6226.  
  6227. BEGIN
  6228.  
  6229.   {$IFDEF OS2}
  6230.  
  6231.   {$ELSE}
  6232.     If WarmBoot Then
  6233.       BiosMemMap^.PostReset := $1234
  6234.     Else
  6235.       BiosMemMap^.PostReset := $0000;
  6236.  
  6237.     ASM
  6238.  
  6239.       MOV     dx, 70h
  6240.       MOV     al, 0Fh
  6241.       OUT     dx, al
  6242.       INC     dx
  6243.       XOR     al, al
  6244.       OUT     dx, al
  6245.       DEC     ax
  6246.  
  6247.       MOV     al, 0FEh
  6248.       MOV     dx, 64h
  6249.       OUT     dx, al
  6250.  
  6251.     END;
  6252.  
  6253.   {$ENDIF}
  6254.  
  6255. END;
  6256.  
  6257. {────────────────────────────────────────────────────────────────────────────}
  6258.  
  6259.  
  6260.  
  6261. (*-
  6262.  
  6263. [FUNCTION]
  6264.  
  6265. Procedure CRC16Char(           Var Ch          : CHAR;
  6266.                                Var Result      : WORD );
  6267.  
  6268. [PARAMETERS]
  6269.  
  6270. Ch          VAR Address of Source Byte to CRC
  6271. Result      VAR Returned 16-Bit CRC Checksum on Source Byte
  6272.  
  6273. [RETURNS]
  6274.  
  6275. Function : None
  6276. (Var     : [Result] Returned 16-Bit CRC Checksum on Source Byte)
  6277.  
  6278. [DESCRIPTION]
  6279.  
  6280. [SEE-ALSO]
  6281.  
  6282. CRC16String
  6283. CRC16Buffer
  6284. CRC32Char
  6285. CRC32String
  6286. CRC32Buffer
  6287.  
  6288. [EXAMPLE]
  6289.  
  6290. VAR
  6291.   Ch    : CHAR;
  6292.   CRC16 : WORD;
  6293.  
  6294. BEGIN
  6295.  
  6296.   Ch := 'A';
  6297.  
  6298.   CRC16Char( Ch, CRC16 );
  6299.  
  6300.   { CRC16 = $0041 }
  6301.  
  6302. END;
  6303.  
  6304. -*)
  6305.  
  6306. Procedure CRC16Char(           Var Ch          : CHAR;
  6307.                                Var Result      : WORD );
  6308.  
  6309. CONST
  6310.  
  6311.   {────────────────────────────────────────────────────────────────────────
  6312.  
  6313.   updcrc derived from article Copyright (C) 1986 Stephen Satchell.
  6314.   NOTE: First argument must be in range 0 to 255.
  6315.         Second argument is referenced twice.
  6316.  
  6317.   Programmers may incorporate any or all code into their programs,
  6318.   giving proper credit within the source. Publication of the
  6319.   source routines is permitted so long as proper credit is given
  6320.   to Stephen Satchell, Satchell Evaluations and Chuck Forsberg,
  6321.   Omen Technology.
  6322.  
  6323.   crctab calculated by Mark G. Mendel, Network Systems Corporation
  6324.  
  6325.   ────────────────────────────────────────────────────────────────────────}
  6326.  
  6327.   CRCTab16 : Array[Byte] of WORD =
  6328.  
  6329.    ($0000, $1021, $2042, $3063, $4084, $50A5, $60C6, $70E7,
  6330.     $8108, $9129, $A14A, $B16B, $C18C, $D1AD, $E1CE, $F1EF,
  6331.     $1231, $0210, $3273, $2252, $52B5, $4294, $72F7, $62D6,
  6332.     $9339, $8318, $B37B, $A35A, $D3BD, $C39C, $F3FF, $E3DE,
  6333.     $2462, $3443, $0420, $1401, $64E6, $74C7, $44A4, $5485,
  6334.     $A56A, $B54B, $8528, $9509, $E5EE, $F5CF, $C5AC, $D58D,
  6335.     $3653, $2672, $1611, $0630, $76D7, $66F6, $5695, $46B4,
  6336.     $B75B, $A77A, $9719, $8738, $F7DF, $E7FE, $D79D, $C7BC,
  6337.     $48C4, $58E5, $6886, $78A7, $0840, $1861, $2802, $3823,
  6338.     $C9CC, $D9ED, $E98E, $F9AF, $8948, $9969, $A90A, $B92B,
  6339.     $5AF5, $4AD4, $7AB7, $6A96, $1A71, $0A50, $3A33, $2A12,
  6340.     $DBFD, $CBDC, $FBBF, $EB9E, $9B79, $8B58, $BB3B, $AB1A,
  6341.     $6CA6, $7C87, $4CE4, $5CC5, $2C22, $3C03, $0C60, $1C41,
  6342.     $EDAE, $FD8F, $CDEC, $DDCD, $AD2A, $BD0B, $8D68, $9D49,
  6343.     $7E97, $6EB6, $5ED5, $4EF4, $3E13, $2E32, $1E51, $0E70,
  6344.     $FF9F, $EFBE, $DFDD, $CFFC, $BF1B, $AF3A, $9F59, $8F78,
  6345.     $9188, $81A9, $B1CA, $A1EB, $D10C, $C12D, $F14E, $E16F,
  6346.     $1080, $00A1, $30C2, $20E3, $5004, $4025, $7046, $6067,
  6347.     $83B9, $9398, $A3FB, $B3DA, $C33D, $D31C, $E37F, $F35E,
  6348.     $02B1, $1290, $22F3, $32D2, $4235, $5214, $6277, $7256,
  6349.     $B5EA, $A5CB, $95A8, $8589, $F56E, $E43F, $D52C, $C50D,
  6350.     $34E2, $24C3, $14A0, $0481, $7466, $6447, $5424, $4405,
  6351.     $A7DB, $B7FA, $8799, $97B8, $E75F, $F77E, $C71D, $D73C,
  6352.     $26D3, $36F2, $0691, $16B0, $6657, $7676, $4615, $5634,
  6353.     $D94C, $C96D, $F90E, $E92F, $99C8, $89E9, $B98A, $A9AB,
  6354.     $5844, $4865, $7806, $6827, $18C0, $08E1, $3882, $28A3,
  6355.     $CB7D, $DB5C, $EB3F, $FB1E, $8BF9, $9BD8, $ABBB, $BB9A,
  6356.     $4A75, $5A54, $6A37, $7A16, $0AF1, $1AD0, $2AB3, $3A92,
  6357.     $FD2E, $ED0F, $DD6C, $CD4D, $BDAA, $AD8B, $9DE8, $8DC9,
  6358.     $7C26, $6C07, $5C64, $4C45, $3CA2, $2C83, $1CE0, $0CC1,
  6359.     $EF1F, $FF3E, $CF5D, $DF7C, $AF9B, $BFBA, $8FD9, $9FF8,
  6360.     $6E17, $7E36, $4E55, $5E74, $2E93, $3EB2, $0ED1, $1EF0);
  6361.  
  6362. BEGIN
  6363.  
  6364.   Result := CRCTab16[(Result SHR 8) AND $FF] XOR (Result SHL 8) XOR Byte(Ch);
  6365.  
  6366. END;
  6367.  
  6368. {────────────────────────────────────────────────────────────────────────────}
  6369.  
  6370. (*-
  6371.  
  6372. [FUNCTION]
  6373.  
  6374. Procedure CRC16Buffer(         Var Buf;
  6375.                                    Count       : WORD;
  6376.                                Var Result      : WORD );
  6377.  
  6378. [PARAMETERS]
  6379.  
  6380. Buf         VAR Address of untyped Data Buffer to CRC
  6381. Count       Number of bytes in Data Buffer
  6382. Result      VAR 16-bit CRC totals on Data Buffer
  6383.  
  6384. [RETURNS]
  6385.  
  6386. Function : None
  6387. (Var     : [Result] 16-bit CRC on the Buffer)
  6388.  
  6389. [DESCRIPTION]
  6390.  
  6391. [SEE-ALSO]
  6392.  
  6393. CRC16Char
  6394. CRC16String
  6395. CRC32Char
  6396. CRC32String
  6397. CRC32Buffer
  6398.  
  6399. [EXAMPLE]
  6400.  
  6401. TYPE
  6402.   TBuff = ARRAY[1..10] of BYTE;
  6403.  
  6404. VAR
  6405.   B     : TBuff;
  6406.   CRC16 : WORD;
  6407.  
  6408. BEGIN
  6409.  
  6410.   FillChar( B, SizeOf( B ), $04 );
  6411.   CRC16 := 0;
  6412.  
  6413.   CRC16Buffer( B, SizeOf( B ), CRC16 );
  6414.  
  6415.   { CRC16 = $43D3 }
  6416.  
  6417. END;
  6418.  
  6419. -*)
  6420.  
  6421. Procedure CRC16Buffer(         Var Buf;
  6422.                                    Count       : WORD;
  6423.                                Var Result      : WORD );
  6424.  
  6425. Var
  6426.  
  6427.   I    : WORD;
  6428.  
  6429. BEGIN
  6430.  
  6431.   For I := 0 to Count Do
  6432.     CRC16Char( Char(TByteArray(Buf)[I]), Result );
  6433.  
  6434. END;
  6435.  
  6436. {────────────────────────────────────────────────────────────────────────────}
  6437.  
  6438. (*-
  6439.  
  6440. [FUNCTION]
  6441.  
  6442. Procedure CRC32Char(           Var Ch          : CHAR;
  6443.                                Var Result      : LONGINT );
  6444.  
  6445. [PARAMETERS]
  6446.  
  6447. Ch          VAR Address of Source Byte to CRC
  6448. Result      VAR Returned 32-Bit CRC Checksum on Source Byte
  6449.  
  6450. [RETURNS]
  6451.  
  6452. Function : None
  6453. (Var     : [Result] 32-Bit CRC Checksum on Source Byte)
  6454.  
  6455. [DESCRIPTION]
  6456.  
  6457. [SEE-ALSO]
  6458.  
  6459. CRC16Char
  6460. CRC16String
  6461. CRC16Buffer
  6462. CRC32String
  6463. CRC32Buffer
  6464.  
  6465. [EXAMPLE]
  6466.  
  6467. VAR
  6468.   Ch    : CHAR;
  6469.   CRC32 : LONGINT;
  6470.  
  6471. BEGIN
  6472.  
  6473.   Ch := 'A';
  6474.  
  6475.   CRC32Char( Ch, CRC32 );
  6476.  
  6477.   { CRC32 = $01DB7106 }
  6478.  
  6479. END;
  6480.  
  6481. -*)
  6482.  
  6483. Procedure CRC32Char(           Var Ch          : CHAR;
  6484.                                Var Result      : LONGINT );
  6485.  
  6486. CONST
  6487.  
  6488.   {────────────────────────────────────────────────────────────────────────
  6489.  
  6490.   Copyright (C) 1986 Gary S. Brown.  You may use this program, or
  6491.   code or tables extracted from it, as desired without restriction.
  6492.  
  6493.   ────────────────────────────────────────────────────────────────────────}
  6494.  
  6495.   CRCTab32 : Array[Byte] of LONGINT =
  6496.  
  6497.  ($00000000, $77073096, $EE0E612C, $990951BA, $076DC419, $706AF48F, $E963A535, $9E6495A3,
  6498.   $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, $09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
  6499.   $1DB71064, $6AB020F2, $F3B97148, $84BE41DE, $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
  6500.   $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC, $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
  6501.   $3B6E20C8, $4C69105E, $D56041E4, $A2677172, $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
  6502.   $35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940, $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
  6503.   $26D930AC, $51DE003A, $C8D75180, $BFD06116, $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
  6504.   $2802B89E, $5F058808, $C60CD9B2, $B10BE924, $2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
  6505.   $76DC4190, $01DB7106, $98D220BC, $EFD5102A, $71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
  6506.   $7807C9A2, $0F00F934, $9609A88E, $E10E9818, $7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
  6507.   $6B6B51F4, $1C6C6162, $856530D8, $F262004E, $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
  6508.   $65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C, $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
  6509.   $4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2, $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
  6510.   $4369E96A, $346ED9FC, $AD678846, $DA60B8D0, $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
  6511.   $5005713C, $270241AA, $BE0B1010, $C90C2086, $5768B525, $206F85B3, $B966D409, $CE61E49F,
  6512.   $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, $59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
  6513.   $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A, $EAD54739, $9DD277AF, $04DB2615, $73DC1683,
  6514.   $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8, $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
  6515.   $F00F9344, $8708A3D2, $1E01F268, $6906C2FE, $F762575D, $806567CB, $196C3671, $6E6B06E7,
  6516.   $FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC, $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
  6517.   $D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252, $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
  6518.   $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, $DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
  6519.   $CB61B38C, $BC66831A, $256FD2A0, $5268E236, $CC0C7795, $BB0B4703, $220216B9, $5505262F,
  6520.   $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04, $C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
  6521.   $9B64C2B0, $EC63F226, $756AA39C, $026D930A, $9C0906A9, $EB0E363F, $72076785, $05005713,
  6522.   $95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38, $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
  6523.   $86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E, $81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
  6524.   $88085AE6, $FF0F6A70, $66063BCA, $11010B5C, $8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
  6525.   $A00AE278, $D70DD2EE, $4E048354, $3903B3C2, $A7672661, $D06016F7, $4969474D, $3E6E77DB,
  6526.   $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, $A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
  6527.   $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, $BAD03605, $CDD70693, $54DE5729, $23D967BF,
  6528.   $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94, $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
  6529.  
  6530. BEGIN
  6531.  
  6532.   Result := CRCTab32[(Result XOR Byte(Ch)) AND $FF] XOR (Result SHR 8);
  6533.  
  6534. END;
  6535.  
  6536. {────────────────────────────────────────────────────────────────────────────}
  6537.  
  6538. (*-
  6539.  
  6540. [FUNCTION]
  6541.  
  6542. Procedure CRC32Buffer(         Var Buf;
  6543.                                    Count       : WORD;
  6544.                                Var Result      : LONGINT );
  6545.  
  6546. [PARAMETERS]
  6547.  
  6548. [RETURNS]
  6549.  
  6550. [DESCRIPTION]
  6551.  
  6552. [SEE-ALSO]
  6553.  
  6554. CRC16Char
  6555. CRC16String
  6556. CRC16Buffer
  6557. CRC32Char
  6558. CRC32String
  6559.  
  6560. [EXAMPLE]
  6561.  
  6562. TYPE
  6563.   TBuff = ARRAY[1..10] of BYTE;
  6564.  
  6565. VAR
  6566.   B     : TBuff;
  6567.   CRC32 : LONGINT;
  6568.  
  6569. BEGIN
  6570.  
  6571.   FillChar( B, SizeOf( B ), $04 );
  6572.   CRC32 := 0;
  6573.  
  6574.   CRC32Buffer( B, SizeOf( B ), CRC32 );
  6575.  
  6576.   { CRC32 = $1716C742 }
  6577.  
  6578. END;
  6579. -*)
  6580.  
  6581. Procedure CRC32Buffer(         Var Buf;
  6582.                                    Count       : WORD;
  6583.                                Var Result      : LONGINT );
  6584.  
  6585. Var
  6586.  
  6587.   I    : WORD;
  6588.  
  6589. BEGIN
  6590.  
  6591.   For I := 0 to Count Do
  6592.     CRC32Char( Char(TByteArray(Buf)[I]), Result );
  6593.  
  6594. END;
  6595.  
  6596. {────────────────────────────────────────────────────────────────────────────}
  6597.  
  6598.  
  6599. (*-
  6600.  
  6601. [FUNCTION]
  6602.  
  6603. Function  SoundexPack(               S         : STRING  ) : WORD;
  6604.  
  6605. [PARAMETERS]
  6606.  
  6607. S           Text string (one text word) to Soundex Encode and pack
  6608.  
  6609. [RETURNS]
  6610.  
  6611. Packed (as WORD) Soundex Code for string
  6612.  
  6613. [DESCRIPTION]
  6614.  
  6615. Soundex Encodes a text string and packs it as word value.
  6616. A Soundex Code is an AlphaNumeric Code derived from the pronounciation
  6617. of a text word.  It's standard format is the first letter of the
  6618. original word along with a numbering system designed to encompass
  6619. sounds of similar pronounciation.  The result is that the Soundex Code
  6620. for a word is the same as a Soundex for a word which sounds the same.
  6621. (ie. "There", "Their", and "They're" would all have the same Soundex
  6622. Code).  This resulting code is further compressed from 4 bytes downto
  6623. the space of a single binary word (2 bytes).  Uses SoundexUnPack to
  6624. revert to it's standard Soundex Format.  This Packed Code may be used
  6625. just as you would the standard Soundex Code in all operations and uses.
  6626. In fact, it is recommended to be used in this format for saving of
  6627. record storage space as well as simplicity of comparison tests.
  6628.  
  6629. [SEE-ALSO]
  6630.  
  6631. SoundexUnPack
  6632. SoundexStr
  6633.  
  6634. [EXAMPLE]
  6635.  
  6636. VAR
  6637.   W1,W2 : WORD;
  6638.  
  6639. BEGIN
  6640.  
  6641.   W1 := SoundexPack( 'Jonson' );
  6642.   W2 := SoundexPack( 'Johnsonn' );
  6643.  
  6644.   { Both W1 and W2 contain the value 10765 }
  6645.  
  6646. END;
  6647.  
  6648. -*)
  6649.  
  6650. Function  SoundexPack(               S         : STRING  ) : WORD;
  6651.  
  6652. Type
  6653.  
  6654.   TN = Array[0..255] of INTEGER;
  6655.  
  6656. Var
  6657.  
  6658.   N     : TN;
  6659.   I     : INTEGER;
  6660.   Err   : INTEGER;
  6661.   Temp  : STRING;
  6662.   W1,W2 : WORD;
  6663.  
  6664. BEGIN
  6665.  
  6666.   FillChar( N, SizeOf( N ), 0 );
  6667.  
  6668.   For I := 1 to Byte( S[0] ) Do
  6669.   BEGIN
  6670.  
  6671.     S[I] := UpCase( Char( S[I] ) );
  6672.  
  6673.     N[I] := Byte( S[I] );
  6674.  
  6675.     If Pos(Char(N[I]), 'BFPV') > 0 Then
  6676.       N[I] := 1
  6677.     Else
  6678.  
  6679.     If Pos(Char(N[I]), 'CGJKQSXZ') > 0 Then
  6680.       N[I] := 2
  6681.     Else
  6682.  
  6683.     If Pos(Char(N[I]), 'DT') > 0 Then
  6684.       N[I] := 3
  6685.     Else
  6686.  
  6687.     If N[I] = Byte('L') Then
  6688.       N[I] := 4
  6689.     Else
  6690.  
  6691.     If Pos(Char(N[I]), 'MN') > 0 Then
  6692.       N[I] := 5
  6693.     Else
  6694.  
  6695.     If N[I] = Byte('R') Then
  6696.       N[I] := 6
  6697.     Else
  6698.       N[I]:=0;
  6699.  
  6700.     If N[I-1] = N[I] Then
  6701.       N[I] := 0;
  6702.  
  6703.   END;
  6704.  
  6705.   Temp := S[1];
  6706.  
  6707.   For I := 2 to Byte( S[0] ) Do
  6708.   BEGIN
  6709.  
  6710.     If (N[I] <> 0) Then
  6711.     BEGIN
  6712.  
  6713.       Temp := Temp + Char( N[I] + 48 );
  6714.  
  6715.       If ( Byte( Temp[0] ) = 4) Then
  6716.         I := Byte(S[0]);
  6717.  
  6718.     END;
  6719.  
  6720.   END;
  6721.  
  6722.   While ( Byte( Temp[0] ) < 4) Do
  6723.     Temp := Temp + '0';
  6724.  
  6725.   W1 := Byte( Byte( Temp[1] ) - 64 ); {FIRST CONVERT THE ALPHA}
  6726.   W1 := (W1 SHL 10);
  6727.  
  6728.   Temp[1] := '0';                    {NOW CONVERT THE NUMERICS}
  6729.   Val( Temp, I, Err );
  6730.   W2 := I;
  6731.  
  6732.   SoundexPack := W1 + W2;
  6733.  
  6734. END;
  6735.  
  6736. {────────────────────────────────────────────────────────────────────────────}
  6737.  
  6738. (*-
  6739.  
  6740. [FUNCTION]
  6741.  
  6742. Function  SoundexUnPack(             W         : WORD    ) : STRING;
  6743.  
  6744. [PARAMETERS]
  6745.  
  6746. W           Word representing Packed Soundex Code to be unpacked
  6747.  
  6748. [RETURNS]
  6749.  
  6750. Standard Unpacked Soundex Code from Packed Code Value
  6751.  
  6752. [DESCRIPTION]
  6753.  
  6754. Unpacks a soundex code from packed code value.
  6755. A Soundex Code is an AlphaNumeric Code derived from the pronounciation
  6756. of a text word.  It's standard format is the first letter of the
  6757. original word along with a numbering system designed to encompass
  6758. sounds of similar pronounciation.  (See SoundexPack for example)  This
  6759. takes the packed 2 byte compressed Soundex Code and uncompresses it
  6760. it's standard Soundex Format as a 4 byte string Code.  It is recommended
  6761. that for operational uses, the compressed for be used for both the
  6762. savings of record storage space as well as simplicity of comparison tests.
  6763.  
  6764. [SEE-ALSO]
  6765.  
  6766. SoundexPack
  6767. SoundexStr
  6768.  
  6769. [EXAMPLE]
  6770.  
  6771. VAR
  6772.   W : WORD;
  6773.   S : STRING;
  6774.  
  6775. BEGIN
  6776.  
  6777.   W := SoundexPack( 'Jonson' );
  6778.   S := SoundexUnPack( W );
  6779.  
  6780.   { W = 10765, S = 'J525' }
  6781.  
  6782. END;
  6783.  
  6784. -*)
  6785.  
  6786.  
  6787. Function  SoundexUnPack(             W         : WORD    ) : STRING;
  6788.  
  6789. Var
  6790.  
  6791.   W1,W2 : WORD;
  6792.   T1,T2 : STRING;
  6793.  
  6794. BEGIN
  6795.  
  6796.   T1 := '';
  6797.   T2 := '';
  6798.  
  6799.   W1 := W SHR 10;            {extract alpha code}
  6800.   T1[1] := CHAR( W1 + 64 );   {shift back to alpha range}
  6801.   W1 := W1 SHL 10;
  6802.   W2 := ( W1 XOR W );
  6803.  
  6804.   Str( W2:3, T2 );
  6805.   T1 := T1[1] + T2;
  6806.  
  6807.   If (T1[2] = ' ') Then
  6808.     T1[2] := '0';
  6809.   If (T1[3] = ' ') Then
  6810.     T1[3] := '0';
  6811.  
  6812.   SoundexUnPack := T1;
  6813.  
  6814. END;
  6815.  
  6816.  
  6817. {────────────────────────────────────────────────────────────────────────────}
  6818.  
  6819. (*-
  6820.  
  6821. [FUNCTION]
  6822.  
  6823. Function  SoundexStr(                S         : STRING  ) : STRING;
  6824.  
  6825. [PARAMETERS]
  6826.  
  6827. [RETURNS]
  6828.  
  6829. [DESCRIPTION]
  6830.  
  6831. For the rare instances when one would like to display the actual Soundex
  6832. Symbolic Code, this function will output that Symbolic Code as a string.
  6833.  
  6834. Use of this is more for show than actually utilizing the data, as it is
  6835. always faster and much more efficient to use a Packed Soundex Code value
  6836. for all comparison operations than to compare by Strings.
  6837.  
  6838. [SEE-ALSO]
  6839.  
  6840. SoundexPack
  6841. SoundexUnPack
  6842.  
  6843. [EXAMPLE]
  6844.  
  6845. VAR
  6846.   S : STRING;
  6847.  
  6848. BEGIN
  6849.  
  6850.   S := SoundexStr( 'Jonson' );
  6851.  
  6852.   { S = 'J525' }
  6853.  
  6854. END;
  6855.  
  6856. -*)
  6857.  
  6858. Function  SoundexStr(                S         : STRING  ) : STRING;
  6859.  
  6860. BEGIN
  6861.  
  6862.   SoundexStr := SoundexUnPack( SoundexPack( S ) );
  6863.  
  6864. END;
  6865.  
  6866.  
  6867. {────────────────────────────────────────────────────────────────────────────}
  6868.  
  6869. (*-
  6870.  
  6871. [FUNCTION]
  6872.  
  6873. Function  PtrToLin(                  Ptr       : POINTER ) : LONGINT;
  6874.  
  6875. [PARAMETERS]
  6876.  
  6877. Ptr         Pointer Address to Convert to Linear Address
  6878.  
  6879. [RETURNS]
  6880.  
  6881. Linear Address associated with Pointer Address
  6882.  
  6883. [DESCRIPTION]
  6884.  
  6885. Converts a Segmented Address Pointer into a Linear Memory Address.
  6886.  
  6887. This is most useful for Windows or DPMI Pointer routines.
  6888. This could also be used to manipulate Pointer Math.
  6889.  
  6890. [SEE-ALSO]
  6891.  
  6892. LinToPtr
  6893.  
  6894. [EXAMPLE]
  6895.  
  6896. VAR
  6897.   P : POINTER;
  6898.   L : LONGINT;
  6899.  
  6900. BEGIN
  6901.  
  6902.   P := Ptr( $A000, $0 );
  6903.   L := PtrToLin( P );
  6904.  
  6905.   { L = $000A0000 }
  6906.  
  6907. END;
  6908.  
  6909. -*)
  6910.  
  6911. Function PtrToLin(           Ptr       : POINTER      ) : LONGINT;
  6912.  
  6913. BEGIN
  6914.  
  6915.  
  6916.  
  6917.   { for windows or dpmi -- call get selector base and add offset }
  6918.   { to return the linear address.                                }
  6919.  
  6920.  
  6921.   PtrToLin :=   Longint( TCastDWord( Ptr ).LowWord ) +
  6922.               ( Longint( TCastDWord( Ptr ).HighWord ) SHL 4 );
  6923.  
  6924. END;
  6925.  
  6926. {────────────────────────────────────────────────────────────────────────────}
  6927.  
  6928. (*-
  6929.  
  6930. [FUNCTION]
  6931.  
  6932. Function  LinToPtr(                  Lin       : LONGINT ) : POINTER;
  6933.  
  6934. [PARAMETERS]
  6935.  
  6936. Lin         Linear Memory Address
  6937.  
  6938. [RETURNS]
  6939.  
  6940. Pointer associated with same Linear Memory Address
  6941.  
  6942. [DESCRIPTION]
  6943.  
  6944. Converts a Linear Memory Address Longint into a Segmented Memory Addr
  6945. Pointer.
  6946.  
  6947. [SEE-ALSO]
  6948.  
  6949. PtrToLin
  6950.  
  6951. [EXAMPLE]
  6952.  
  6953. VAR
  6954.   P : POINTER;
  6955.   L : LONGINT;
  6956.  
  6957. BEGIN
  6958.  
  6959.   L := $000A0000;
  6960.   P := LinToPtr( L );
  6961.  
  6962.   { P = $A000:0000 }
  6963.  
  6964. END;
  6965.  
  6966. -*)
  6967.  
  6968. Function LinToPtr(          Lin        : LONGINT      ) : POINTER;
  6969.  
  6970. BEGIN
  6971.  
  6972.   LinToPtr := Ptr( Lin SHR 4, Lin MOD 16 );
  6973.  
  6974. END;
  6975.  
  6976. {────────────────────────────────────────────────────────────────────────────}
  6977.  
  6978. (*-
  6979.  
  6980. [FUNCTION]
  6981.  
  6982. Function  PtrAdd(                    OrigPtr   : POINTER;
  6983.                                      AddOfs    : LONGINT ) : POINTER;
  6984.  
  6985. [PARAMETERS]
  6986.  
  6987. OrigPtr     Source Pointer to work with
  6988. AddOfs      Pointer Offset to Add
  6989.  
  6990. [RETURNS]
  6991.  
  6992. New Pointer from the above pointer math
  6993.  
  6994. [DESCRIPTION]
  6995.  
  6996. This function will take the provided Source Pointer and Add to it the
  6997. Offset Address "AddOfs" to come up with another Pointer Address.  This
  6998. is math at the Pointer Level and comes in very useful with routines
  6999. emulating C Style Pointer operations.
  7000.  
  7001. [SEE-ALSO]
  7002.  
  7003. PtrSub
  7004. PtrDiff
  7005.  
  7006. [EXAMPLE]
  7007.  
  7008. VAR
  7009.   T,P : POINTER;
  7010.   Len : INTEGER;
  7011.  
  7012. BEGIN
  7013.  
  7014.   T   := NewString( 300, 'This is a Test' + #0 );
  7015.   { T is now a "C"-Type String }
  7016.  
  7017.   P   := T;
  7018.   Len := 0;
  7019.  
  7020.   While ( P <> #0) Do
  7021.   BEGIN
  7022.     Inc( Len );
  7023.     P := PtrAdd( P, 1 );
  7024.   END;
  7025.  
  7026.   { Len now equals the length of the AsciiZ string }
  7027.  
  7028. END;
  7029.  
  7030. -*)
  7031.  
  7032. Function PtrAdd(             OrigPtr   : POINTER;
  7033.                              AddOfs    : LONGINT      ) : POINTER;
  7034.  
  7035. BEGIN
  7036.  
  7037.   PtrAdd := Ptr( TCastDWord( OrigPtr ).HighWord +
  7038.                  TCastDWord( AddOfs  ).HighWord * SelectorInc,
  7039.                  TCastDWord( OrigPtr ).LowWord  +
  7040.                  TCastDWord( AddOfs  ).LowWord                 );
  7041.  
  7042.  
  7043. END;
  7044.  
  7045. {────────────────────────────────────────────────────────────────────────────}
  7046.  
  7047. (*-
  7048.  
  7049. [FUNCTION]
  7050.  
  7051. Function  PtrSub(                    OrigPtr   : POINTER;
  7052.                                      SubOfs    : LONGINT ) : POINTER;
  7053.  
  7054. [PARAMETERS]
  7055.  
  7056. OrigPtr     Source Pointer to work with
  7057. SubOfs      Pointer Offset to Subtract
  7058.  
  7059. [RETURNS]
  7060.  
  7061. New Pointer from the above pointer math
  7062.  
  7063. [DESCRIPTION]
  7064.  
  7065. This function will take the provided Source Pointer and Subtract from
  7066. it's address the Offset "SubOfs" to produce another pointer.  This is
  7067. basically math at the Pointer Level and can be very useful when used
  7068. much like C Pointer routines
  7069.  
  7070. Suggest that this may be more useful moving Pointer Indexes into
  7071. DataBases.
  7072.  
  7073. [SEE-ALSO]
  7074.  
  7075. PtrAdd
  7076. PtrDiff
  7077.  
  7078. [EXAMPLE]
  7079.  
  7080.  
  7081. VAR
  7082.   P   : POINTER;
  7083.   Len : INTEGER;
  7084.  
  7085. BEGIN
  7086.  
  7087.   P   := NewString( 300, 'This is a Test'+#0 );
  7088.   { P is now a "C"-Type String }
  7089.  
  7090.   Len := 0;
  7091.  
  7092.   While ( P <> #0) Do
  7093.   BEGIN
  7094.     Inc( Len );
  7095.     P := PtrAdd( P, 1 );
  7096.   END;
  7097.  
  7098.   P := PtrSub( P, Len );
  7099.  
  7100.   {------------------------------------------------------}
  7101.   { "Len" now equals the length of the AsciiZ string     }
  7102.   { while "P" is returned to the original string address }
  7103.   {------------------------------------------------------}
  7104.  
  7105.  
  7106.   {-------------------------------------------------}
  7107.   { GRANTED THIS IS NOT AN EXAMPLE OF OPTIMAL USAGE }
  7108.   { BUT IT DOES SHOW THE ACTION.                    }
  7109.   {-------------------------------------------------}
  7110.  
  7111. END;
  7112.  
  7113. -*)
  7114.  
  7115. Function PtrSub(             OrigPtr   : POINTER;
  7116.                              SubOfs    : LONGINT      ) : POINTER;
  7117.  
  7118. BEGIN
  7119.  
  7120.  
  7121.  
  7122.   PtrSub := Ptr( TCastDWord( OrigPtr ).HighWord -
  7123.                  TCastDWord( SubOfs  ).HighWord * SelectorInc,
  7124.                  TCastDWord( OrigPtr ).LowWord  -
  7125.                  TCastDWord( SubOfs  ).LowWord                 );
  7126.  
  7127.  
  7128.  
  7129. END;
  7130.  
  7131. {────────────────────────────────────────────────────────────────────────────}
  7132.  
  7133. (*-
  7134.  
  7135. [FUNCTION]
  7136.  
  7137. Function  PtrDiff(                A             : POINTER;
  7138.                                   B             : POINTER       ) : LONGINT;
  7139.  
  7140. [PARAMETERS]
  7141.  
  7142. A           1st pointer
  7143. B           2nd pointer
  7144.  
  7145. [RETURNS]
  7146.  
  7147. Difference between the two pointers.
  7148.  
  7149. [DESCRIPTION]
  7150.  
  7151. Returns the difference between two pointers.
  7152.  
  7153. [SEE-ALSO]
  7154.  
  7155. PtrSub
  7156. PtrAdd
  7157.  
  7158. [EXAMPLE]
  7159.  
  7160. -*)
  7161.  
  7162. Function  PtrDiff(                A             : POINTER;
  7163.                                   B             : POINTER       ) : LONGINT;
  7164.  
  7165. BEGIN
  7166.  
  7167.   PtrDiff := (LongInt(TCastDWord(A).HighWord) SHL TCastDWord(A).LowWord+4) -
  7168.              (LongInt(TCastDWord(B).HighWord) SHL TCastDWord(B).LowWord+4);
  7169.  
  7170. END;
  7171.  
  7172. {────────────────────────────────────────────────────────────────────────────}
  7173.  
  7174.  
  7175. (*-
  7176.  
  7177. [FUNCTION]
  7178.  
  7179. Procedure FarCall(          Proc          : POINTER );
  7180.  
  7181. [PARAMETERS]
  7182.  
  7183. Proc        Far Pointer to Procedure to Call
  7184.  
  7185. [RETURNS]
  7186.  
  7187. (None)
  7188.  
  7189. [DESCRIPTION]
  7190.  
  7191. Jumps to the Far Pointer and executes the Procedure.
  7192.  
  7193. NOTE: Caller must be sure to declare his Procedures to be called
  7194. as Far Procedures as shown in the Example below.
  7195.  
  7196. [SEE-ALSO]
  7197.  
  7198. (None)
  7199.  
  7200. [EXAMPLE]
  7201.  
  7202. Procedure MyRoutine; Far
  7203. BEGIN
  7204.   WriteLn( 'Something to Do.');
  7205. END;
  7206.  
  7207. BEGIN
  7208.  
  7209.   FarCall( @MyRoutine );
  7210.  
  7211. END.
  7212.  
  7213. -*)
  7214.  
  7215. Procedure FarCall(          Proc          : POINTER );
  7216.  
  7217. Assembler;
  7218. ASM
  7219.  
  7220.   CALL [PROC]
  7221.  
  7222. END;
  7223.  
  7224.  
  7225.  
  7226. Procedure SetJump(                JumpInfo      : PJumpInfo     );
  7227.  
  7228.  
  7229.  
  7230. BEGIN
  7231.  
  7232.   ASM
  7233.  
  7234.     LES  BX, dword PTR [JumpInfo]
  7235.  
  7236.     MOV  SI, SP                   { get SP   }
  7237.  
  7238.     MOV  AX, word PTR SS:[SI+2]   { get BP   }
  7239.     MOV  word PTR ES:[BX  ],AX    { store it }
  7240.  
  7241.     MOV  AX, word PTR SS:[SI+4]   { get IP   }
  7242.     MOV  word PTR ES:[BX+2],AX    { store it }
  7243.  
  7244.     MOV  AX, word PTR SS:[SI+6]   { get CS   }
  7245.     MOV  word PTR ES:[BX+4],AX    { store it }
  7246.  
  7247.     MOV  word PTR ES:[BX+6],SI    { store SP }
  7248.  
  7249.   END;
  7250.  
  7251. END;
  7252.  
  7253.  
  7254. Procedure LongJump(               JumpInfo      : PJumpInfo     );
  7255.  
  7256. BEGIN
  7257.  
  7258.   ASM
  7259.  
  7260.     LES BX, dword PTR [jumpinfo]
  7261.  
  7262.     MOV SI, SP
  7263.  
  7264.  
  7265.  
  7266.   END;
  7267.  
  7268. END;
  7269.  
  7270.  
  7271. Procedure EnableInts; Assembler;
  7272.  
  7273. ASM
  7274.   CLI;
  7275. END;
  7276.  
  7277. Procedure DisableInts; Assembler;
  7278.  
  7279. ASM
  7280.   STI;
  7281. END;
  7282.  
  7283.  
  7284. Procedure PushWord(               W             : WORD          );
  7285.  
  7286. BEGIN
  7287.  
  7288. END;
  7289.  
  7290. Procedure PushLong(               L             : LONGINT       );
  7291.  
  7292. BEGIN
  7293.  
  7294. END;
  7295.  
  7296. Procedure PushPtr(                P             : POINTER       );
  7297.  
  7298. BEGIN
  7299.  
  7300. END;
  7301.  
  7302. Function  PopWord : WORD;
  7303.  
  7304. BEGIN
  7305.  
  7306. END;
  7307.  
  7308. Function  PopLong : LONGINT;
  7309.  
  7310. BEGIN
  7311.  
  7312. END;
  7313.  
  7314. Function  PopPtr  : POINTER;
  7315.  
  7316. BEGIN
  7317.  
  7318. END;
  7319.  
  7320. Procedure BufferSRByte(    Buffer         : POINTER;
  7321.                            BuffSize       : WORD;
  7322.                            ByteToLookfor  : BYTE;
  7323.                            ReplaceWith    : BYTE      );
  7324.  
  7325. ASSEMBLER;
  7326.  
  7327. ASM
  7328.  
  7329.   LES DI, dword PTR [BUFFER]
  7330.   MOV AL, ByteToLookFor
  7331.   CLD
  7332.   MOV CX, BuffSize
  7333.   MOV AH, ReplaceWith
  7334.  
  7335.  @@1:
  7336.   REPNE SCASB
  7337.   JNE @@2
  7338.  
  7339.   MOV byte PTR ES:[DI-1], AH
  7340.   JCXZ @@2
  7341.  
  7342.   JMP @@1
  7343.  
  7344.  @@2:
  7345.  
  7346. END;
  7347.  
  7348. {────────────────────────────────────────────────────────────────────────────}
  7349.  
  7350. Function  GetNextTwirlyChar : CHAR;
  7351.  
  7352. BEGIN
  7353.  
  7354.   If cTwirlyCurPos=8 Then
  7355.     cTwirlyCurPos:=1
  7356.   Else
  7357.     Inc( cTwirlyCurPos );
  7358.  
  7359.  
  7360.   GetNextTwirlyChar := cTwirlyString[ cTwirlyCurPos ];
  7361.  
  7362. END;
  7363.  
  7364. {────────────────────────────────────────────────────────────────────────────}
  7365. {────────────────────────────────────────────────────────────────────────────}
  7366. {────────────────────────────────────────────────────────────────────────────}
  7367.  
  7368. BEGIN
  7369. END.
  7370.