rxStrUtils.pas
上传用户:hylc_2004
上传日期:2014-01-23
资源大小:46800k
文件大小:28k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {         Copyright (c) 1995, 1996 AO ROSNO             }
  5. {         Copyright (c) 1997, 1998 Master-Bank          }
  6. {                                                       }
  7. {         This unit based on AlexGraf String Library    }
  8. {         by Alexei Lukin (c) 1992                      }
  9. {                                                       }
  10. {*******************************************************}
  11. unit rxStrUtils;
  12. {$I RX.INC}
  13. {$A+,B-,E-,R-}
  14. interface
  15. uses SysUtils;
  16. type
  17. {$IFNDEF RX_D4}
  18.   TSysCharSet = set of Char;
  19. {$ENDIF}
  20.   TCharSet = TSysCharSet;
  21. { ** Common string handling routines ** }
  22. function StrToOem(const AnsiStr: string): string;
  23. { StrToOem translates a string from the Windows character set into the
  24.   OEM character set. }
  25. function OemToAnsiStr(const OemStr: string): string;
  26. { OemToAnsiStr translates a string from the OEM character set into the
  27.   Windows character set. }
  28. function IsEmptyStr(const S: string; const EmptyChars: TCharSet): Boolean;
  29. { EmptyStr returns true if the given string contains only character
  30.   from the EmptyChars. }
  31. function ReplaceStr(const S, Srch, Replace: string): string;
  32. { Returns string with every occurrence of Srch string replaced with
  33.   Replace string. }
  34. function DelSpace(const S: string): string;
  35. { DelSpace return a string with all white spaces removed. }
  36. function DelChars(const S: string; Chr: Char): string;
  37. { DelChars return a string with all Chr characters removed. }
  38. function DelBSpace(const S: string): string;
  39. { DelBSpace trims leading spaces from the given string. }
  40. function DelESpace(const S: string): string;
  41. { DelESpace trims trailing spaces from the given string. }
  42. function DelRSpace(const S: string): string;
  43. { DelRSpace trims leading and trailing spaces from the given string. }
  44. function DelSpace1(const S: string): string;
  45. { DelSpace1 return a string with all non-single white spaces removed. }
  46. function Tab2Space(const S: string; Numb: Byte): string;
  47. { Tab2Space converts any tabulation character in the given string to the
  48.   Numb spaces characters. }
  49. function NPos(const C: string; S: string; N: Integer): Integer;
  50. { NPos searches for a N-th position of substring C in a given string. }
  51. function MakeStr(C: Char; N: Integer): string;
  52. function MS(C: Char; N: Integer): string;
  53. { MakeStr return a string of length N filled with character C. }
  54. function AddChar(C: Char; const S: string; N: Integer): string;
  55. { AddChar return a string left-padded to length N with characters C. }
  56. function AddCharR(C: Char; const S: string; N: Integer): string;
  57. { AddCharR return a string right-padded to length N with characters C. }
  58. function LeftStr(const S: string; N: Integer): string;
  59. { LeftStr return a string right-padded to length N with blanks. }
  60. function RightStr(const S: string; N: Integer): string;
  61. { RightStr return a string left-padded to length N with blanks. }
  62. function CenterStr(const S: string; Len: Integer): string;
  63. { CenterStr centers the characters in the string based upon the
  64.   Len specified. }
  65. function CompStr(const S1, S2: string): Integer;
  66. { CompStr compares S1 to S2, with case-sensitivity. The return value is
  67.   -1 if S1 < S2, 0 if S1 = S2, or 1 if S1 > S2. }
  68. function CompText(const S1, S2: string): Integer;
  69. { CompText compares S1 to S2, without case-sensitivity. The return value
  70.   is the same as for CompStr. }
  71. function Copy2Symb(const S: string; Symb: Char): string;
  72. { Copy2Symb returns a substring of a string S from begining to first
  73.   character Symb. }
  74. function Copy2SymbDel(var S: string; Symb: Char): string;
  75. { Copy2SymbDel returns a substring of a string S from begining to first
  76.   character Symb and removes this substring from S. }
  77. function Copy2Space(const S: string): string;
  78. { Copy2Symb returns a substring of a string S from begining to first
  79.   white space. }
  80. function Copy2SpaceDel(var S: string): string;
  81. { Copy2SpaceDel returns a substring of a string S from begining to first
  82.   white space and removes this substring from S. }
  83. function AnsiProperCase(const S: string; const WordDelims: TCharSet): string;
  84. { Returns string, with the first letter of each word in uppercase,
  85.   all other letters in lowercase. Words are delimited by WordDelims. }
  86. function WordCount(const S: string; const WordDelims: TCharSet): Integer;
  87. { WordCount given a set of word delimiters, returns number of words in S. }
  88. function WordPosition(const N: Integer; const S: string;
  89.   const WordDelims: TCharSet): Integer;
  90. { Given a set of word delimiters, returns start position of N'th word in S. }
  91. function ExtractWord(N: Integer; const S: string;
  92.   const WordDelims: TCharSet): string;
  93. function ExtractWordPos(N: Integer; const S: string;
  94.   const WordDelims: TCharSet; var Pos: Integer): string;
  95. function ExtractDelimited(N: Integer; const S: string;
  96.   const Delims: TCharSet): string;
  97. { ExtractWord, ExtractWordPos and ExtractDelimited given a set of word
  98.   delimiters, return the N'th word in S. }
  99. function ExtractSubstr(const S: string; var Pos: Integer;
  100.   const Delims: TCharSet): string;
  101. { ExtractSubstr given a set of word delimiters, returns the substring from S,
  102.   that started from position Pos. }
  103. function IsWordPresent(const W, S: string; const WordDelims: TCharSet): Boolean;
  104. { IsWordPresent given a set of word delimiters, returns True if word W is
  105.   present in string S. }
  106. function QuotedString(const S: string; Quote: Char): string;
  107. { QuotedString returns the given string as a quoted string, using the
  108.   provided Quote character. }
  109. function ExtractQuotedString(const S: string; Quote: Char): string;
  110. { ExtractQuotedString removes the Quote characters from the beginning and
  111.   end of a quoted string, and reduces pairs of Quote characters within
  112.   the quoted string to a single character. }
  113. function FindPart(const HelpWilds, InputStr: string): Integer;
  114. { FindPart compares a string with '?' and another, returns the position of
  115.   HelpWilds in InputStr. }
  116. function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean;
  117. { IsWild compares InputString with WildCard string and returns True
  118.   if corresponds. }
  119. function XorString(const Key, Src: ShortString): ShortString;
  120. function XorEncode(const Key, Source: string): string;
  121. function XorDecode(const Key, Source: string): string;
  122. { ** Command line routines ** }
  123. {$IFNDEF RX_D4}
  124. function FindCmdLineSwitch(const Switch: string; SwitchChars: TCharSet;
  125.   IgnoreCase: Boolean): Boolean;
  126. {$ENDIF}
  127. function GetCmdLineArg(const Switch: string; SwitchChars: TCharSet): string;
  128. { ** Numeric string handling routines ** }
  129. function Numb2USA(const S: string): string;
  130. { Numb2USA converts numeric string S to USA-format. }
  131. function Dec2Hex(N: Longint; A: Byte): string;
  132. function D2H(N: Longint; A: Byte): string;
  133. { Dec2Hex converts the given value to a hexadecimal string representation
  134.   with the minimum number of digits (A) specified. }
  135. function Hex2Dec(const S: string): Longint;
  136. function H2D(const S: string): Longint;
  137. { Hex2Dec converts the given hexadecimal string to the corresponding integer
  138.   value. }
  139. function Dec2Numb(N: Longint; A, B: Byte): string;
  140. { Dec2Numb converts the given value to a string representation with the
  141.   base equal to B and with the minimum number of digits (A) specified. }
  142. function Numb2Dec(S: string; B: Byte): Longint;
  143. { Numb2Dec converts the given B-based numeric string to the corresponding
  144.   integer value. }
  145. function IntToBin(Value: Longint; Digits, Spaces: Integer): string;
  146. { IntToBin converts the given value to a binary string representation
  147.   with the minimum number of digits specified. }
  148. function IntToRoman(Value: Longint): string;
  149. { IntToRoman converts the given value to a roman numeric string
  150.   representation. }
  151. function RomanToInt(const S: string): Longint;
  152. { RomanToInt converts the given string to an integer value. If the string
  153.   doesn't contain a valid roman numeric value, the 0 value is returned. }
  154. const
  155.   CRLF = #13#10;
  156.   DigitChars = ['0'..'9'];
  157. {$IFNDEF CBUILDER}
  158.   Brackets = ['(',')','[',']','{','}'];
  159.   StdWordDelims = [#0..' ',',','.',';','/','',':','''','"','`'] + Brackets;
  160. {$ENDIF}
  161. implementation
  162. uses {$IFDEF WIN32} Windows {$ELSE} WinTypes, WinProcs {$ENDIF};
  163. function StrToOem(const AnsiStr: string): string;
  164. begin
  165.   SetLength(Result, Length(AnsiStr));
  166.   if Length(Result) > 0 then
  167. {$IFDEF WIN32}
  168.     CharToOemBuff(PChar(AnsiStr), PChar(Result), Length(Result));
  169. {$ELSE}
  170.     AnsiToOemBuff(@AnsiStr[1], @Result[1], Length(Result));
  171. {$ENDIF}
  172. end;
  173. function OemToAnsiStr(const OemStr: string): string;
  174. begin
  175.   SetLength(Result, Length(OemStr));
  176.   if Length(Result) > 0 then
  177. {$IFDEF WIN32}
  178.     OemToCharBuff(PChar(OemStr), PChar(Result), Length(Result));
  179. {$ELSE}
  180.     OemToAnsiBuff(@OemStr[1], @Result[1], Length(Result));
  181. {$ENDIF}
  182. end;
  183. function IsEmptyStr(const S: string; const EmptyChars: TCharSet): Boolean;
  184. var
  185.   I, SLen: Integer;
  186. begin
  187.   SLen := Length(S);
  188.   I := 1;
  189.   while I <= SLen do begin
  190.     if not (S[I] in EmptyChars) then begin
  191.       Result := False;
  192.       Exit;
  193.     end
  194.     else Inc(I);
  195.   end;
  196.   Result := True;
  197. end;
  198. function ReplaceStr(const S, Srch, Replace: string): string;
  199. var
  200.   I: Integer;
  201.   Source: string;
  202. begin
  203.   Source := S;
  204.   Result := '';
  205.   repeat
  206.     I := Pos(Srch, Source);
  207.     if I > 0 then begin
  208.       Result := Result + Copy(Source, 1, I - 1) + Replace;
  209.       Source := Copy(Source, I + Length(Srch), MaxInt);
  210.     end
  211.     else Result := Result + Source;
  212.   until I <= 0;
  213. end;
  214. function DelSpace(const S: String): string;
  215. begin
  216.   Result := DelChars(S, ' ');
  217. end;
  218. function DelChars(const S: string; Chr: Char): string;
  219. var
  220.   I: Integer;
  221. begin
  222.   Result := S;
  223.   for I := Length(Result) downto 1 do begin
  224.     if Result[I] = Chr then Delete(Result, I, 1);
  225.   end;
  226. end;
  227. function DelBSpace(const S: string): string;
  228. var
  229.   I, L: Integer;
  230. begin
  231.   L := Length(S);
  232.   I := 1;
  233.   while (I <= L) and (S[I] = ' ') do Inc(I);
  234.   Result := Copy(S, I, MaxInt);
  235. end;
  236. function DelESpace(const S: string): string;
  237. var
  238.   I: Integer;
  239. begin
  240.   I := Length(S);
  241.   while (I > 0) and (S[I] = ' ') do Dec(I);
  242.   Result := Copy(S, 1, I);
  243. end;
  244. function DelRSpace(const S: string): string;
  245. begin
  246.   Result := DelBSpace(DelESpace(S));
  247. end;
  248. function DelSpace1(const S: string): string;
  249. var
  250.   I: Integer;
  251. begin
  252.   Result := S;
  253.   for I := Length(Result) downto 2 do begin
  254.     if (Result[I] = ' ') and (Result[I - 1] = ' ') then
  255.       Delete(Result, I, 1);
  256.   end;
  257. end;
  258. function Tab2Space(const S: string; Numb: Byte): string;
  259. var
  260.   I: Integer;
  261. begin
  262.   I := 1;
  263.   Result := S;
  264.   while I <= Length(Result) do begin
  265.     if Result[I] = Chr(9) then begin
  266.       Delete(Result, I, 1);
  267.       Insert(MakeStr(' ', Numb), Result, I);
  268.       Inc(I, Numb);
  269.     end
  270.     else Inc(I);
  271.   end;
  272. end;
  273. function MakeStr(C: Char; N: Integer): string;
  274. begin
  275.   if N < 1 then Result := ''
  276.   else begin
  277. {$IFNDEF WIN32}
  278.     if N > 255 then N := 255;
  279. {$ENDIF WIN32}
  280.     SetLength(Result, N);
  281.     FillChar(Result[1], Length(Result), C);
  282.   end;
  283. end;
  284. function MS(C: Char; N: Integer): string;
  285. begin
  286.   Result := MakeStr(C, N);
  287. end;
  288. function NPos(const C: string; S: string; N: Integer): Integer;
  289. var
  290.   I, P, K: Integer;
  291. begin
  292.   Result := 0;
  293.   K := 0;
  294.   for I := 1 to N do begin
  295.     P := Pos(C, S);
  296.     Inc(K, P);
  297.     if (I = N) and (P > 0) then begin
  298.       Result := K;
  299.       Exit;
  300.     end;
  301.     if P > 0 then Delete(S, 1, P)
  302.     else Exit;
  303.   end;
  304. end;
  305. function AddChar(C: Char; const S: string; N: Integer): string;
  306. begin
  307.   if Length(S) < N then
  308.     Result := MakeStr(C, N - Length(S)) + S
  309.   else Result := S;
  310. end;
  311. function AddCharR(C: Char; const S: string; N: Integer): string;
  312. begin
  313.   if Length(S) < N then
  314.     Result := S + MakeStr(C, N - Length(S))
  315.   else Result := S;
  316. end;
  317. function LeftStr(const S: string; N: Integer): string;
  318. begin
  319.   Result := AddCharR(' ', S, N);
  320. end;
  321. function RightStr(const S: string; N: Integer): string;
  322. begin
  323.   Result := AddChar(' ', S, N);
  324. end;
  325. function CompStr(const S1, S2: string): Integer;
  326. begin
  327. {$IFDEF WIN32}
  328.   Result := CompareString(GetThreadLocale, SORT_STRINGSORT, PChar(S1),
  329.     Length(S1), PChar(S2), Length(S2)) - 2;
  330. {$ELSE}
  331.   Result := CompareStr(S1, S2);
  332. {$ENDIF}
  333. end;
  334. function CompText(const S1, S2: string): Integer;
  335. begin
  336. {$IFDEF WIN32}
  337.   Result := CompareString(GetThreadLocale, SORT_STRINGSORT or NORM_IGNORECASE,
  338.     PChar(S1), Length(S1), PChar(S2), Length(S2)) - 2;
  339. {$ELSE}
  340.   Result := CompareText(S1, S2);
  341. {$ENDIF}
  342. end;
  343. function Copy2Symb(const S: string; Symb: Char): string;
  344. var
  345.   P: Integer;
  346. begin
  347.   P := Pos(Symb, S);
  348.   if P = 0 then P := Length(S) + 1;
  349.   Result := Copy(S, 1, P - 1);
  350. end;
  351. function Copy2SymbDel(var S: string; Symb: Char): string;
  352. begin
  353.   Result := Copy2Symb(S, Symb);
  354.   S := DelBSpace(Copy(S, Length(Result) + 1, Length(S)));
  355. end;
  356. function Copy2Space(const S: string): string;
  357. begin
  358.   Result := Copy2Symb(S, ' ');
  359. end;
  360. function Copy2SpaceDel(var S: string): string;
  361. begin
  362.   Result := Copy2SymbDel(S, ' ');
  363. end;
  364. function AnsiProperCase(const S: string; const WordDelims: TCharSet): string;
  365. var
  366.   SLen, I: Cardinal;
  367. begin
  368.   Result := AnsiLowerCase(S);
  369.   I := 1;
  370.   SLen := Length(Result);
  371.   while I <= SLen do begin
  372.     while (I <= SLen) and (Result[I] in WordDelims) do Inc(I);
  373.     if I <= SLen then Result[I] := AnsiUpperCase(Result[I])[1];
  374.     while (I <= SLen) and not (Result[I] in WordDelims) do Inc(I);
  375.   end;
  376. end;
  377. function WordCount(const S: string; const WordDelims: TCharSet): Integer;
  378. var
  379.   SLen, I: Cardinal;
  380. begin
  381.   Result := 0;
  382.   I := 1;
  383.   SLen := Length(S);
  384.   while I <= SLen do begin
  385.     while (I <= SLen) and (S[I] in WordDelims) do Inc(I);
  386.     if I <= SLen then Inc(Result);
  387.     while (I <= SLen) and not(S[I] in WordDelims) do Inc(I);
  388.   end;
  389. end;
  390. function WordPosition(const N: Integer; const S: string;
  391.   const WordDelims: TCharSet): Integer;
  392. var
  393.   Count, I: Integer;
  394. begin
  395.   Count := 0;
  396.   I := 1;
  397.   Result := 0;
  398.   while (I <= Length(S)) and (Count <> N) do begin
  399.     { skip over delimiters }
  400.     while (I <= Length(S)) and (S[I] in WordDelims) do Inc(I);
  401.     { if we're not beyond end of S, we're at the start of a word }
  402.     if I <= Length(S) then Inc(Count);
  403.     { if not finished, find the end of the current word }
  404.     if Count <> N then
  405.       while (I <= Length(S)) and not (S[I] in WordDelims) do Inc(I)
  406.     else Result := I;
  407.   end;
  408. end;
  409. function ExtractWord(N: Integer; const S: string;
  410.   const WordDelims: TCharSet): string;
  411. var
  412.   I: Integer;
  413.   Len: Integer;
  414. begin
  415.   Len := 0;
  416.   I := WordPosition(N, S, WordDelims);
  417.   if I <> 0 then
  418.     { find the end of the current word }
  419.     while (I <= Length(S)) and not(S[I] in WordDelims) do begin
  420.       { add the I'th character to result }
  421.       Inc(Len);
  422.       SetLength(Result, Len);
  423.       Result[Len] := S[I];
  424.       Inc(I);
  425.     end;
  426.   SetLength(Result, Len);
  427. end;
  428. function ExtractWordPos(N: Integer; const S: string;
  429.   const WordDelims: TCharSet; var Pos: Integer): string;
  430. var
  431.   I, Len: Integer;
  432. begin
  433.   Len := 0;
  434.   I := WordPosition(N, S, WordDelims);
  435.   Pos := I;
  436.   if I <> 0 then
  437.     { find the end of the current word }
  438.     while (I <= Length(S)) and not(S[I] in WordDelims) do begin
  439.       { add the I'th character to result }
  440.       Inc(Len);
  441.       SetLength(Result, Len);
  442.       Result[Len] := S[I];
  443.       Inc(I);
  444.     end;
  445.   SetLength(Result, Len);
  446. end;
  447. function ExtractDelimited(N: Integer; const S: string;
  448.   const Delims: TCharSet): string;
  449. var
  450.   CurWord: Integer;
  451.   I, Len, SLen: Integer;
  452. begin
  453.   CurWord := 0;
  454.   I := 1;
  455.   Len := 0;
  456.   SLen := Length(S);
  457.   SetLength(Result, 0);
  458.   while (I <= SLen) and (CurWord <> N) do begin
  459.     if S[I] in Delims then Inc(CurWord)
  460.     else begin
  461.       if CurWord = N - 1 then begin
  462.         Inc(Len);
  463.         SetLength(Result, Len);
  464.         Result[Len] := S[I];
  465.       end;
  466.     end;
  467.     Inc(I);
  468.   end;
  469. end;
  470. function ExtractSubstr(const S: string; var Pos: Integer;
  471.   const Delims: TCharSet): string;
  472. var
  473.   I: Integer;
  474. begin
  475.   I := Pos;
  476.   while (I <= Length(S)) and not (S[I] in Delims) do Inc(I);
  477.   Result := Copy(S, Pos, I - Pos);
  478.   if (I <= Length(S)) and (S[I] in Delims) then Inc(I);
  479.   Pos := I;
  480. end;
  481. function IsWordPresent(const W, S: string; const WordDelims: TCharSet): Boolean;
  482. var
  483.   Count, I: Integer;
  484. begin
  485.   Result := False;
  486.   Count := WordCount(S, WordDelims);
  487.   for I := 1 to Count do
  488.     if ExtractWord(I, S, WordDelims) = W then begin
  489.       Result := True;
  490.       Exit;
  491.     end;
  492. end;
  493. {$IFDEF WIN32}
  494.   {$IFNDEF VER90}
  495.     { C++Builder or Delphi 3.0 }
  496.     {$DEFINE MBCS}
  497.   {$ENDIF}
  498. {$ENDIF}
  499. function QuotedString(const S: string; Quote: Char): string;
  500. {$IFDEF MBCS}
  501. begin
  502.   Result := AnsiQuotedStr(S, Quote);
  503. {$ELSE}
  504. var
  505.   I: Integer;
  506. begin
  507.   Result := S;
  508.   for I := Length(Result) downto 1 do
  509.     if Result[I] = Quote then Insert(Quote, Result, I);
  510.   Result := Quote + Result + Quote;
  511. {$ENDIF MBCS}
  512. end;
  513. function ExtractQuotedString(const S: string; Quote: Char): string;
  514. var
  515. {$IFDEF MBCS}
  516.   P: PChar;
  517. begin
  518.   P := PChar(S);
  519.   if P^ = Quote then Result := AnsiExtractQuotedStr(P, Quote)
  520.   else Result := S;
  521. {$ELSE}
  522.   I: Integer;
  523. begin
  524.   Result := S;
  525.   I := Length(Result);
  526.   if (I > 0) and (Result[1] = Quote) and
  527.     (Result[I] = Quote) then
  528.   begin
  529.     Delete(Result, I, 1);
  530.     Delete(Result, 1, 1);
  531.     for I := Length(Result) downto 2 do begin
  532.       if (Result[I] = Quote) and (Result[I - 1] = Quote) then
  533.         Delete(Result, I, 1);
  534.     end;
  535.   end;
  536. {$ENDIF MBCS}
  537. end;
  538. function Numb2USA(const S: string): string;
  539. var
  540.   I, NA: Integer;
  541. begin
  542.   I := Length(S);
  543.   Result := S;
  544.   NA := 0;
  545.   while (I > 0) do begin
  546.     if ((Length(Result) - I + 1 - NA) mod 3 = 0) and (I <> 1) then
  547.     begin
  548.       Insert(',', Result, I);
  549.       Inc(NA);
  550.     end;
  551.     Dec(I);
  552.   end;
  553. end;
  554. function CenterStr(const S: string; Len: Integer): string;
  555. begin
  556.   if Length(S) < Len then begin
  557.     Result := MakeStr(' ', (Len div 2) - (Length(S) div 2)) + S;
  558.     Result := Result + MakeStr(' ', Len - Length(Result));
  559.   end
  560.   else Result := S;
  561. end;
  562. function Dec2Hex(N: LongInt; A: Byte): string;
  563. begin
  564.   Result := IntToHex(N, A);
  565. end;
  566. function D2H(N: LongInt; A: Byte): string;
  567. begin
  568.   Result := IntToHex(N, A);
  569. end;
  570. function Hex2Dec(const S: string): Longint;
  571. var
  572.   HexStr: string;
  573. begin
  574.   if Pos('$', S) = 0 then HexStr := '$' + S
  575.   else HexStr := S;
  576.   Result := StrToIntDef(HexStr, 0);
  577. end;
  578. function H2D(const S: string): Longint;
  579. begin
  580.   Result := Hex2Dec(S);
  581. end;
  582. function Dec2Numb(N: Longint; A, B: Byte): string;
  583. var
  584.   C: Integer;
  585. {$IFDEF RX_D4}
  586.   Number: Cardinal;
  587. {$ELSE}
  588.   Number: Longint;
  589. {$ENDIF}
  590. begin
  591.   if N = 0 then Result := '0'
  592.   else begin
  593. {$IFDEF RX_D4}
  594.     Number := Cardinal(N);
  595. {$ELSE}
  596.     Number := N;
  597. {$ENDIF}
  598.     Result := '';
  599.     while Number > 0 do begin
  600.       C := Number mod B;
  601.       if C > 9 then C := C + 55
  602.       else C := C + 48;
  603.       Result := Chr(C) + Result;
  604.       Number := Number div B;
  605.     end;
  606.   end;
  607.   if Result <> '' then Result := AddChar('0', Result, A);
  608. end;
  609. function Numb2Dec(S: string; B: Byte): Longint;
  610. var
  611.   I, P: Longint;
  612. begin
  613.   I := Length(S);
  614.   Result := 0;
  615.   S := UpperCase(S);
  616.   P := 1;
  617.   while (I >= 1) do begin
  618.     if S[I] > '@' then Result := Result + (Ord(S[I]) - 55) * P
  619.     else Result := Result + (Ord(S[I]) - 48) * P;
  620.     Dec(I);
  621.     P := P * B;
  622.   end;
  623. end;
  624. function RomanToInt(const S: string): Longint;
  625. const
  626.   RomanChars = ['C','D','I','L','M','V','X'];
  627.   RomanValues: array['C'..'X'] of Word =
  628.     (100,500,0,0,0,0,1,0,0,50,1000,0,0,0,0,0,0,0,0,5,0,10);
  629. var
  630.   Index, Next: Char;
  631.   I: Integer;
  632.   Negative: Boolean;
  633. begin
  634.   Result := 0;
  635.   I := 0;
  636.   Negative := (Length(S) > 0) and (S[1] = '-');
  637.   if Negative then Inc(I);
  638.   while (I < Length(S)) do begin
  639.     Inc(I);
  640.     Index := UpCase(S[I]);
  641.     if Index in RomanChars then begin
  642.       if Succ(I) <= Length(S) then Next := UpCase(S[I + 1])
  643.       else Next := #0;
  644.       if (Next in RomanChars) and (RomanValues[Index] < RomanValues[Next]) then
  645.       begin
  646.         Inc(Result, RomanValues[Next]);
  647.         Dec(Result, RomanValues[Index]);
  648.         Inc(I);
  649.       end
  650.       else Inc(Result, RomanValues[Index]);
  651.     end
  652.     else begin
  653.       Result := 0;
  654.       Exit;
  655.     end;
  656.   end;
  657.   if Negative then Result := -Result;
  658. end;
  659. function IntToRoman(Value: Longint): string;
  660. Label
  661.   A500, A400, A100, A90, A50, A40, A10, A9, A5, A4, A1;
  662. begin
  663.   Result := '';
  664. {$IFNDEF WIN32}
  665.   if (Value > MaxInt * 2) then Exit;
  666. {$ENDIF}
  667.   while Value >= 1000 do begin
  668.     Dec(Value, 1000); Result := Result + 'M';
  669.   end;
  670.   if Value < 900 then goto A500
  671.   else begin
  672.     Dec(Value, 900); Result := Result + 'CM';
  673.   end;
  674.   goto A90;
  675. A400:
  676.   if Value < 400 then goto A100
  677.   else begin
  678.     Dec(Value, 400); Result := Result + 'CD';
  679.   end;
  680.   goto A90;
  681. A500:
  682.   if Value < 500 then goto A400
  683.   else begin
  684.     Dec(Value, 500); Result := Result + 'D';
  685.   end;
  686. A100:
  687.   while Value >= 100 do begin
  688.     Dec(Value, 100); Result := Result + 'C';
  689.   end;
  690. A90:
  691.   if Value < 90 then goto A50
  692.   else begin
  693.     Dec(Value, 90); Result := Result + 'XC';
  694.   end;
  695.   goto A9;
  696. A40:
  697.   if Value < 40 then goto A10
  698.   else begin
  699.     Dec(Value, 40); Result := Result + 'XL';
  700.   end;
  701.   goto A9;
  702. A50:
  703.   if Value < 50 then goto A40
  704.   else begin
  705.     Dec(Value, 50); Result := Result + 'L';
  706.   end;
  707. A10:
  708.   while Value >= 10 do begin
  709.     Dec(Value, 10); Result := Result + 'X';
  710.   end;
  711. A9:
  712.   if Value < 9 then goto A5
  713.   else begin
  714.     Result := Result + 'IX';
  715.   end;
  716.   Exit;
  717. A4:
  718.   if Value < 4 then goto A1
  719.   else begin
  720.     Result := Result + 'IV';
  721.   end;
  722.   Exit;
  723. A5:
  724.   if Value < 5 then goto A4
  725.   else begin
  726.     Dec(Value, 5); Result := Result + 'V';
  727.   end;
  728.   goto A1;
  729. A1:
  730.   while Value >= 1 do begin
  731.     Dec(Value); Result := Result + 'I';
  732.   end;
  733. end;
  734. function IntToBin(Value: Longint; Digits, Spaces: Integer): string;
  735. begin
  736.   Result := '';
  737.   if Digits > 32 then Digits := 32;
  738.   while Digits > 0 do begin
  739.     if (Digits mod Spaces) = 0 then Result := Result + ' ';
  740.     Dec(Digits);
  741.     Result := Result + IntToStr((Value shr Digits) and 1);
  742.   end;
  743. end;
  744. function FindPart(const HelpWilds, InputStr: string): Integer;
  745. var
  746.   I, J: Integer;
  747.   Diff: Integer;
  748. begin
  749.   I := Pos('?', HelpWilds);
  750.   if I = 0 then begin
  751.     { if no '?' in HelpWilds }
  752.     Result := Pos(HelpWilds, InputStr);
  753.     Exit;
  754.   end;
  755.   { '?' in HelpWilds }
  756.   Diff := Length(InputStr) - Length(HelpWilds);
  757.   if Diff < 0 then begin
  758.     Result := 0;
  759.     Exit;
  760.   end;
  761.   { now move HelpWilds over InputStr }
  762.   for I := 0 to Diff do begin
  763.     for J := 1 to Length(HelpWilds) do begin
  764.       if (InputStr[I + J] = HelpWilds[J]) or
  765.         (HelpWilds[J] = '?') then
  766.       begin
  767.         if J = Length(HelpWilds) then begin
  768.           Result := I + 1;
  769.           Exit;
  770.         end;
  771.       end
  772.       else Break;
  773.     end;
  774.   end;
  775.   Result := 0;
  776. end;
  777. function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean;
  778.  function SearchNext(var Wilds: string): Integer;
  779.  { looking for next *, returns position and string until position }
  780.  begin
  781.    Result := Pos('*', Wilds);
  782.    if Result > 0 then Wilds := Copy(Wilds, 1, Result - 1);
  783.  end;
  784. var
  785.   CWild, CInputWord: Integer; { counter for positions }
  786.   I, LenHelpWilds: Integer;
  787.   MaxInputWord, MaxWilds: Integer; { Length of InputStr and Wilds }
  788.   HelpWilds: string;
  789. begin
  790.   if Wilds = InputStr then begin
  791.     Result := True;
  792.     Exit;
  793.   end;
  794.   repeat { delete '**', because '**' = '*' }
  795.     I := Pos('**', Wilds);
  796.     if I > 0 then
  797.       Wilds := Copy(Wilds, 1, I - 1) + '*' + Copy(Wilds, I + 2, MaxInt);
  798.   until I = 0;
  799.   if Wilds = '*' then begin { for fast end, if Wilds only '*' }
  800.     Result := True;
  801.     Exit;
  802.   end;
  803.   MaxInputWord := Length(InputStr);
  804.   MaxWilds := Length(Wilds);
  805.   if IgnoreCase then begin { upcase all letters }
  806.     InputStr := AnsiUpperCase(InputStr);
  807.     Wilds := AnsiUpperCase(Wilds);
  808.   end;
  809.   if (MaxWilds = 0) or (MaxInputWord = 0) then begin
  810.     Result := False;
  811.     Exit;
  812.   end;
  813.   CInputWord := 1;
  814.   CWild := 1;
  815.   Result := True;
  816.   repeat
  817.     if InputStr[CInputWord] = Wilds[CWild] then begin { equal letters }
  818.       { goto next letter }
  819.       Inc(CWild);
  820.       Inc(CInputWord);
  821.       Continue;
  822.     end;
  823.     if Wilds[CWild] = '?' then begin { equal to '?' }
  824.       { goto next letter }
  825.       Inc(CWild);
  826.       Inc(CInputWord);
  827.       Continue;
  828.     end;
  829.     if Wilds[CWild] = '*' then begin { handling of '*' }
  830.       HelpWilds := Copy(Wilds, CWild + 1, MaxWilds);
  831.       I := SearchNext(HelpWilds);
  832.       LenHelpWilds := Length(HelpWilds);
  833.       if I = 0 then begin
  834.         { no '*' in the rest, compare the ends }
  835.         if HelpWilds = '' then Exit; { '*' is the last letter }
  836.         { check the rest for equal Length and no '?' }
  837.         for I := 0 to LenHelpWilds - 1 do begin
  838.           if (HelpWilds[LenHelpWilds - I] <> InputStr[MaxInputWord - I]) and
  839.             (HelpWilds[LenHelpWilds - I]<> '?') then
  840.           begin
  841.             Result := False;
  842.             Exit;
  843.           end;
  844.         end;
  845.         Exit;
  846.       end;
  847.       { handle all to the next '*' }
  848.       Inc(CWild, 1 + LenHelpWilds);
  849.       I := FindPart(HelpWilds, Copy(InputStr, CInputWord, MaxInt));
  850.       if I= 0 then begin
  851.         Result := False;
  852.         Exit;
  853.       end;
  854.       CInputWord := I + LenHelpWilds;
  855.       Continue;
  856.     end;
  857.     Result := False;
  858.     Exit;
  859.   until (CInputWord > MaxInputWord) or (CWild > MaxWilds);
  860.   { no completed evaluation }
  861.   if CInputWord <= MaxInputWord then Result := False;
  862.   if (CWild <= MaxWilds) and (Wilds[MaxWilds] <> '*') then Result := False;
  863. end;
  864. function XorString(const Key, Src: ShortString): ShortString;
  865. var
  866.   I: Integer;
  867. begin
  868.   Result := Src;
  869.   if Length(Key) > 0 then
  870.     for I := 1 to Length(Src) do
  871.       Result[I] := Chr(Byte(Key[1 + ((I - 1) mod Length(Key))]) xor Ord(Src[I]));
  872. end;
  873. function XorEncode(const Key, Source: string): string;
  874. var
  875.   I: Integer;
  876.   C: Byte;
  877. begin
  878.   Result := '';
  879.   for I := 1 to Length(Source) do begin
  880.     if Length(Key) > 0 then
  881.       C := Byte(Key[1 + ((I - 1) mod Length(Key))]) xor Byte(Source[I])
  882.     else
  883.       C := Byte(Source[I]);
  884.     Result := Result + AnsiLowerCase(IntToHex(C, 2));
  885.   end;
  886. end;
  887. function XorDecode(const Key, Source: string): string;
  888. var
  889.   I: Integer;
  890.   C: Char;
  891. begin
  892.   Result := '';
  893.   for I := 0 to Length(Source) div 2 - 1 do begin
  894.     C := Chr(StrToIntDef('$' + Copy(Source, (I * 2) + 1, 2), Ord(' ')));
  895.     if Length(Key) > 0 then
  896.       C := Chr(Byte(Key[1 + (I mod Length(Key))]) xor Byte(C));
  897.     Result := Result + C;
  898.   end;
  899. end;
  900. {$IFNDEF RX_D4}
  901. function FindCmdLineSwitch(const Switch: string; SwitchChars: TCharSet;
  902.   IgnoreCase: Boolean): Boolean;
  903. var
  904.   I: Integer;
  905.   S: string;
  906. begin
  907.   for I := 1 to ParamCount do begin
  908.     S := ParamStr(I);
  909.     if (SwitchChars = []) or ((S[1] in SwitchChars) and (Length(S) > 1)) then
  910.     begin
  911.       S := Copy(S, 2, MaxInt);
  912.       if IgnoreCase then begin
  913.         if (AnsiCompareText(S, Switch) = 0) then begin
  914.           Result := True;
  915.           Exit;
  916.         end;
  917.       end
  918.       else begin
  919.         if (AnsiCompareStr(S, Switch) = 0) then begin
  920.           Result := True;
  921.           Exit;
  922.         end;
  923.       end;
  924.     end;
  925.   end;
  926.   Result := False;
  927. end;
  928. {$ENDIF RX_D4}
  929. function GetCmdLineArg(const Switch: string; SwitchChars: TCharSet): string;
  930. var
  931.   I: Integer;
  932.   S: string;
  933. begin
  934.   I := 1;
  935.   while I <= ParamCount do begin
  936.     S := ParamStr(I);
  937.     if (SwitchChars = []) or ((S[1] in SwitchChars) and (Length(S) > 1)) then
  938.     begin
  939.       if (AnsiCompareText(Copy(S, 2, MaxInt), Switch) = 0) then begin
  940.         Inc(I);
  941.         if I <= ParamCount then begin
  942.           Result := ParamStr(I);
  943.           Exit;
  944.         end;
  945.       end;
  946.     end;
  947.     Inc(I);
  948.   end;
  949.   Result := '';
  950. end;
  951. end.