diff --git a/rtl/objpas/strutils.pp b/rtl/objpas/strutils.pp new file mode 100644 index 0000000000..e188cf0bf8 --- /dev/null +++ b/rtl/objpas/strutils.pp @@ -0,0 +1,594 @@ +{$mode objfpc} +{$h+} +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 1999-2000 by the Free Pascal development team + + Delphi/Kylix compatibility unit: String handling routines. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +unit strutils; + +interface + +uses + SysUtils{, Types}; + +{ --------------------------------------------------------------------- + Case sensitive search/replace + ---------------------------------------------------------------------} + +Function AnsiResemblesText(const AText, AOther: string): Boolean; +Function AnsiContainsText(const AText, ASubText: string): Boolean; +Function AnsiStartsText(const ASubText, AText: string): Boolean; +Function AnsiEndsText(const ASubText, AText: string): Boolean; +Function AnsiReplaceText(const AText, AFromText, AToText: string): string; +Function AnsiMatchText(const AText: string; const AValues: array of string): Boolean; +Function AnsiIndexText(const AText: string; const AValues: array of string): Integer; + +{ --------------------------------------------------------------------- + Case insensitive search/replace + ---------------------------------------------------------------------} + +Function AnsiContainsStr(const AText, ASubText: string): Boolean; +Function AnsiStartsStr(const ASubText, AText: string): Boolean; +Function AnsiEndsStr(const ASubText, AText: string): Boolean; +Function AnsiReplaceStr(const AText, AFromText, AToText: string): string; +Function AnsiMatchStr(const AText: string; const AValues: array of string): Boolean; +Function AnsiIndexStr(const AText: string; const AValues: array of string): Integer; + +{ --------------------------------------------------------------------- + Playthingies + ---------------------------------------------------------------------} + +Function DupeString(const AText: string; ACount: Integer): string; +Function ReverseString(const AText: string): string; +Function AnsiReverseString(const AText: AnsiString): AnsiString; +Function StuffString(const AText: string; AStart, ALength: Cardinal; const ASubText: string): string; +Function RandomFrom(const AValues: array of string): string; overload; +Function IfThen(AValue: Boolean; const ATrue: string; AFalse: string): string; +Function IfThen(AValue: Boolean; const ATrue: string): string; // ; AFalse: string = '' + +{ --------------------------------------------------------------------- + VB emulations. + ---------------------------------------------------------------------} + +Function LeftStr(const AText: AnsiString; const ACount: Integer): AnsiString; +Function RightStr(const AText: AnsiString; const ACount: Integer): AnsiString; +Function MidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString; +Function RightBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString; +Function MidBStr(const AText: AnsiString; const AByteStart, AByteCount: Integer): AnsiString; +Function AnsiLeftStr(const AText: AnsiString; const ACount: Integer): AnsiString; +Function AnsiRightStr(const AText: AnsiString; const ACount: Integer): AnsiString; +Function AnsiMidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString; +{$ifndef ver1_0} +Function LeftBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString; +Function LeftStr(const AText: WideString; const ACount: Integer): WideString; +Function RightStr(const AText: WideString; const ACount: Integer): WideString; +Function MidStr(const AText: WideString; const AStart, ACount: Integer): WideString; +{$endif} + +{ --------------------------------------------------------------------- + Extended search and replace + ---------------------------------------------------------------------} + +const + { Default word delimiters are any character except the core alphanumerics. } + WordDelimiters: set of Char = [#0..#255] - ['a'..'z','A'..'Z','1'..'9','0']; + +type + TStringSeachOption = (soDown, soMatchCase, soWholeWord); + TStringSearchOptions = set of TStringSeachOption; + +Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String; Options: TStringSearchOptions): PChar; +Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String): PChar; // ; Options: TStringSearchOptions = [soDown] +Function PosEx(const SubStr, S: string; Offset: Cardinal): Integer; +Function PosEx(const SubStr, S: string): Integer; // Offset: Cardinal = 1 + +{ --------------------------------------------------------------------- + Soundex Functions. + ---------------------------------------------------------------------} + +type + TSoundexLength = 1..MaxInt; + +Function Soundex(const AText: string; ALength: TSoundexLength): string; +Function Soundex(const AText: string): string; // ; ALength: TSoundexLength = 4 + +type + TSoundexIntLength = 1..8; + +Function SoundexInt(const AText: string; ALength: TSoundexIntLength): Integer; +Function SoundexInt(const AText: string): Integer; //; ALength: TSoundexIntLength = 4 +Function DecodeSoundexInt(AValue: Integer): string; +Function SoundexWord(const AText: string): Word; +Function DecodeSoundexWord(AValue: Word): string; +Function SoundexSimilar(const AText, AOther: string; ALength: TSoundexLength): Boolean; +Function SoundexSimilar(const AText, AOther: string): Boolean; //; ALength: TSoundexLength = 4 +Function SoundexCompare(const AText, AOther: string; ALength: TSoundexLength): Integer; +Function SoundexCompare(const AText, AOther: string): Integer; //; ALength: TSoundexLength = 4 +Function SoundexProc(const AText, AOther: string): Boolean; + +type + TCompareTextProc = Function(const AText, AOther: string): Boolean; + +Const + AnsiResemblesProc: TCompareTextProc = @SoundexProc; + +implementation + +{ --------------------------------------------------------------------- + Auxiliary functions + ---------------------------------------------------------------------} + +Procedure NotYetImplemented (FN : String); + +begin + Raise Exception.CreateFmt('Function "%s" (strutils) is not yet implemented',[FN]); +end; + +{ --------------------------------------------------------------------- + Case sensitive search/replace + ---------------------------------------------------------------------} + +Function AnsiResemblesText(const AText, AOther: string): Boolean; + +begin + NotYetImplemented(' AnsiResemblesText'); +end; + + + +Function AnsiContainsText(const AText, ASubText: string): Boolean; + +begin + NotYetImplemented(' AnsiContainsText'); +end; + + + +Function AnsiStartsText(const ASubText, AText: string): Boolean; + +begin + NotYetImplemented(' AnsiStartsText'); +end; + + + +Function AnsiEndsText(const ASubText, AText: string): Boolean; + +begin + NotYetImplemented(' AnsiEndsText'); +end; + + + +Function AnsiReplaceText(const AText, AFromText, AToText: string): string; + +begin + NotYetImplemented(' AnsiReplaceText'); +end; + + + +Function AnsiMatchText(const AText: string; const AValues: array of string): Boolean; + +begin + NotYetImplemented(' AnsiMatchText'); +end; + + + +Function AnsiIndexText(const AText: string; const AValues: array of string): Integer; + +begin + NotYetImplemented(' AnsiIndexText'); +end; + + + + +{ --------------------------------------------------------------------- + Case insensitive search/replace + ---------------------------------------------------------------------} + +Function AnsiContainsStr(const AText, ASubText: string): Boolean; + +begin + NotYetImplemented(' AnsiContainsStr'); +end; + + + +Function AnsiStartsStr(const ASubText, AText: string): Boolean; + +begin + NotYetImplemented(' AnsiStartsStr'); +end; + + + +Function AnsiEndsStr(const ASubText, AText: string): Boolean; + +begin + NotYetImplemented(' AnsiEndsStr'); +end; + + + +Function AnsiReplaceStr(const AText, AFromText, AToText: string): string; + +begin + NotYetImplemented(' AnsiReplaceStr'); +end; + + + +Function AnsiMatchStr(const AText: string; const AValues: array of string): Boolean; + +begin + NotYetImplemented(' AnsiMatchStr'); +end; + + + +Function AnsiIndexStr(const AText: string; const AValues: array of string): Integer; + +begin + NotYetImplemented(' AnsiIndexStr'); +end; + + + + +{ --------------------------------------------------------------------- + Playthingies + ---------------------------------------------------------------------} + +Function DupeString(const AText: string; ACount: Integer): string; + +begin + NotYetImplemented(' DupeString'); +end; + + + +Function ReverseString(const AText: string): string; + +begin + NotYetImplemented(' ReverseString'); +end; + + + +Function AnsiReverseString(const AText: AnsiString): AnsiString; + +begin + NotYetImplemented(' AnsiReverseString'); +end; + + + +Function StuffString(const AText: string; AStart, ALength: Cardinal; const ASubText: string): string; + +begin + NotYetImplemented(' StuffString'); +end; + + + +Function RandomFrom(const AValues: array of string): string; overload; + +begin + NotYetImplemented(' RandomFrom'); +end; + + + +Function IfThen(AValue: Boolean; const ATrue: string; AFalse: string): string; + +begin + NotYetImplemented(' IfThen'); +end; + + + +Function IfThen(AValue: Boolean; const ATrue: string): string; // ; AFalse: string = '' + +begin + NotYetImplemented(' IfThen'); +end; + + + + +{ --------------------------------------------------------------------- + VB emulations. + ---------------------------------------------------------------------} + +Function LeftStr(const AText: AnsiString; const ACount: Integer): AnsiString; + +begin + NotYetImplemented(' LeftStr'); +end; + + + +Function RightStr(const AText: AnsiString; const ACount: Integer): AnsiString; + +begin + NotYetImplemented(' RightStr'); +end; + + + +Function MidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString; + +begin + NotYetImplemented(' MidStr'); +end; + + + +Function LeftBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString; + +begin + NotYetImplemented(' LeftBStr'); +end; + + + +Function RightBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString; + +begin + NotYetImplemented(' RightBStr'); +end; + + + +Function MidBStr(const AText: AnsiString; const AByteStart, AByteCount: Integer): AnsiString; + +begin + NotYetImplemented(' MidBStr'); +end; + + + +Function AnsiLeftStr(const AText: AnsiString; const ACount: Integer): AnsiString; + +begin + NotYetImplemented(' AnsiLeftStr'); +end; + + + +Function AnsiRightStr(const AText: AnsiString; const ACount: Integer): AnsiString; + +begin + NotYetImplemented(' AnsiRightStr'); +end; + + + +Function AnsiMidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString; + +begin + NotYetImplemented(' AnsiMidStr'); +end; + +{$ifndef ver1_0} +Function LeftStr(const AText: WideString; const ACount: Integer): WideString; + +begin + NotYetImplemented(' LeftStr'); +end; + + + +Function RightStr(const AText: WideString; const ACount: Integer): WideString; + +begin + NotYetImplemented(' RightStr'); +end; + + + +Function MidStr(const AText: WideString; const AStart, ACount: Integer): WideString; + +begin + NotYetImplemented(' MidStr'); +end; +{$endif} + + + + +{ --------------------------------------------------------------------- + Extended search and replace + ---------------------------------------------------------------------} + +Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String; Options: TStringSearchOptions): PChar; + +begin + NotYetImplemented(' SearchBuf'); +end; + + + +Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String): PChar; // ; Options: TStringSearchOptions = [soDown] + +begin + NotYetImplemented(' SearchBuf'); +end; + + + +Function PosEx(const SubStr, S: string; Offset: Cardinal): Integer; + +begin + NotYetImplemented(' PosEx'); +end; + + + +Function PosEx(const SubStr, S: string): Integer; // Offset: Cardinal = 1 + +begin + NotYetImplemented(' PosEx'); +end; + + + + +{ --------------------------------------------------------------------- + Soundex Functions. + ---------------------------------------------------------------------} +Const +SScore : array[1..255] of Char = + ('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 + '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 + '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 + '0','0','0','0','0','0', // 91..95 + '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 + '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 + '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 + '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 + '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 + '0','0','0','0','0'); // 251..255 + + + +Function Soundex(const AText: string; ALength: TSoundexLength): string; + +Var + S,PS : Char; + I,L : integer; + +begin + Result:=''; + PS:=#0; + If Length(AText)>0 then + begin + Result:=Upcase(AText[1]); + I:=2; + L:=Length(AText); + While (I<=L) and (Length(Result)'i') then + PS:=S; + Inc(I); + end; + end; + L:=Length(Result); + If (L