home *** CD-ROM | disk | FTP | other *** search
/ BBS 1 / BBS#1.iso / for-dos / tvtoys.arj / TOYUTILS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-12-14  |  4.3 KB  |  163 lines
  1. (***************************************************************************
  2.   Utils unit
  3.   Odd stuff
  4.   PJB November 3, 1993, Internet mail to d91-pbr@nada.kth.se
  5.   Copyright 1993, All Rights Reserved
  6.   Free source, use at your own risk.
  7.   If modified, please state so if you pass this around.
  8.  
  9.   These are non-TV specific helpers with no error checking
  10.  
  11. ***************************************************************************)
  12. unit toyUtils;
  13.  
  14. interface
  15.  
  16.   uses
  17.     Dos;
  18.  
  19.   function AddBackslash(const s:String):String;
  20.   function DefaultExtension(const FileName, Ext:String; Force:Boolean):String;
  21.  
  22.   function HexChar(i:Integer):Char;
  23.   function HexStr(w:Word):String;
  24.   function HexStrValue(const s:String):Word;
  25.   function HexValue(c:Char):Byte;
  26.  
  27.   function Min(a,b:Integer):Integer;
  28.   function Max(a,b:Integer):Integer;
  29.   function MemComp(const m1, m2; Len:Integer):Boolean;
  30.   function ToStr(l:Longint):String;
  31.  
  32.   const
  33.     HexChars : array [0..15] of char = '0123456789ABCDEF';
  34.  
  35.  
  36. (***************************************************************************
  37. ***************************************************************************)
  38. implementation
  39.  
  40.  
  41.   (*******************************************************************
  42.     Make sure we can append a file name
  43.   *******************************************************************)
  44.   function AddBackslash(const s:String):String;
  45.   begin
  46.     if (s<>'') and not (s[Length(s)] in ['\',':']) then
  47.       AddBackslash:=s+'\'
  48.     else
  49.       AddBackslash:=s;
  50.   end;
  51.  
  52.  
  53.   (*******************************************************************
  54.     Add extension if necessary
  55.   *******************************************************************)
  56.   function DefaultExtension;
  57.     var
  58.       P: PathStr;
  59.       D: DirStr;
  60.       N: NameStr;
  61.       E: ExtStr;
  62.   begin
  63.     FSplit(FileName, D, N, E);
  64.     if (E = '') or Force then
  65.       E:=Ext;
  66.     DefaultExtension:=D+N+E;
  67.   end;
  68.  
  69.  
  70.   (*******************************************************************
  71.     Convert 0-15 to hex (0-F)
  72.   *******************************************************************)
  73.   function HexChar;
  74.   begin
  75.     HexChar:=HexChars[i and 15];
  76.   end;
  77.  
  78.  
  79.   (*******************************************************************
  80.     Convert word to four hex chars, zero extended
  81.   *******************************************************************)
  82.   function HexStr;
  83.   begin
  84.     HexStr[0]:=Chr(4);
  85.     HexStr[1]:=HexChars[Hi(w) shr 4];
  86.     HexStr[2]:=HexChars[Hi(w) and $F];
  87.     HexStr[3]:=HexChars[Lo(w) shr 4];
  88.     HexStr[4]:=HexChars[Lo(w) and $F];
  89.   end;
  90.  
  91.  
  92.   (*******************************************************************
  93.     Convert hex string to word
  94.   *******************************************************************)
  95.   function HexStrValue;
  96.     var
  97.       sum, i : Word;
  98.   begin
  99.     sum:=0;
  100.     for i:=1 to Length(s) do
  101.       sum:=16*sum+HexValue(s[i]);
  102.     HexStrValue:=sum;
  103.   end;
  104.  
  105.  
  106.   (*******************************************************************
  107.     Convert hex char (0-F) to byte (0-15)
  108.   *******************************************************************)
  109.   function HexValue;
  110.   begin
  111.     c:=Upcase(c);
  112.     if c>'9' then
  113.       Dec(Byte(c), 7);
  114.     HexValue:=Ord(c)-Ord('0');
  115.   end;
  116.  
  117.  
  118.   (*******************************************************************
  119.     Min and Max
  120.   *******************************************************************)
  121.   function Min;
  122.   begin
  123.     if a<b then Min:=a else Min:=b;
  124.   end;
  125.  
  126.   function Max;
  127.   begin
  128.     if a>b then Max:=a else Max:=b;
  129.   end;
  130.  
  131.  
  132.   (*******************************************************************
  133.     Compare two blocks of memory, returns True if equal
  134.   *******************************************************************)
  135.   function MemComp; assembler;
  136.   asm
  137.       push ds
  138.       les  di,m1
  139.       lds  si,m2
  140.       mov  cx,Len
  141.       cld
  142.       rep  cmpsb
  143.       mov  al,1
  144.       je   @Fin
  145.       dec  al
  146.     @Fin:
  147.       pop  ds
  148.   end;
  149.  
  150.  
  151.   (*******************************************************************
  152.     Function version of Str(), incurs speed overhead
  153.   *******************************************************************)
  154.   function ToStr;
  155.     var
  156.       s : String[15];
  157.   begin
  158.     Str(l,s);
  159.     ToStr:=s;
  160.   end;
  161.  
  162.  
  163. end.