strutils.pp 45 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859
  1. {
  2. Delphi/Kylix compatibility unit: String handling routines.
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2005 by the Free Pascal development team
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {$mode objfpc}
  12. {$h+}
  13. {$inline on}
  14. unit strutils;
  15. interface
  16. uses
  17. SysUtils{, Types};
  18. { ---------------------------------------------------------------------
  19. Case insensitive search/replace
  20. ---------------------------------------------------------------------}
  21. Function AnsiResemblesText(const AText, AOther: string): Boolean;
  22. Function AnsiContainsText(const AText, ASubText: string): Boolean;
  23. Function AnsiStartsText(const ASubText, AText: string): Boolean;inline;
  24. Function AnsiEndsText(const ASubText, AText: string): Boolean;inline;
  25. Function AnsiReplaceText(const AText, AFromText, AToText: string): string;inline;
  26. Function AnsiMatchText(const AText: string; const AValues: array of string): Boolean;inline;
  27. Function AnsiIndexText(const AText: string; const AValues: array of string): Integer;
  28. { ---------------------------------------------------------------------
  29. Case sensitive search/replace
  30. ---------------------------------------------------------------------}
  31. Function AnsiContainsStr(const AText, ASubText: string): Boolean;inline;
  32. Function AnsiStartsStr(const ASubText, AText: string): Boolean;inline;
  33. Function AnsiEndsStr(const ASubText, AText: string): Boolean;inline;
  34. Function AnsiReplaceStr(const AText, AFromText, AToText: string): string;inline;
  35. Function AnsiMatchStr(const AText: string; const AValues: array of string): Boolean;inline;
  36. Function AnsiIndexStr(const AText: string; const AValues: array of string): Integer;
  37. { ---------------------------------------------------------------------
  38. Playthingies
  39. ---------------------------------------------------------------------}
  40. Function DupeString(const AText: string; ACount: Integer): string;
  41. Function ReverseString(const AText: string): string;
  42. Function AnsiReverseString(const AText: AnsiString): AnsiString;inline;
  43. Function StuffString(const AText: string; AStart, ALength: Cardinal; const ASubText: string): string;
  44. Function RandomFrom(const AValues: array of string): string; overload;
  45. Function IfThen(AValue: Boolean; const ATrue: string; AFalse: string): string;inline;
  46. Function IfThen(AValue: Boolean; const ATrue: string): string;inline; // ; AFalse: string = ''
  47. { ---------------------------------------------------------------------
  48. VB emulations.
  49. ---------------------------------------------------------------------}
  50. Function LeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline;
  51. Function RightStr(const AText: AnsiString; const ACount: Integer): AnsiString;
  52. Function MidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString;inline;
  53. Function RightBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;inline;
  54. Function MidBStr(const AText: AnsiString; const AByteStart, AByteCount: Integer): AnsiString;inline;
  55. Function AnsiLeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline;
  56. Function AnsiRightStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline;
  57. Function AnsiMidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString;inline;
  58. Function LeftBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;inline;
  59. Function LeftStr(const AText: WideString; const ACount: Integer): WideString;inline;
  60. Function RightStr(const AText: WideString; const ACount: Integer): WideString;
  61. Function MidStr(const AText: WideString; const AStart, ACount: Integer): WideString;inline;
  62. { ---------------------------------------------------------------------
  63. Extended search and replace
  64. ---------------------------------------------------------------------}
  65. const
  66. { Default word delimiters are any character except the core alphanumerics. }
  67. WordDelimiters: set of Char = [#0..#255] - ['a'..'z','A'..'Z','1'..'9','0'];
  68. type
  69. TStringSearchOption = (soDown, soMatchCase, soWholeWord);
  70. TStringSearchOptions = set of TStringSearchOption;
  71. TStringSeachOption = TStringSearchOption;
  72. Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String; Options: TStringSearchOptions): PChar;
  73. Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String): PChar;inline; // ; Options: TStringSearchOptions = [soDown]
  74. Function PosEx(const SubStr, S: string; Offset: Cardinal): Integer;
  75. Function PosEx(const SubStr, S: string): Integer;inline; // Offset: Cardinal = 1
  76. Function PosEx(c:char; const S: string; Offset: Cardinal): Integer;
  77. { ---------------------------------------------------------------------
  78. Soundex Functions.
  79. ---------------------------------------------------------------------}
  80. type
  81. TSoundexLength = 1..MaxInt;
  82. Function Soundex(const AText: string; ALength: TSoundexLength): string;
  83. Function Soundex(const AText: string): string;inline; // ; ALength: TSoundexLength = 4
  84. type
  85. TSoundexIntLength = 1..8;
  86. Function SoundexInt(const AText: string; ALength: TSoundexIntLength): Integer;
  87. Function SoundexInt(const AText: string): Integer;inline; //; ALength: TSoundexIntLength = 4
  88. Function DecodeSoundexInt(AValue: Integer): string;
  89. Function SoundexWord(const AText: string): Word;
  90. Function DecodeSoundexWord(AValue: Word): string;
  91. Function SoundexSimilar(const AText, AOther: string; ALength: TSoundexLength): Boolean;inline;
  92. Function SoundexSimilar(const AText, AOther: string): Boolean;inline; //; ALength: TSoundexLength = 4
  93. Function SoundexCompare(const AText, AOther: string; ALength: TSoundexLength): Integer;inline;
  94. Function SoundexCompare(const AText, AOther: string): Integer;inline; //; ALength: TSoundexLength = 4
  95. Function SoundexProc(const AText, AOther: string): Boolean;
  96. type
  97. TCompareTextProc = Function(const AText, AOther: string): Boolean;
  98. Const
  99. AnsiResemblesProc: TCompareTextProc = @SoundexProc;
  100. { ---------------------------------------------------------------------
  101. Other functions, based on RxStrUtils.
  102. ---------------------------------------------------------------------}
  103. function IsEmptyStr(const S: string; const EmptyChars: TSysCharSet): Boolean;
  104. function DelSpace(const S: string): string;
  105. function DelChars(const S: string; Chr: Char): string;
  106. function DelSpace1(const S: string): string;
  107. function Tab2Space(const S: string; Numb: Byte): string;
  108. function NPos(const C: string; S: string; N: Integer): Integer;
  109. Function RPosEX(C:char;const S : AnsiString;offs:cardinal):Integer; overload;
  110. Function RPosex (Const Substr : AnsiString; Const Source : AnsiString;offs:cardinal) : Integer; overload;
  111. Function RPos(c:char;const S : AnsiString):Integer; overload;
  112. Function RPos (Const Substr : AnsiString; Const Source : AnsiString) : Integer; overload;
  113. function AddChar(C: Char; const S: string; N: Integer): string;
  114. function AddCharR(C: Char; const S: string; N: Integer): string;
  115. function PadLeft(const S: string; N: Integer): string;inline;
  116. function PadRight(const S: string; N: Integer): string;inline;
  117. function PadCenter(const S: string; Len: Integer): string;
  118. function Copy2Symb(const S: string; Symb: Char): string;
  119. function Copy2SymbDel(var S: string; Symb: Char): string;
  120. function Copy2Space(const S: string): string;inline;
  121. function Copy2SpaceDel(var S: string): string;inline;
  122. function AnsiProperCase(const S: string; const WordDelims: TSysCharSet): string;
  123. function WordCount(const S: string; const WordDelims: TSysCharSet): Integer;
  124. function WordPosition(const N: Integer; const S: string; const WordDelims: TSysCharSet): Integer;
  125. function ExtractWord(N: Integer; const S: string; const WordDelims: TSysCharSet): string;inline;
  126. function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; var Pos: Integer): string;
  127. function ExtractDelimited(N: Integer; const S: string; const Delims: TSysCharSet): string;
  128. function ExtractSubstr(const S: string; var Pos: Integer; const Delims: TSysCharSet): string;
  129. function IsWordPresent(const W, S: string; const WordDelims: TSysCharSet): Boolean;
  130. function FindPart(const HelpWilds, InputStr: string): Integer;
  131. function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean;
  132. function XorString(const Key, Src: ShortString): ShortString;
  133. function XorEncode(const Key, Source: string): string;
  134. function XorDecode(const Key, Source: string): string;
  135. function GetCmdLineArg(const Switch: string; SwitchChars: TSysCharSet): string;
  136. function Numb2USA(const S: string): string;
  137. function Hex2Dec(const S: string): Longint;
  138. function Dec2Numb(N: Longint; Len, Base: Byte): string;
  139. function Numb2Dec(S: string; Base: Byte): Longint;
  140. function IntToBin(Value: Longint; Digits, Spaces: Integer): string;
  141. function IntToBin(Value: Longint; Digits: Integer): string;
  142. function intToBin(Value: int64; Digits:integer): string;
  143. function IntToRoman(Value: Longint): string;
  144. function RomanToInt(const S: string): Longint;
  145. procedure BinToHex(BinValue, HexValue: PChar; BinBufSize: Integer);
  146. function HexToBin(HexValue, BinValue: PChar; BinBufSize: Integer): Integer;
  147. const
  148. DigitChars = ['0'..'9'];
  149. Brackets = ['(',')','[',']','{','}'];
  150. StdWordDelims = [#0..' ',',','.',';','/','\',':','''','"','`'] + Brackets;
  151. StdSwitchChars = ['-','/'];
  152. function PosSet (const c:TSysCharSet;const s : ansistring ):Integer;
  153. function PosSet (const c:string;const s : ansistring ):Integer;
  154. function PosSetEx (const c:TSysCharSet;const s : ansistring;count:Integer ):Integer;
  155. function PosSetEx (const c:string;const s : ansistring;count:Integer ):Integer;
  156. Procedure Removeleadingchars(VAR S : AnsiString; Const CSet:TSysCharset);
  157. Procedure RemoveTrailingChars(VAR S : AnsiString;Const CSet:TSysCharset);
  158. Procedure RemovePadChars(VAR S : AnsiString;Const CSet:TSysCharset);
  159. function TrimLeftSet(const S: String;const CSet:TSysCharSet): String;
  160. Function TrimRightSet(const S: String;const CSet:TSysCharSet): String;
  161. function TrimSet(const S: String;const CSet:TSysCharSet): String;
  162. implementation
  163. { ---------------------------------------------------------------------
  164. Possibly Exception raising functions
  165. ---------------------------------------------------------------------}
  166. Procedure NotYetImplemented (FN : String);
  167. begin
  168. Raise Exception.CreateFmt('Function "%s" (strutils) is not yet implemented',[FN]);
  169. end;
  170. function Hex2Dec(const S: string): Longint;
  171. var
  172. HexStr: string;
  173. begin
  174. if Pos('$',S)=0 then
  175. HexStr:='$'+ S
  176. else
  177. HexStr:=S;
  178. Result:=StrToInt(HexStr);
  179. end;
  180. {
  181. We turn off implicit exceptions, since these routines are tested, and it
  182. saves 20% codesize (and some speed) and don't throw exceptions, except maybe
  183. heap related. If they don't, that is consider a bug.
  184. In the future, be wary with routines that use strtoint, floating point
  185. and/or format() derivatives. And check every divisor for 0.
  186. }
  187. {$IMPLICITEXCEPTIONS OFF}
  188. { ---------------------------------------------------------------------
  189. Case insensitive search/replace
  190. ---------------------------------------------------------------------}
  191. Function AnsiResemblesText(const AText, AOther: string): Boolean;
  192. begin
  193. if Assigned(AnsiResemblesProc) then
  194. Result:=AnsiResemblesProc(AText,AOther)
  195. else
  196. Result:=False;
  197. end;
  198. Function AnsiContainsText(const AText, ASubText: string): Boolean;
  199. begin
  200. AnsiContainsText:=AnsiPos(AnsiUppercase(ASubText),AnsiUppercase(AText))>0;
  201. end;
  202. Function AnsiStartsText(const ASubText, AText: string): Boolean;inline;
  203. begin
  204. Result:=AnsiCompareText(Copy(AText,1,Length(AsubText)),ASubText)=0;
  205. end;
  206. Function AnsiEndsText(const ASubText, AText: string): Boolean;inline;
  207. begin
  208. result:=AnsiCompareText(Copy(AText,Length(AText)-Length(ASubText)+1,Length(ASubText)),asubtext)=0;
  209. end;
  210. Function AnsiReplaceText(const AText, AFromText, AToText: string): string;inline;
  211. begin
  212. Result := StringReplace(AText,AFromText,AToText,[rfReplaceAll,rfIgnoreCase]);
  213. end;
  214. Function AnsiMatchText(const AText: string; const AValues: array of string): Boolean;inline;
  215. begin
  216. Result:=(AnsiIndexText(AText,AValues)<>-1)
  217. end;
  218. Function AnsiIndexText(const AText: string; const AValues: array of string): Integer;
  219. var i : longint;
  220. begin
  221. result:=-1;
  222. if high(AValues)=-1 Then
  223. Exit;
  224. for i:=low(AValues) to High(Avalues) do
  225. if CompareText(avalues[i],atext)=0 Then
  226. exit(i); // make sure it is the first val.
  227. end;
  228. { ---------------------------------------------------------------------
  229. Case sensitive search/replace
  230. ---------------------------------------------------------------------}
  231. Function AnsiContainsStr(const AText, ASubText: string): Boolean;inline;
  232. begin
  233. Result := AnsiPos(ASubText,AText)>0;
  234. end;
  235. Function AnsiStartsStr(const ASubText, AText: string): Boolean;inline;
  236. begin
  237. Result := AnsiPos(ASubText,AText)=1;
  238. end;
  239. Function AnsiEndsStr(const ASubText, AText: string): Boolean;inline;
  240. begin
  241. Result := AnsiCompareStr(Copy(AText,length(AText)-length(ASubText)+1,length(ASubText)),ASubText)=0;
  242. end;
  243. Function AnsiReplaceStr(const AText, AFromText, AToText: string): string;inline;
  244. begin
  245. Result := StringReplace(AText,AFromText,AToText,[rfReplaceAll]);
  246. end;
  247. Function AnsiMatchStr(const AText: string; const AValues: array of string): Boolean;inline;
  248. begin
  249. Result:=AnsiIndexStr(AText,Avalues)<>-1;
  250. end;
  251. Function AnsiIndexStr(const AText: string; const AValues: array of string): Integer;
  252. var
  253. i : longint;
  254. begin
  255. result:=-1;
  256. if high(AValues)=-1 Then
  257. Exit;
  258. for i:=low(AValues) to High(Avalues) do
  259. if (avalues[i]=AText) Then
  260. exit(i); // make sure it is the first val.
  261. end;
  262. { ---------------------------------------------------------------------
  263. Playthingies
  264. ---------------------------------------------------------------------}
  265. Function DupeString(const AText: string; ACount: Integer): string;
  266. var i,l : integer;
  267. begin
  268. result:='';
  269. if aCount>=0 then
  270. begin
  271. l:=length(atext);
  272. SetLength(result,aCount*l);
  273. for i:=0 to ACount-1 do
  274. move(atext[1],Result[l*i+1],l);
  275. end;
  276. end;
  277. Function ReverseString(const AText: string): string;
  278. var
  279. i,j:longint;
  280. begin
  281. setlength(result,length(atext));
  282. i:=1; j:=length(atext);
  283. while (i<=j) do
  284. begin
  285. result[i]:=atext[j-i+1];
  286. inc(i);
  287. end;
  288. end;
  289. Function AnsiReverseString(const AText: AnsiString): AnsiString;inline;
  290. begin
  291. Result:=ReverseString(AText);
  292. end;
  293. Function StuffString(const AText: string; AStart, ALength: Cardinal; const ASubText: string): string;
  294. var i,j : SizeUInt;
  295. k : SizeInt;
  296. begin
  297. j:=length(ASubText);
  298. i:=length(AText);
  299. if AStart>i then
  300. aStart:=i+1;
  301. k:=i-AStart+1;
  302. if ALength> k then
  303. ALength:=k;
  304. SetLength(Result,i+j-ALength);
  305. move (AText[1],result[1],AStart-1);
  306. move (ASubText[1],result[AStart],j);
  307. move (AText[AStart+ALength], Result[AStart+j],i+1-AStart-ALength);
  308. end;
  309. Function RandomFrom(const AValues: array of string): string; overload;
  310. begin
  311. if high(AValues)=-1 then exit('');
  312. result:=Avalues[random(High(AValues)+1)];
  313. end;
  314. Function IfThen(AValue: Boolean; const ATrue: string; AFalse: string): string;inline;
  315. begin
  316. if avalue then
  317. result:=atrue
  318. else
  319. result:=afalse;
  320. end;
  321. Function IfThen(AValue: Boolean; const ATrue: string): string;inline; // ; AFalse: string = ''
  322. begin
  323. if avalue then
  324. result:=atrue
  325. else
  326. result:='';
  327. end;
  328. { ---------------------------------------------------------------------
  329. VB emulations.
  330. ---------------------------------------------------------------------}
  331. Function LeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline;
  332. begin
  333. Result:=Copy(AText,1,ACount);
  334. end;
  335. Function RightStr(const AText: AnsiString; const ACount: Integer): AnsiString;
  336. var j,l:integer;
  337. begin
  338. l:=length(atext);
  339. j:=ACount;
  340. if j>l then j:=l;
  341. Result:=Copy(AText,l-j+1,j);
  342. end;
  343. Function MidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString;inline;
  344. begin
  345. if (ACount=0) or (AStart>length(atext)) then
  346. exit('');
  347. Result:=Copy(AText,AStart,ACount);
  348. end;
  349. Function LeftBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;inline;
  350. begin
  351. Result:=LeftStr(AText,AByteCount);
  352. end;
  353. Function RightBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;inline;
  354. begin
  355. Result:=RightStr(Atext,AByteCount);
  356. end;
  357. Function MidBStr(const AText: AnsiString; const AByteStart, AByteCount: Integer): AnsiString;inline;
  358. begin
  359. Result:=MidStr(AText,AByteStart,AByteCount);
  360. end;
  361. Function AnsiLeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline;
  362. begin
  363. Result := copy(AText,1,ACount);
  364. end;
  365. Function AnsiRightStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline;
  366. begin
  367. Result := copy(AText,length(AText)-ACount+1,ACount);
  368. end;
  369. Function AnsiMidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString;inline;
  370. begin
  371. Result:=Copy(AText,AStart,ACount);
  372. end;
  373. Function LeftStr(const AText: WideString; const ACount: Integer): WideString;inline;
  374. begin
  375. Result:=Copy(AText,1,ACount);
  376. end;
  377. Function RightStr(const AText: WideString; const ACount: Integer): WideString;
  378. var
  379. j,l:integer;
  380. begin
  381. l:=length(atext);
  382. j:=ACount;
  383. if j>l then j:=l;
  384. Result:=Copy(AText,l-j+1,j);
  385. end;
  386. Function MidStr(const AText: WideString; const AStart, ACount: Integer): WideString;inline;
  387. begin
  388. Result:=Copy(AText,AStart,ACount);
  389. end;
  390. { ---------------------------------------------------------------------
  391. Extended search and replace
  392. ---------------------------------------------------------------------}
  393. Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String; Options: TStringSearchOptions): PChar;
  394. var
  395. Len,I,SLen: Integer;
  396. C: Char;
  397. Found : Boolean;
  398. Direction: Shortint;
  399. CharMap: array[Char] of Char;
  400. Function GotoNextWord(var P : PChar): Boolean;
  401. begin
  402. if (Direction=1) then
  403. begin
  404. // Skip characters
  405. While (Len>0) and not (P^ in WordDelimiters) do
  406. begin
  407. Inc(P);
  408. Dec(Len);
  409. end;
  410. // skip delimiters
  411. While (Len>0) and (P^ in WordDelimiters) do
  412. begin
  413. Inc(P);
  414. Dec(Len);
  415. end;
  416. Result:=Len>0;
  417. end
  418. else
  419. begin
  420. // Skip Delimiters
  421. While (Len>0) and (P^ in WordDelimiters) do
  422. begin
  423. Dec(P);
  424. Dec(Len);
  425. end;
  426. // skip characters
  427. While (Len>0) and not (P^ in WordDelimiters) do
  428. begin
  429. Dec(P);
  430. Dec(Len);
  431. end;
  432. Result:=Len>0;
  433. // We're on the first delimiter. Pos back on char.
  434. Inc(P);
  435. Inc(Len);
  436. end;
  437. end;
  438. begin
  439. Result:=nil;
  440. Slen:=Length(SearchString);
  441. if (BufLen<=0) or (Slen=0) then
  442. Exit;
  443. if soDown in Options then
  444. begin
  445. Direction:=1;
  446. Inc(SelStart,SelLength);
  447. Len:=BufLen-SelStart-SLen+1;
  448. if (Len<=0) then
  449. Exit;
  450. end
  451. else
  452. begin
  453. Direction:=-1;
  454. Dec(SelStart,Length(SearchString));
  455. Len:=SelStart+1;
  456. end;
  457. if (SelStart<0) or (SelStart>BufLen) then
  458. Exit;
  459. Result:=@Buf[SelStart];
  460. for C:=Low(Char) to High(Char) do
  461. if (soMatchCase in Options) then
  462. CharMap[C]:=C
  463. else
  464. CharMap[C]:=Upcase(C);
  465. if Not (soMatchCase in Options) then
  466. SearchString:=UpCase(SearchString);
  467. Found:=False;
  468. while (Result<>Nil) and (Not Found) do
  469. begin
  470. if ((soWholeWord in Options) and
  471. (Result<>@Buf[SelStart]) and
  472. not GotoNextWord(Result)) then
  473. Result:=Nil
  474. else
  475. begin
  476. // try to match whole searchstring
  477. I:=0;
  478. while (I<Slen) and (CharMap[Result[I]]=SearchString[I+1]) do
  479. Inc(I);
  480. // Whole searchstring matched ?
  481. if (I=SLen) then
  482. Found:=(Len=0) or
  483. (not (soWholeWord in Options)) or
  484. (Result[SLen] in WordDelimiters);
  485. if not Found then
  486. begin
  487. Inc(Result,Direction);
  488. Dec(Len);
  489. If (Len=0) then
  490. Result:=Nil;
  491. end;
  492. end;
  493. end;
  494. end;
  495. Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String): PChar;inline; // ; Options: TStringSearchOptions = [soDown]
  496. begin
  497. Result:=SearchBuf(Buf,BufLen,SelStart,SelLength,SearchString,[soDown]);
  498. end;
  499. Function PosEx(const SubStr, S: string; Offset: Cardinal): Integer;
  500. var i : pchar;
  501. begin
  502. if (offset<1) or (offset>SizeUInt(length(s))) then exit(0);
  503. i:=strpos(@s[offset],@substr[1]);
  504. if i=nil then
  505. PosEx:=0
  506. else
  507. PosEx:=succ(i-pchar(pointer(s)));
  508. end;
  509. Function PosEx(const SubStr, S: string): Integer;inline; // Offset: Cardinal = 1
  510. begin
  511. posex:=posex(substr,s,1);
  512. end;
  513. Function PosEx(c:char; const S: string; Offset: Cardinal): Integer;
  514. var l : longint;
  515. begin
  516. if (offset<1) or (offset>SizeUInt(length(s))) then exit(0);
  517. l:=length(s);
  518. {$ifndef useindexbyte}
  519. while (SizeInt(offset)<=l) and (s[offset]<>c) do inc(offset);
  520. if SizeInt(offset)>l then
  521. posex:=0
  522. else
  523. posex:=offset;
  524. {$else}
  525. posex:=offset+indexbyte(s[offset],l-offset+1);
  526. if posex=(offset-1) then
  527. posex:=0;
  528. {$endif}
  529. end;
  530. { ---------------------------------------------------------------------
  531. Soundex Functions.
  532. ---------------------------------------------------------------------}
  533. Const
  534. SScore : array[1..255] of Char =
  535. ('0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0', // 1..32
  536. '0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0', // 33..64
  537. '0','1','2','3','0','1','2','i','0','2','2','4','5','5','0','1','2','6','2','3','0','1','i','2','i','2', // 64..90
  538. '0','0','0','0','0','0', // 91..95
  539. '0','1','2','3','0','1','2','i','0','2','2','4','5','5','0','1','2','6','2','3','0','1','i','2','i','2', // 96..122
  540. '0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0', // 123..154
  541. '0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0', // 155..186
  542. '0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0', // 187..218
  543. '0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0', // 219..250
  544. '0','0','0','0','0'); // 251..255
  545. Function Soundex(const AText: string; ALength: TSoundexLength): string;
  546. Var
  547. S,PS : Char;
  548. I,L : integer;
  549. begin
  550. Result:='';
  551. PS:=#0;
  552. If Length(AText)>0 then
  553. begin
  554. Result:=Upcase(AText[1]);
  555. I:=2;
  556. L:=Length(AText);
  557. While (I<=L) and (Length(Result)<ALength) do
  558. begin
  559. S:=SScore[Ord(AText[i])];
  560. If Not (S in ['0','i',PS]) then
  561. Result:=Result+S;
  562. If (S<>'i') then
  563. PS:=S;
  564. Inc(I);
  565. end;
  566. end;
  567. L:=Length(Result);
  568. If (L<ALength) then
  569. Result:=Result+StringOfChar('0',Alength-L);
  570. end;
  571. Function Soundex(const AText: string): string;inline; // ; ALength: TSoundexLength = 4
  572. begin
  573. Result:=Soundex(AText,4);
  574. end;
  575. Const
  576. Ord0 = Ord('0');
  577. OrdA = Ord('A');
  578. Function SoundexInt(const AText: string; ALength: TSoundexIntLength): Integer;
  579. var
  580. SE: string;
  581. I: Integer;
  582. begin
  583. Result:=-1;
  584. SE:=Soundex(AText,ALength);
  585. If Length(SE)>0 then
  586. begin
  587. Result:=Ord(SE[1])-OrdA;
  588. if ALength > 1 then
  589. begin
  590. Result:=Result*26+(Ord(SE[2])-Ord0);
  591. for I:=3 to ALength do
  592. Result:=(Ord(SE[I])-Ord0)+Result*7;
  593. end;
  594. Result:=ALength+Result*9;
  595. end;
  596. end;
  597. Function SoundexInt(const AText: string): Integer;inline; //; ALength: TSoundexIntLength = 4
  598. begin
  599. Result:=SoundexInt(AText,4);
  600. end;
  601. Function DecodeSoundexInt(AValue: Integer): string;
  602. var
  603. I, Len: Integer;
  604. begin
  605. Result := '';
  606. Len := AValue mod 9;
  607. AValue := AValue div 9;
  608. for I:=Len downto 3 do
  609. begin
  610. Result:=Chr(Ord0+(AValue mod 7))+Result;
  611. AValue:=AValue div 7;
  612. end;
  613. if Len>2 then
  614. Result:=IntToStr(AValue mod 26)+Result;
  615. AValue:=AValue div 26;
  616. Result:=Chr(OrdA+AValue)+Result;
  617. end;
  618. Function SoundexWord(const AText: string): Word;
  619. Var
  620. S : String;
  621. begin
  622. S:=SoundEx(Atext,4);
  623. Result:=Ord(S[1])-OrdA;
  624. Result:=Result*26+ord(S[2])-48;
  625. Result:=Result*7+ord(S[3])-48;
  626. Result:=Result*7+ord(S[4])-48;
  627. end;
  628. Function DecodeSoundexWord(AValue: Word): string;
  629. begin
  630. Result := Chr(Ord0+ (AValue mod 7));
  631. AValue := AValue div 7;
  632. Result := Chr(Ord0+ (AValue mod 7)) + Result;
  633. AValue := AValue div 7;
  634. Result := IntToStr(AValue mod 26) + Result;
  635. AValue := AValue div 26;
  636. Result := Chr(OrdA+AValue) + Result;
  637. end;
  638. Function SoundexSimilar(const AText, AOther: string; ALength: TSoundexLength): Boolean;inline;
  639. begin
  640. Result:=Soundex(AText,ALength)=Soundex(AOther,ALength);
  641. end;
  642. Function SoundexSimilar(const AText, AOther: string): Boolean;inline; //; ALength: TSoundexLength = 4
  643. begin
  644. Result:=SoundexSimilar(AText,AOther,4);
  645. end;
  646. Function SoundexCompare(const AText, AOther: string; ALength: TSoundexLength): Integer;inline;
  647. begin
  648. Result:=AnsiCompareStr(Soundex(AText,ALength),Soundex(AOther,ALength));
  649. end;
  650. Function SoundexCompare(const AText, AOther: string): Integer;inline; //; ALength: TSoundexLength = 4
  651. begin
  652. Result:=SoundexCompare(AText,AOther,4);
  653. end;
  654. Function SoundexProc(const AText, AOther: string): Boolean;
  655. begin
  656. Result:=SoundexSimilar(AText,AOther);
  657. end;
  658. { ---------------------------------------------------------------------
  659. RxStrUtils-like functions.
  660. ---------------------------------------------------------------------}
  661. function IsEmptyStr(const S: string; const EmptyChars: TSysCharSet): Boolean;
  662. var
  663. i,l: Integer;
  664. begin
  665. l:=Length(S);
  666. i:=1;
  667. Result:=True;
  668. while Result and (i<=l) do
  669. begin
  670. Result:=Not (S[i] in EmptyChars);
  671. Inc(i);
  672. end;
  673. end;
  674. function DelSpace(const S: String): string;
  675. begin
  676. Result:=DelChars(S,' ');
  677. end;
  678. function DelChars(const S: string; Chr: Char): string;
  679. var
  680. I,J: Integer;
  681. begin
  682. Result:=S;
  683. I:=Length(Result);
  684. While I>0 do
  685. begin
  686. if Result[I]=Chr then
  687. begin
  688. J:=I-1;
  689. While (J>0) and (Result[J]=Chr) do
  690. Dec(j);
  691. Delete(Result,J+1,I-J);
  692. I:=J+1;
  693. end;
  694. dec(I);
  695. end;
  696. end;
  697. function DelSpace1(const S: string): string;
  698. var
  699. i: Integer;
  700. begin
  701. Result:=S;
  702. for i:=Length(Result) downto 2 do
  703. if (Result[i]=' ') and (Result[I-1]=' ') then
  704. Delete(Result,I,1);
  705. end;
  706. function Tab2Space(const S: string; Numb: Byte): string;
  707. var
  708. I: Integer;
  709. begin
  710. I:=1;
  711. Result:=S;
  712. while I <= Length(Result) do
  713. if Result[I]<>Chr(9) then
  714. inc(I)
  715. else
  716. begin
  717. Result[I]:=' ';
  718. If (Numb>1) then
  719. Insert(StringOfChar('0',Numb-1),Result,I);
  720. Inc(I,Numb);
  721. end;
  722. end;
  723. function NPos(const C: string; S: string; N: Integer): Integer;
  724. var
  725. i,p,k: Integer;
  726. begin
  727. Result:=0;
  728. if N<1 then
  729. Exit;
  730. k:=0;
  731. i:=1;
  732. Repeat
  733. p:=pos(C,S);
  734. Inc(k,p);
  735. if p>0 then
  736. delete(S,1,p);
  737. Inc(i);
  738. Until (i>n) or (p=0);
  739. If (P>0) then
  740. Result:=K;
  741. end;
  742. function AddChar(C: Char; const S: string; N: Integer): string;
  743. Var
  744. l : Integer;
  745. begin
  746. Result:=S;
  747. l:=Length(Result);
  748. if l<N then
  749. Result:=StringOfChar(C,N-l)+Result;
  750. end;
  751. function AddCharR(C: Char; const S: string; N: Integer): string;
  752. Var
  753. l : Integer;
  754. begin
  755. Result:=S;
  756. l:=Length(Result);
  757. if l<N then
  758. Result:=Result+StringOfChar(C,N-l);
  759. end;
  760. function PadRight(const S: string; N: Integer): string;inline;
  761. begin
  762. Result:=AddCharR(' ',S,N);
  763. end;
  764. function PadLeft(const S: string; N: Integer): string;inline;
  765. begin
  766. Result:=AddChar(' ',S,N);
  767. end;
  768. function Copy2Symb(const S: string; Symb: Char): string;
  769. var
  770. p: Integer;
  771. begin
  772. p:=Pos(Symb,S);
  773. if p=0 then
  774. p:=Length(S)+1;
  775. Result:=Copy(S,1,p-1);
  776. end;
  777. function Copy2SymbDel(var S: string; Symb: Char): string;
  778. var
  779. p: Integer;
  780. begin
  781. p:=Pos(Symb,S);
  782. if p=0 then
  783. begin
  784. result:=s;
  785. s:='';
  786. end
  787. else
  788. begin
  789. Result:=Copy(S,1,p-1);
  790. delete(s,1,p);
  791. end;
  792. end;
  793. function Copy2Space(const S: string): string;inline;
  794. begin
  795. Result:=Copy2Symb(S,' ');
  796. end;
  797. function Copy2SpaceDel(var S: string): string;inline;
  798. begin
  799. Result:=Copy2SymbDel(S,' ');
  800. end;
  801. function AnsiProperCase(const S: string; const WordDelims: TSysCharSet): string;
  802. var
  803. // l : Integer;
  804. P,PE : PChar;
  805. begin
  806. Result:=AnsiLowerCase(S);
  807. P:=PChar(pointer(Result));
  808. PE:=P+Length(Result);
  809. while (P<PE) do
  810. begin
  811. while (P<PE) and (P^ in WordDelims) do
  812. inc(P);
  813. if (P<PE) then
  814. P^:=UpCase(P^);
  815. while (P<PE) and not (P^ in WordDelims) do
  816. inc(P);
  817. end;
  818. end;
  819. function WordCount(const S: string; const WordDelims: TSysCharSet): Integer;
  820. var
  821. P,PE : PChar;
  822. begin
  823. Result:=0;
  824. P:=Pchar(pointer(S));
  825. PE:=P+Length(S);
  826. while (P<PE) do
  827. begin
  828. while (P<PE) and (P^ in WordDelims) do
  829. Inc(P);
  830. if (P<PE) then
  831. inc(Result);
  832. while (P<PE) and not (P^ in WordDelims) do
  833. inc(P);
  834. end;
  835. end;
  836. function WordPosition(const N: Integer; const S: string; const WordDelims: TSysCharSet): Integer;
  837. var
  838. PS,P,PE : PChar;
  839. Count: Integer;
  840. begin
  841. Result:=0;
  842. Count:=0;
  843. PS:=PChar(pointer(S));
  844. PE:=PS+Length(S);
  845. P:=PS;
  846. while (P<PE) and (Count<>N) do
  847. begin
  848. while (P<PE) and (P^ in WordDelims) do
  849. inc(P);
  850. if (P<PE) then
  851. inc(Count);
  852. if (Count<>N) then
  853. while (P<PE) and not (P^ in WordDelims) do
  854. inc(P)
  855. else
  856. Result:=(P-PS)+1;
  857. end;
  858. end;
  859. function ExtractWord(N: Integer; const S: string; const WordDelims: TSysCharSet): string;inline;
  860. var
  861. i: Integer;
  862. begin
  863. Result:=ExtractWordPos(N,S,WordDelims,i);
  864. end;
  865. function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; var Pos: Integer): string;
  866. var
  867. i,j,l: Integer;
  868. begin
  869. j:=0;
  870. i:=WordPosition(N, S, WordDelims);
  871. Pos:=i;
  872. if (i<>0) then
  873. begin
  874. j:=i;
  875. l:=Length(S);
  876. while (j<=L) and not (S[j] in WordDelims) do
  877. inc(j);
  878. end;
  879. SetLength(Result,j-i);
  880. If ((j-i)>0) then
  881. Move(S[i],Result[1],j-i);
  882. end;
  883. function ExtractDelimited(N: Integer; const S: string; const Delims: TSysCharSet): string;
  884. var
  885. w,i,l,len: Integer;
  886. begin
  887. w:=0;
  888. i:=1;
  889. l:=0;
  890. len:=Length(S);
  891. SetLength(Result, 0);
  892. while (i<=len) and (w<>N) do
  893. begin
  894. if s[i] in Delims then
  895. inc(w)
  896. else
  897. begin
  898. if (N-1)=w then
  899. begin
  900. inc(l);
  901. SetLength(Result,l);
  902. Result[L]:=S[i];
  903. end;
  904. end;
  905. inc(i);
  906. end;
  907. end;
  908. function ExtractSubstr(const S: string; var Pos: Integer; const Delims: TSysCharSet): string;
  909. var
  910. i,l: Integer;
  911. begin
  912. i:=Pos;
  913. l:=Length(S);
  914. while (i<=l) and not (S[i] in Delims) do
  915. inc(i);
  916. Result:=Copy(S,Pos,i-Pos);
  917. while (i<=l) and (S[i] in Delims) do
  918. inc(i);
  919. Pos:=i;
  920. end;
  921. function isWordPresent(const W, S: string; const WordDelims: TSysCharSet): Boolean;
  922. var
  923. i,Count : Integer;
  924. begin
  925. Result:=False;
  926. Count:=WordCount(S, WordDelims);
  927. I:=1;
  928. While (Not Result) and (I<=Count) do
  929. begin
  930. Result:=ExtractWord(i,S,WordDelims)=W;
  931. Inc(i);
  932. end;
  933. end;
  934. function Numb2USA(const S: string): string;
  935. var
  936. i, NA: Integer;
  937. begin
  938. i:=Length(S);
  939. Result:=S;
  940. NA:=0;
  941. while (i > 0) do begin
  942. if ((Length(Result) - i + 1 - NA) mod 3 = 0) and (i <> 1) then
  943. begin
  944. insert(',', Result, i);
  945. inc(NA);
  946. end;
  947. Dec(i);
  948. end;
  949. end;
  950. function PadCenter(const S: string; Len: Integer): string;
  951. begin
  952. if Length(S)<Len then
  953. begin
  954. Result:=StringOfChar(' ',(Len div 2) -(Length(S) div 2))+S;
  955. Result:=Result+StringOfChar(' ',Len-Length(Result));
  956. end
  957. else
  958. Result:=S;
  959. end;
  960. function Dec2Numb(N: Longint; Len, Base: Byte): string;
  961. var
  962. C: Integer;
  963. Number: Longint;
  964. begin
  965. if N=0 then
  966. Result:='0'
  967. else
  968. begin
  969. Number:=N;
  970. Result:='';
  971. while Number>0 do
  972. begin
  973. C:=Number mod Base;
  974. if C>9 then
  975. C:=C+55
  976. else
  977. C:=C+48;
  978. Result:=Chr(C)+Result;
  979. Number:=Number div Base;
  980. end;
  981. end;
  982. if (Result<>'') then
  983. Result:=AddChar('0',Result,Len);
  984. end;
  985. function Numb2Dec(S: string; Base: Byte): Longint;
  986. var
  987. i, P: Longint;
  988. begin
  989. i:=Length(S);
  990. Result:=0;
  991. S:=UpperCase(S);
  992. P:=1;
  993. while (i>=1) do
  994. begin
  995. if (S[i]>'@') then
  996. Result:=Result+(Ord(S[i])-55)*P
  997. else
  998. Result:=Result+(Ord(S[i])-48)*P;
  999. Dec(i);
  1000. P:=P*Base;
  1001. end;
  1002. end;
  1003. function RomanToint(const S: string): Longint;
  1004. const
  1005. RomanChars = ['C','D','I','L','M','V','X'];
  1006. RomanValues : array['C'..'X'] of Word
  1007. = (100,500,0,0,0,0,1,0,0,50,1000,0,0,0,0,0,0,0,0,5,0,10);
  1008. var
  1009. index, Next: Char;
  1010. i,l: Integer;
  1011. Negative: Boolean;
  1012. begin
  1013. Result:=0;
  1014. i:=0;
  1015. Negative:=(Length(S)>0) and (S[1]='-');
  1016. if Negative then
  1017. inc(i);
  1018. l:=Length(S);
  1019. while (i<l) do
  1020. begin
  1021. inc(i);
  1022. index:=UpCase(S[i]);
  1023. if index in RomanChars then
  1024. begin
  1025. if Succ(i)<=l then
  1026. Next:=UpCase(S[i+1])
  1027. else
  1028. Next:=#0;
  1029. if (Next in RomanChars) and (RomanValues[index]<RomanValues[Next]) then
  1030. begin
  1031. inc(Result, RomanValues[Next]);
  1032. Dec(Result, RomanValues[index]);
  1033. inc(i);
  1034. end
  1035. else
  1036. inc(Result, RomanValues[index]);
  1037. end
  1038. else
  1039. begin
  1040. Result:=0;
  1041. Exit;
  1042. end;
  1043. end;
  1044. if Negative then
  1045. Result:=-Result;
  1046. end;
  1047. function intToRoman(Value: Longint): string;
  1048. const
  1049. Arabics : Array[1..13] of Integer
  1050. = (1,4,5,9,10,40,50,90,100,400,500,900,1000);
  1051. Romans : Array[1..13] of String
  1052. = ('I','IV','V','IX','X','XL','L','XC','C','CD','D','CM','M');
  1053. var
  1054. i: Integer;
  1055. begin
  1056. Result:='';
  1057. for i:=13 downto 1 do
  1058. while (Value >= Arabics[i]) do
  1059. begin
  1060. Value:=Value-Arabics[i];
  1061. Result:=Result+Romans[i];
  1062. end;
  1063. end;
  1064. function intToBin(Value: Longint; Digits, Spaces: Integer): string;
  1065. var endpos : integer;
  1066. p,p2:pchar;
  1067. k: integer;
  1068. begin
  1069. Result:='';
  1070. if (Digits>32) then
  1071. Digits:=32;
  1072. if (spaces=0) then
  1073. begin
  1074. result:=inttobin(value,digits);
  1075. exit;
  1076. end;
  1077. endpos:=digits+ (digits-1) div spaces;
  1078. setlength(result,endpos);
  1079. p:=@result[endpos];
  1080. p2:=@result[1];
  1081. k:=spaces;
  1082. while (p>=p2) do
  1083. begin
  1084. if k=0 then
  1085. begin
  1086. p^:=' ';
  1087. dec(p);
  1088. k:=spaces;
  1089. end;
  1090. p^:=chr(48+(cardinal(value) and 1));
  1091. value:=cardinal(value) shr 1;
  1092. dec(p);
  1093. dec(k);
  1094. end;
  1095. end;
  1096. function intToBin(Value: Longint; Digits:integer): string;
  1097. var p,p2 : pchar;
  1098. begin
  1099. result:='';
  1100. if digits<=0 then exit;
  1101. setlength(result,digits);
  1102. p:=pchar(pointer(@result[digits]));
  1103. p2:=pchar(pointer(@result[1]));
  1104. // typecasts because we want to keep intto* delphi compat and take an integer
  1105. while (p>=p2) and (cardinal(value)>0) do
  1106. begin
  1107. p^:=chr(48+(cardinal(value) and 1));
  1108. value:=cardinal(value) shr 1;
  1109. dec(p);
  1110. end;
  1111. digits:=p-p2+1;
  1112. if digits>0 then
  1113. fillchar(result[1],digits,#48);
  1114. end;
  1115. function intToBin(Value: int64; Digits:integer): string;
  1116. var p,p2 : pchar;
  1117. begin
  1118. result:='';
  1119. if digits<=0 then exit;
  1120. setlength(result,digits);
  1121. p:=pchar(pointer(@result[digits]));
  1122. p2:=pchar(pointer(@result[1]));
  1123. // typecasts because we want to keep intto* delphi compat and take a signed val
  1124. // and avoid warnings
  1125. while (p>=p2) and (qword(value)>0) do
  1126. begin
  1127. p^:=chr(48+(cardinal(value) and 1));
  1128. value:=qword(value) shr 1;
  1129. dec(p);
  1130. end;
  1131. digits:=p-p2+1;
  1132. if digits>0 then
  1133. fillchar(result[1],digits,#48);
  1134. end;
  1135. function FindPart(const HelpWilds, inputStr: string): Integer;
  1136. var
  1137. i, J: Integer;
  1138. Diff: Integer;
  1139. begin
  1140. Result:=0;
  1141. i:=Pos('?',HelpWilds);
  1142. if (i=0) then
  1143. Result:=Pos(HelpWilds, inputStr)
  1144. else
  1145. begin
  1146. Diff:=Length(inputStr) - Length(HelpWilds);
  1147. for i:=0 to Diff do
  1148. begin
  1149. for J:=1 to Length(HelpWilds) do
  1150. if (inputStr[i + J] = HelpWilds[J]) or (HelpWilds[J] = '?') then
  1151. begin
  1152. if (J=Length(HelpWilds)) then
  1153. begin
  1154. Result:=i+1;
  1155. Exit;
  1156. end;
  1157. end
  1158. else
  1159. Break;
  1160. end;
  1161. end;
  1162. end;
  1163. function isWild(inputStr, Wilds: string; ignoreCase: Boolean): Boolean;
  1164. function SearchNext(var Wilds: string): Integer;
  1165. begin
  1166. Result:=Pos('*', Wilds);
  1167. if Result>0 then
  1168. Wilds:=Copy(Wilds,1,Result - 1);
  1169. end;
  1170. var
  1171. CWild, CinputWord: Integer; { counter for positions }
  1172. i, LenHelpWilds: Integer;
  1173. MaxinputWord, MaxWilds: Integer; { Length of inputStr and Wilds }
  1174. HelpWilds: string;
  1175. begin
  1176. if Wilds = inputStr then begin
  1177. Result:=True;
  1178. Exit;
  1179. end;
  1180. repeat { delete '**', because '**' = '*' }
  1181. i:=Pos('**', Wilds);
  1182. if i > 0 then
  1183. Wilds:=Copy(Wilds, 1, i - 1) + '*' + Copy(Wilds, i + 2, Maxint);
  1184. until i = 0;
  1185. if Wilds = '*' then begin { for fast end, if Wilds only '*' }
  1186. Result:=True;
  1187. Exit;
  1188. end;
  1189. MaxinputWord:=Length(inputStr);
  1190. MaxWilds:=Length(Wilds);
  1191. if ignoreCase then begin { upcase all letters }
  1192. inputStr:=AnsiUpperCase(inputStr);
  1193. Wilds:=AnsiUpperCase(Wilds);
  1194. end;
  1195. if (MaxWilds = 0) or (MaxinputWord = 0) then begin
  1196. Result:=False;
  1197. Exit;
  1198. end;
  1199. CinputWord:=1;
  1200. CWild:=1;
  1201. Result:=True;
  1202. repeat
  1203. if inputStr[CinputWord] = Wilds[CWild] then begin { equal letters }
  1204. { goto next letter }
  1205. inc(CWild);
  1206. inc(CinputWord);
  1207. Continue;
  1208. end;
  1209. if Wilds[CWild] = '?' then begin { equal to '?' }
  1210. { goto next letter }
  1211. inc(CWild);
  1212. inc(CinputWord);
  1213. Continue;
  1214. end;
  1215. if Wilds[CWild] = '*' then begin { handling of '*' }
  1216. HelpWilds:=Copy(Wilds, CWild + 1, MaxWilds);
  1217. i:=SearchNext(HelpWilds);
  1218. LenHelpWilds:=Length(HelpWilds);
  1219. if i = 0 then begin
  1220. { no '*' in the rest, compare the ends }
  1221. if HelpWilds = '' then Exit; { '*' is the last letter }
  1222. { check the rest for equal Length and no '?' }
  1223. for i:=0 to LenHelpWilds - 1 do begin
  1224. if (HelpWilds[LenHelpWilds - i] <> inputStr[MaxinputWord - i]) and
  1225. (HelpWilds[LenHelpWilds - i]<> '?') then
  1226. begin
  1227. Result:=False;
  1228. Exit;
  1229. end;
  1230. end;
  1231. Exit;
  1232. end;
  1233. { handle all to the next '*' }
  1234. inc(CWild, 1 + LenHelpWilds);
  1235. i:=FindPart(HelpWilds, Copy(inputStr, CinputWord, Maxint));
  1236. if i= 0 then begin
  1237. Result:=False;
  1238. Exit;
  1239. end;
  1240. CinputWord:=i + LenHelpWilds;
  1241. Continue;
  1242. end;
  1243. Result:=False;
  1244. Exit;
  1245. until (CinputWord > MaxinputWord) or (CWild > MaxWilds);
  1246. { no completed evaluation }
  1247. if CinputWord <= MaxinputWord then Result:=False;
  1248. if (CWild <= MaxWilds) and (Wilds[MaxWilds] <> '*') then Result:=False;
  1249. end;
  1250. function XorString(const Key, Src: ShortString): ShortString;
  1251. var
  1252. i: Integer;
  1253. begin
  1254. Result:=Src;
  1255. if Length(Key) > 0 then
  1256. for i:=1 to Length(Src) do
  1257. Result[i]:=Chr(Byte(Key[1 + ((i - 1) mod Length(Key))]) xor Ord(Src[i]));
  1258. end;
  1259. function XorEncode(const Key, Source: string): string;
  1260. var
  1261. i: Integer;
  1262. C: Byte;
  1263. begin
  1264. Result:='';
  1265. for i:=1 to Length(Source) do
  1266. begin
  1267. if Length(Key) > 0 then
  1268. C:=Byte(Key[1 + ((i - 1) mod Length(Key))]) xor Byte(Source[i])
  1269. else
  1270. C:=Byte(Source[i]);
  1271. Result:=Result+AnsiLowerCase(intToHex(C, 2));
  1272. end;
  1273. end;
  1274. function XorDecode(const Key, Source: string): string;
  1275. var
  1276. i: Integer;
  1277. C: Char;
  1278. begin
  1279. Result:='';
  1280. for i:=0 to Length(Source) div 2 - 1 do
  1281. begin
  1282. C:=Chr(StrTointDef('$' + Copy(Source, (i * 2) + 1, 2), Ord(' ')));
  1283. if Length(Key) > 0 then
  1284. C:=Chr(Byte(Key[1 + (i mod Length(Key))]) xor Byte(C));
  1285. Result:=Result + C;
  1286. end;
  1287. end;
  1288. function GetCmdLineArg(const Switch: string; SwitchChars: TSysCharSet): string;
  1289. var
  1290. i: Integer;
  1291. S: string;
  1292. begin
  1293. i:=1;
  1294. Result:='';
  1295. while (Result='') and (i<=ParamCount) do
  1296. begin
  1297. S:=ParamStr(i);
  1298. if (SwitchChars=[]) or ((S[1] in SwitchChars) and (Length(S) > 1)) and
  1299. (AnsiCompareText(Copy(S,2,Length(S)-1),Switch)=0) then
  1300. begin
  1301. inc(i);
  1302. if i<=ParamCount then
  1303. Result:=ParamStr(i);
  1304. end;
  1305. inc(i);
  1306. end;
  1307. end;
  1308. Function RPosEX(C:char;const S : AnsiString;offs:cardinal):Integer; overload;
  1309. var I : SizeUInt;
  1310. p,p2: pChar;
  1311. Begin
  1312. I:=Length(S);
  1313. If (I<>0) and (offs<=i) Then
  1314. begin
  1315. p:=@s[offs];
  1316. p2:=@s[1];
  1317. while (p2<=p) and (p^<>c) do dec(p);
  1318. RPosEx:=(p-p2)+1;
  1319. end
  1320. else
  1321. RPosEX:=0;
  1322. End;
  1323. Function RPos(c:char;const S : AnsiString):Integer; overload;
  1324. var I : Integer;
  1325. p,p2: pChar;
  1326. Begin
  1327. I:=Length(S);
  1328. If I<>0 Then
  1329. begin
  1330. p:=@s[i];
  1331. p2:=@s[1];
  1332. while (p2<=p) and (p^<>c) do dec(p);
  1333. i:=p-p2+1;
  1334. end;
  1335. RPos:=i;
  1336. End;
  1337. Function RPos (Const Substr : AnsiString; Const Source : AnsiString) : Integer; overload;
  1338. var
  1339. MaxLen,llen : Integer;
  1340. c : char;
  1341. pc,pc2 : pchar;
  1342. begin
  1343. rPos:=0;
  1344. llen:=Length(SubStr);
  1345. maxlen:=length(source);
  1346. if (llen>0) and (maxlen>0) and ( llen<=maxlen) then
  1347. begin
  1348. // i:=maxlen;
  1349. pc:=@source[maxlen];
  1350. pc2:=@source[llen-1];
  1351. c:=substr[llen];
  1352. while pc>=pc2 do
  1353. begin
  1354. if (c=pc^) and
  1355. (CompareChar(Substr[1],pchar(pc-llen+1)^,Length(SubStr))=0) then
  1356. begin
  1357. rPos:=pchar(pc-llen+1)-pchar(@source[1])+1;
  1358. exit;
  1359. end;
  1360. dec(pc);
  1361. end;
  1362. end;
  1363. end;
  1364. Function RPosex (Const Substr : AnsiString; Const Source : AnsiString;offs:cardinal) : Integer; overload;
  1365. var
  1366. MaxLen,llen : Integer;
  1367. c : char;
  1368. pc,pc2 : pchar;
  1369. begin
  1370. rPosex:=0;
  1371. llen:=Length(SubStr);
  1372. maxlen:=length(source);
  1373. if SizeInt(offs)<maxlen then maxlen:=offs;
  1374. if (llen>0) and (maxlen>0) and ( llen<=maxlen) then
  1375. begin
  1376. // i:=maxlen;
  1377. pc:=@source[maxlen];
  1378. pc2:=@source[llen-1];
  1379. c:=substr[llen];
  1380. while pc>=pc2 do
  1381. begin
  1382. if (c=pc^) and
  1383. (CompareChar(Substr[1],pchar(pc-llen+1)^,Length(SubStr))=0) then
  1384. begin
  1385. rPosex:=pchar(pc-llen+1)-pchar(@source[1])+1;
  1386. exit;
  1387. end;
  1388. dec(pc);
  1389. end;
  1390. end;
  1391. end;
  1392. // def from delphi.about.com:
  1393. procedure BinToHex(BinValue, HexValue: PChar; BinBufSize: Integer);
  1394. Const
  1395. HexDigits='0123456789ABCDEF';
  1396. var
  1397. i : longint;
  1398. begin
  1399. for i:=0 to binbufsize-1 do
  1400. begin
  1401. HexValue[0]:=hexdigits[1+((ord(binvalue^) shr 4))];
  1402. HexValue[1]:=hexdigits[1+((ord(binvalue^) and 15))];
  1403. inc(hexvalue,2);
  1404. inc(binvalue);
  1405. end;
  1406. end;
  1407. function HexToBin(HexValue, BinValue: PChar; BinBufSize: Integer): Integer;
  1408. // more complex, have to accept more than bintohex
  1409. // A..F    1000001
  1410. // a..f    1100001
  1411. // 0..9     110000
  1412. var i,j,h,l : integer;
  1413. begin
  1414. i:=binbufsize;
  1415. while (i>0) do
  1416. begin
  1417. if hexvalue^ IN ['A'..'F','a'..'f'] then
  1418. h:=((ord(hexvalue^)+9) and 15)
  1419. else if hexvalue^ IN ['0'..'9'] then
  1420. h:=((ord(hexvalue^)) and 15)
  1421. else
  1422. break;
  1423. inc(hexvalue);
  1424. if hexvalue^ IN ['A'..'F','a'..'f'] then
  1425. l:=(ord(hexvalue^)+9) and 15
  1426. else if hexvalue^ IN ['0'..'9'] then
  1427. l:=(ord(hexvalue^)) and 15
  1428. else
  1429. break;
  1430. j := l + (h shl 4);
  1431. inc(hexvalue);
  1432. binvalue^:=chr(j);
  1433. inc(binvalue);
  1434. dec(i);
  1435. end;
  1436. result:=binbufsize-i;
  1437. end;
  1438. function possetex (const c:TSysCharSet;const s : ansistring;count:Integer ):Integer;
  1439. var i,j:Integer;
  1440. begin
  1441. if pchar(pointer(s))=nil then
  1442. j:=0
  1443. else
  1444. begin
  1445. i:=length(s);
  1446. j:=count;
  1447. if j>i then
  1448. begin
  1449. result:=0;
  1450. exit;
  1451. end;
  1452. while (j<=i) and (not (s[j] in c)) do inc(j);
  1453. if (j>i) then
  1454. j:=0; // not found.
  1455. end;
  1456. result:=j;
  1457. end;
  1458. function posset (const c:TSysCharSet;const s : ansistring ):Integer;
  1459. begin
  1460. result:=possetex(c,s,1);
  1461. end;
  1462. function possetex (const c:string;const s : ansistring;count:Integer ):Integer;
  1463. var cset : TSysCharSet;
  1464. i : integer;
  1465. begin
  1466. cset:=[];
  1467. if length(c)>0 then
  1468. for i:=1 to length(c) do
  1469. include(cset,c[i]);
  1470. result:=possetex(cset,s,count);
  1471. end;
  1472. function posset (const c:string;const s : ansistring ):Integer;
  1473. var cset : TSysCharSet;
  1474. i : integer;
  1475. begin
  1476. cset:=[];
  1477. if length(c)>0 then
  1478. for i:=1 to length(c) do
  1479. include(cset,c[i]);
  1480. result:=possetex(cset,s,1);
  1481. end;
  1482. Procedure Removeleadingchars(VAR S : AnsiString; Const CSet:TSysCharset);
  1483. VAR I,J : Longint;
  1484. Begin
  1485. I:=Length(S);
  1486. IF (I>0) Then
  1487. Begin
  1488. J:=1;
  1489. While (J<=I) And (S[J] IN CSet) DO
  1490. INC(J);
  1491. IF J>1 Then
  1492. Delete(S,1,J-1);
  1493. End;
  1494. End;
  1495. function TrimLeftSet(const S: String;const CSet:TSysCharSet): String;
  1496. begin
  1497. result:=s;
  1498. removeleadingchars(result,cset);
  1499. end;
  1500. Procedure RemoveTrailingChars(VAR S : AnsiString;Const CSet:TSysCharset);
  1501. VAR I,J: LONGINT;
  1502. Begin
  1503. I:=Length(S);
  1504. IF (I>0) Then
  1505. Begin
  1506. J:=I;
  1507. While (j>0) and (S[J] IN CSet) DO DEC(J);
  1508. IF J<>I Then
  1509. SetLength(S,J);
  1510. End;
  1511. End;
  1512. Function TrimRightSet(const S: String;const CSet:TSysCharSet): String;
  1513. begin
  1514. result:=s;
  1515. RemoveTrailingchars(result,cset);
  1516. end;
  1517. Procedure RemovePadChars(VAR S : AnsiString;Const CSet:TSysCharset);
  1518. VAR I,J,K: LONGINT;
  1519. Begin
  1520. I:=Length(S);
  1521. IF (I>0) Then
  1522. Begin
  1523. J:=I;
  1524. While (j>0) and (S[J] IN CSet) DO DEC(J);
  1525. if j=0 Then
  1526. begin
  1527. s:='';
  1528. exit;
  1529. end;
  1530. k:=1;
  1531. While (k<=I) And (S[k] IN CSet) DO
  1532. INC(k);
  1533. IF k>1 Then
  1534. begin
  1535. move(s[k],s[1],j-k+1);
  1536. setlength(s,j-k+1);
  1537. end
  1538. else
  1539. setlength(s,j);
  1540. End;
  1541. End;
  1542. function TrimSet(const S: String;const CSet:TSysCharSet): String;
  1543. begin
  1544. result:=s;
  1545. RemovePadChars(result,cset);
  1546. end;
  1547. end.