strutil.pas

FIBPlus is a component suite intended for work with InterBase. It is direct, fast and flexible Inter

{***************************************************************}
{ FIBPlus - component library for direct access to Firebird and }
{ InterBase databases                                           }
{                                                               }
{    FIBPlus is based in part on the product                    }
{    Free IB Components, written by Gregory H. Deatz for        }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.            }
{    mailto:[e-mail]                                    }
{                                                               }
{    Copyright (c) 1998-2007 Devrace Ltd.                       }
{    Written by Serge Buzadzhy ([e-mail])               }
{                                                               }
{ ------------------------------------------------------------- }
{    FIBPlus home page: http://www.fibplus.com/                 }
{    FIBPlus support  : http://www.devrace.com/support/         }
{ ------------------------------------------------------------- }
{                                                               }
{  Please see the file License.txt for full license information }
{***************************************************************}


{*******************************************************}
{                                                       }
{ This unit based on  StrUtils.pas from RX Library      }
{ and SoWldStr.pas from SOHOLIB                         }
{                                                       }
{*******************************************************}

unit StrUtil;

interface

{$I FIBPlus.inc}
uses
   SysUtils,Classes
  {$IFNDEF LINUX}
    ,Windows
  {$ENDIF}
   ;
type
 TCharSet= Set of Char;

const
     CLRF=#13#10;
 // from RX
function MakeStr(C: Char; N: Integer): string;
function StrAsFloat(S:string):double;

function ToClientDateFmt(D:string;caseFmt:byte):string;
function ExtractWord(Num:integer;const Str: string;const  WordDelims:TCharSet):string;
function ExtractLastWord(const Str: string;const  WordDelims:TCharSet):string;
function WordCount(const S: string; const WordDelims: TCharSet): Integer;
//from SOHOLIB

function WildStringCompare( FirstString,SecondString : string ) : boolean;
function MaskCompare(const aString,Mask : string ) : boolean;
function SQLMaskCompare(const aString,Mask : string ) : boolean;  {$IFDEF D6+}overload;{$ENDIF}
{$IFDEF D6+}
function SQLMaskCompare(const aString,Mask : Widestring ) : boolean; overload;
{$ENDIF}
function WldIndexOf(ts:TStrings;const Value:string;CaseSensitive:boolean):integer;

//from Me

function TrimCLRF(const s:string): string;

procedure CopyChars(const Src:string; var  Dest:string;
 StartInSrc,StartInDest,Count:integer
);
function ReplaceStr(const S, Srch, Replace: string): string;

function ReplaceStrInSubstr(const Source :string;const Srch, Replace: string;
            BeginPos,EndPos:integer
): string;
function ReplaceCIStr(const S, Srch, Replace: string;Ansi:boolean =True): string;
function ReplaceStrCIInSubstr(const Source :string;const Srch, Replace:string; 
            BeginPos,EndPos:integer
): string;

function FastUpperCase(const S: string): string; {$IFDEF D9+} inline;{$ENDIF}
procedure DoUpperCase(var S: string;FirstPos:integer=1;LastPos:integer=0);
procedure DoAnsiUpperCase(var S: string);
procedure DoWideUpperCase(var S: WideString);
procedure DoUtf8Decode(const s:string; var ws:WideString); overload;
procedure DoUtf8Decode(const s:variant; var ws:WideString); overload;
function EquelStrings(const s,s1:string; CaseSensitive:boolean):boolean;

function iifStr(Condition:boolean;const Str1,Str2:string ):string;
function iifVariant(Condition:boolean;const Var1,Var2:Variant ):Variant;
function StrOnMask(const StrIn, MaskIn, MaskOut: string):string;
function EasyLikeStr(Str1,Str2:string) :boolean; // Only Russian texts
function StrIsInteger(const Str:string):boolean;

function FormatIdentifierValue(Dialect: Integer; const Value: string): string;{$IFDEF D9+} inline;{$ENDIF}
function FormatIdentifier(Dialect: Integer; const Value: string): string;{$IFDEF D9+} inline;{$ENDIF}
function EasyFormatIdentifier(Dialect: Integer; const Value: string;DoEasy:boolean ): string;{$IFDEF D9+} inline;{$ENDIF}

function EquelNames(CI:boolean; const Value,Value1: string): boolean;{$IFDEF D9+} inline;{$ENDIF}
function NeedQuote(const Name:string):boolean;
function EasyNeedQuote(const Name:string):boolean;

function PosCh(aCh:Char; const s:string):integer;
function PosCh1(aCh:Char; const s:string; StartPos:integer):integer;
function PosCI(const Substr,Str:string):integer;  {$IFDEF D9+} inline;{$ENDIF}
function PosExt(const Substr,Str:string;BegSub,EndSub:TCharSet):integer;{$IFDEF D9+} inline;{$ENDIF}
function PosExtCI(const Substr,Str:string;BegSub,EndSub:TCharSet; AnsiUpper:boolean =True):integer;

function PosInSubstr(const substr,Str:string;
                     BeginPos,EndPos:integer
         ):integer;

function PosInRight(const substr,Str:string;BeginPos:integer):integer;

function PosInSubstrCI(const SearchStr,Str:string;
                     BeginPos,EndPos:integer
         ):integer;

function PosInSubstrExt(const SearchStr:string;Str:string;
                     BeginPos,EndPos:integer;
             BegSub,EndSub:TCharSet
         ):integer;


function PosInSubstrCIExt(const SearchStr:string;Str:string;
                     BeginPos,EndPos:integer;
             BegSub,EndSub:TCharSet
         ):integer;

function FirstPos(Search:array of char ; const InString:string):integer;
function LastChar(const Str:string):Char;

function QuotedStr(const S: string): string;
function CutQuote(const S: string): string;

function  StringInArray(const s:string; const a:array of string):boolean;
function  IsBlank(const Str:string) : boolean;
function  IsBeginPartStr(const PartStr,TargetStr:string):boolean; {$IFDEF D6+} overload;{$ENDIF}
{$IFDEF D6+}
function  IsBeginPartStr(const PartStr,TargetStr:Widestring):boolean; overload;
{$ENDIF}
// string procedures
procedure DoLowerCase(var Str:string);
procedure DoTrim(var Str:string); 


procedure DoTrimTo(const Source:string ;var Dest:string);
procedure DoTrimRight(var Str:string);
procedure DoCopy(const Source:string; var Dest:string; Index, Count: Integer);
function  StrTrimmedLen(Str:PChar):integer;

function FastTrim(const S: string): string;
function FastCopy(const S: string;Index:integer;Count:Integer): string;
// TStringList functions



procedure SLDifference(ASL,BSL:TStringList;ResultSL:TStrings);
function  EmptyStrings(SL:TStrings):boolean;
procedure DeleteEmptyStr(Src:TStrings);
function NonAnsiSortCompareStrings(SL: TStringList; Index1, Index2: Integer):Integer;
function  FindInDiapazon(SL:TStringList;const S: string;const StartIndex,EndIndex:integer;
 AnsiCompare:boolean;
 var Index: Integer
):boolean;

procedure GetNameAndValue(const s:string; var Name,Value:string);

function  StrToDateFmt(const ADate,Fmt:string):TDateTime;
function  DateToSQLStr(const ADate:TDateTime):string;
function  ValueFromStr(const Str:string):string;

{$IFNDEF D6+}
function WideUpperCase(const S: WideString): WideString;
{$ENDIF}
function Q_StrLen(P: PChar): Cardinal;

function IsOldParamName(const ParamName:string):boolean;
function IsNewParamName(const ParamName:string):boolean;
function IsMasParamName(const ParamName:string):boolean;

function GUIDAsString(const AGUID: TGUID): string; // fast GUIDToString
function StringAsGUID(const AStr: string): TGUID;
function CompareStrAndGuid(GUID:PGUID;const Str:string):integer;
function IsEqualGUIDs(const guid1, guid2: TGUID): Boolean;

{Thanks to Anton Tril}


function IsNumericStr(const Str:string):boolean;
function IsEmptyStr(const Str:string):boolean;
function CompareStrTrimmed(const Str1,Str2:PChar; Len:integer):integer;

implementation
uses SysConst
{$IFNDEF D6+}
 ,StdFuncs
{$ENDIF}
;

{$IFNDEF D6+}
type
  IntegerArray  = array[0..$effffff] of Integer;
  PIntegerArray = ^IntegerArray;
{$ENDIF}
function IsNumericStr(const Str:string):boolean;
var
   pStr,pStrEnd:PChar;
begin
  if Length(Str)=0 then
  begin
    Result:=False;
    Exit;
  end;
  pStr:=Pointer(Str);
  pStrEnd:=Pointer(Str);
  Inc(pStrEnd,Length(Str));
  while (pStr<pStrEnd) and (pStr^ in ['+','-']) do
    Inc(pStr);
  if pStr=pStrEnd then
  begin
   Result:=False;
   Exit;
  end;
  while pStr<pStrEnd do
  begin
   if (pStr^ in ['0'..'9','.']) then
    Inc(pStr)
   else
   begin
    Result:=False;
    Exit;
   end;
  end;
  Result:=True;
end;

function IsEmptyStr(const Str:string):boolean;
var
   pStr,pStrEnd:PChar;
begin
  if Length(Str)=0 then
  begin
    Result:=True;
    Exit;
  end;
  pStr:=Pointer(Str);
  pStrEnd:=Pointer(Str);
  Inc(pStrEnd,Length(Str));
  while (pStr<pStrEnd) do
  begin
    if pStr^ > ' ' then
    begin
     Result:=False;
     Exit;
    end;
    Inc(pStr);
  end;
  Result:=True;
end;

function CompareStrTrimmed(const Str1,Str2:PChar; Len:integer):integer;
var
 i:integer;
begin
// 买铕