home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 3 Comm / 03-Comm.zip / TIKTP12A.LZH / UTILITY.PAS < prev   
Pascal/Delphi Source File  |  1992-03-16  |  9KB  |  353 lines
  1. (*#module(turbo_comp=>off)*)
  2. IMPLEMENTATION Unit Utility ;
  3.  
  4. IMPORT
  5.   DOS(EXIT_PROCESS),
  6.   TURBOSYS(upcase,_STR_INT)
  7.   ;
  8.  
  9. FUNCTION UpperCase { (TheString: MAXSTRING): MAXSTRING ; };
  10.  
  11. Var
  12.   Idx   : Word ;
  13.  
  14. Begin
  15.   For Idx := 1 to Length(TheString) Do
  16.     { Special Cases are for International Characters }
  17.     Case TheString[Idx] of
  18.       'å' : TheString[Idx]:= 'Å';
  19.       'ä' : TheString[Idx]:= 'Ä';
  20.       'ö' : TheString[Idx]:= 'Ö';
  21.       'ü' : TheString[Idx]:= 'Ü';
  22.       'é' : TheString[Idx]:= 'É';
  23.       'ñ' : TheString[Idx]:= 'Ñ';
  24.       'æ' : TheString[Idx]:= 'Æ';
  25.       {Put all other chars to be converted here }
  26.     Else
  27.       TheString[Idx] := upcase(TheString[Idx]);
  28.   End ;
  29.   UpperCase := TheString ;
  30. End;
  31.  
  32. FUNCTION LowerCase { (TheString: MAXSTRING): MAXSTRING ; };
  33. Var
  34.   Idx : Word ;
  35.   Ch  : Char ;
  36. Begin
  37.   For Idx := 1 to Length(TheString) Do
  38.   Begin
  39.     Ch := TheString[Idx] ;
  40.     If Ch In ['A'..'Z'] Then
  41.       TheString[Idx] := ((Ord(Ch)+32)::Char)
  42.     Else Begin
  43.       { Special Cases for International Characters }
  44.       Case TheString[Idx] of
  45.         'Å' : TheString[Idx]:= 'å' ;
  46.         'Ä' : TheString[Idx]:= 'ä' ;
  47.         'Ö' : TheString[Idx]:= 'ö' ;
  48.         'Ü' : TheString[Idx]:= 'ü' ;
  49.         'É' : TheString[Idx]:= 'é' ;
  50.         'Ñ' : TheString[Idx]:= 'ñ' ;
  51.         'Æ' : TheString[Idx]:= 'æ' ;
  52.         Else      End ;
  53.     End ;
  54.   End ;
  55.   LowerCase := TheString ;
  56. End ;
  57.  
  58. FUNCTION Capitalize { (TheString: MAXSTRING): MAXSTRING ; };
  59. Var
  60.   I  : Word ;
  61.   Ch : Char ;
  62.   Fl : Boolean ;
  63. Begin
  64.   Fl := True ;
  65.   TheString := LowerCase(TheString) ;
  66.   For I := 1 to Length(TheString) Do
  67.   Begin
  68.     Ch := TheString[I] ;
  69.     If Ch In ['a'..'z',''''] Then
  70.     Begin
  71.       If Fl Then TheString[I] := upcase(Ch) ;
  72.       Fl := False ;
  73.     End Else
  74.       Fl := True ;
  75.   End ;
  76.   Capitalize := TheString ;
  77. End ;
  78.  
  79. FUNCTION Trim { (TheString: MAXSTRING): MAXSTRING ; };
  80. Var
  81.   I   : Word ;
  82. Begin
  83.   Repeat
  84.     Begin
  85.       I := POS('  ',TheString) ;
  86.       If I <> 0 Then Delete(TheString,I,1) ;
  87.     End ;
  88.   Until I = 0  ;
  89.   If TheString[1] = ' ' Then
  90.     Delete(TheString,1,1) ;
  91.   If TheString[Length(TheString)] = ' ' Then
  92.     Delete(TheString,Length(TheString),1);
  93.   Trim := TheString ;
  94. End ;
  95.  
  96. FUNCTION Strip { (TheString: MAXSTRING; Delim: Char; Mode: Char): MAXSTRING ; };
  97.  
  98. Var
  99.   Idx : Word ;
  100.  
  101. Begin
  102.   Case upcase(Mode) of
  103.     'L' : Begin      { Strips All LEADING characters }
  104.             While (TheString[1] = Delim) and (Length(TheString) > 0) Do
  105.               Delete(TheString,1,1);
  106.           End ;
  107.  
  108.     'T' : Begin      { Strips all TRAILING characters }
  109.             While (TheString[Length(TheString)] = Delim) and (Length(TheString) > 0) Do
  110.               Delete(TheString,Length(TheString),1);
  111.             End ;
  112.  
  113.     'B' : Begin      { Strips BOTH leading and trailing characters }
  114.             While (TheString[1] = Delim) and (Length(TheString) > 0) Do
  115.               Delete(TheString,1,1);
  116.             While (TheString[Length(TheString)] = Delim) and (Length(TheString) > 0)  Do
  117.               Delete(TheString,Length(TheString),1);
  118.           End ;
  119.  
  120.     'A' : Begin      { Strips ALL occurances of the character }
  121.             Repeat
  122.               Begin
  123.                 Idx := POS(Delim,TheString) ;
  124.                 If Idx <> 0 Then Delete(TheString,Idx,1) ;
  125.               End ;
  126.             Until Idx = 0  ;
  127.           End ;
  128.  
  129.     'R' : Begin      { Strips Redundant characters }
  130.             Repeat
  131.               Begin
  132.                 Idx := POS(Delim + Delim,TheString) ;
  133.                 If Idx <> 0 Then Delete(TheString,Idx,1) ;
  134.               End ;
  135.             Until Idx = 0  ;
  136.             If TheString[1] = Delim Then
  137.               Delete(TheString,1,1) ;
  138.             If TheString[Length(TheString)] = Delim Then
  139.               Delete(TheString,Length(TheString),1);
  140.           End ;
  141.     Else  End;
  142.   Strip := TheString;
  143. End ;
  144.  
  145. FUNCTION Word_to_Str { (TheWord: Word): MAXSTRING ; };
  146. Var
  147.   Tmp : MAXSTRING ;
  148.   OK : boolean;
  149. Begin
  150.   IntToStr(TheWord,Tmp,10,OK);
  151. {  _STR_INT(TheWord, 0, Tmp) ;}
  152.   Word_to_Str := Tmp ;
  153. End ;
  154.  
  155. FUNCTION Str_To_Word { (TheString: MAXSTRING): Word ; };
  156. Var
  157.   Tmp     : Word ;
  158.   OK : boolean;
  159. Begin
  160.   Tmp := StrToInt(TheString,10,OK);
  161. {  _VAL_INT(TheString,Tmp,Garbage) ; }
  162.   If not OK Then
  163.     Str_To_Word := 0
  164.   Else
  165.     Str_To_Word := Tmp ;
  166. End ;
  167.  
  168. FUNCTION Count { (TheString: MAXSTRING; Delim: MAXSTRING): Word ; };
  169. Var
  170.   Idx   : Word ;
  171.   Cnt   : Word ;
  172. Begin
  173.   Cnt := 0 ;
  174.   For Idx := 1 to Length(TheString) Do
  175.     If Copy(TheString,Idx,Length(Delim)) = Delim Then Cnt:=Cnt+1 ;
  176.   Count := Cnt ;
  177. End ;
  178.  
  179. FUNCTION DCount { (TheString: MAXSTRING; Delim: MAXSTRING): Word ; };
  180. Var
  181.   Idx   : Word ;
  182.   Cnt   : Word ;
  183. LABEL 1;
  184. Begin
  185.   If TheString = '' Then Begin
  186.     DCount := 0 ;
  187.     GOTO 1 ;
  188.   End ;
  189.   Cnt := 1 ;
  190.   For Idx := 1 to Length(TheString) Do
  191.     If Copy(TheString,Idx,Length(Delim)) = Delim Then Cnt:=Cnt+1 ;
  192.   DCount := Cnt ;
  193.  1:
  194. End ;
  195.  
  196. FUNCTION Index { (TheString: MAXSTRING; Delim: MAXSTRING; Cnt: Word): Word ; };
  197. Var
  198.   X   : Word ;
  199.   Idx : Word ;
  200. LABEL 1;
  201. Begin
  202.   If (Count(TheString,Delim) < Cnt) or (Cnt < 1) Then
  203.     Index := 0
  204.   Else Begin
  205.     X := 0 ;
  206.     For Idx := 1 to Length(TheString) Do
  207.     Begin
  208.       If Copy(TheString,Idx,Length(Delim)) = Delim Then X:=X+1 ;
  209.       If X = Cnt Then
  210.       Begin
  211.         Index := Idx ;
  212.         GOTO 1 ;
  213.       End ;
  214.     End ;
  215.     WriteLn('ERROR IN INDEX FUNCTION') ;
  216.     dos.exit(EXIT_PROCESS,255);
  217.   End ;
  218.  1:
  219. End ;
  220.  
  221. FUNCTION Field { (TheString: MAXSTRING; Delim: MAXSTRING; Cnt: Word): MAXSTRING ; };
  222. Var
  223.   Start : Word ;
  224.   Last  : Word ;
  225.   Size  : Word ;
  226. LABEL 1;
  227. Begin
  228.   Start := Index(TheString,Delim,Cnt-1) ;
  229.   If (Start = 0) and (Cnt <> 1) Then
  230.   Begin
  231.     Field := '' ;
  232.     GOTO 1 ;
  233.   End ;
  234.   Start := Start + 1 ;
  235.   Last := Index(TheString,Delim,Cnt) ;
  236.   If Last = 0 Then
  237.     Last := Length(TheString)
  238.   Else
  239.     Last := Last - 1 ;
  240.   Size := Last - Start + 1 ;
  241.   Field := Copy(TheString,Start,Size) ;
  242.  1:
  243. End ;
  244.  
  245. FUNCTION Change { (TheString: MAXSTRING; Old: Char; New: Char): MAXSTRING ; };
  246.  
  247. Var
  248.   Idx : Word ;
  249.   Tmp : MAXSTRING ;
  250.  
  251. Begin
  252.   Tmp := TheString ;
  253.   For Idx := 1 to Length(TheString) Do
  254.     If Tmp[Idx] = Old Then Tmp[Idx] := New ;
  255.   Change := Tmp ;
  256. End ;
  257.  
  258. FUNCTION PadLeft { (TheString: MAXSTRING; Size:Word; Pad: Char): MAXSTRING ; };
  259.  
  260. Var
  261.   Tmp : MAXSTRING ;
  262.  
  263. Begin
  264.     Fillchar(Tmp[1],Size,Pad) ;
  265.     Tmp[0] := Chr(Size) ;
  266.     If Length(TheString) <= Size Then
  267.        Move(TheString[1],Tmp[1],Length(TheString))
  268.     Else
  269.        Move(TheString[1],Tmp[1],Size) ;
  270.     PadLeft := Tmp ;
  271. End ;
  272.  
  273.  
  274. FUNCTION PadRight { (TheString: MAXSTRING; Size: Word; Pad: Char): MAXSTRING ; };
  275.  
  276. Var
  277.   Tmp : MAXSTRING ;
  278.   L   : Word ;
  279.  
  280. Begin
  281.     Fillchar(Tmp[1],Size,Pad) ;
  282.     Tmp[0] := Chr(Size) ;
  283.     L := Length(TheString) ;
  284.     If L <= Size Then
  285.        Move(TheString[1],Tmp[Succ(Size - L)],L)
  286.     Else
  287.        Move(TheString[L - Size + 1],Tmp[1],Size);
  288.     PadRight := Tmp;
  289. End;
  290.  
  291. FUNCTION PadCenter { (TheString: MAXSTRING; Size: Word; Pad: Char): MAXSTRING ; };
  292.  
  293. Var
  294.   Tmp : MAXSTRING ;
  295.   L   : Word ;
  296.  
  297. Begin
  298.     Fillchar(Tmp[1],Size,Pad) ;
  299.     Tmp[0] := Chr(Size) ;
  300.     L := Length(TheString) ;
  301.     If L <= Size Then
  302.        Move(TheString[1],Tmp[((Size - L) div 2) + 1],L)
  303.     Else
  304.        Move(TheString[((L - Size) div 2) + 1],Tmp[1],Size) ;
  305.     PadCenter := Tmp ;
  306. End ;
  307.  
  308. FUNCTION DATE_DMA { (Number: Word): MAXSTRING ; };
  309. TYPE ZZZXXXZZZ0= Array[1..12] of String[9];
  310. Const  Months = ZZZXXXZZZ0    ('January','February','March','April','May','June',
  311. 'July','August','September','October','November','December') ;
  312.  
  313. Begin
  314.   DATE_DMA := Months[Number] ;
  315. End ;
  316.  
  317. FUNCTION DATE_DWA { (Number: Word): MAXSTRING ; };
  318. TYPE ZZZXXXZZZ1= Array[0..6] of String[9];
  319. Const  DaysOfWeek = ZZZXXXZZZ1    ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday') ;
  320.  
  321. Begin
  322.   DATE_DWA := DaysOfWeek[Number] ;
  323. End ;
  324.  
  325. FUNCTION MD { (Number: INTEGER; Decimal: Word): MAXSTRING ; };
  326.  
  327. Var
  328.   Tmp    : MAXSTRING ;
  329.  
  330. Begin
  331.   _STR_INT(Number, 0,Tmp) ;
  332.  
  333.   Tmp := PadRight(Tmp,15 + Decimal,'0') ;
  334.  
  335.   Tmp := Copy(Tmp,1,3) + ','
  336.        + Copy(Tmp,4,3) + ','
  337.        + Copy(Tmp,7,3) + ','
  338.        + Copy(Tmp,10,3) + ','
  339.        + Copy(Tmp,13,3) + '.'
  340.        + Copy(Tmp,16,255) ;
  341.  
  342.   While (Tmp[1] = '0') or (Tmp[1] = ',') Do
  343.     Delete(Tmp,1,1) ;
  344.  
  345.   If Decimal = 0 Then Delete(Tmp,Length(Tmp),1) ;
  346.   If Tmp = '' Then Tmp := '0' ;
  347.  
  348.   MD := Tmp ;
  349. End ;
  350.  
  351. Begin
  352. End .
  353.