strutil.pas

FIBPlus version 6-96. This is somewhat usefull interbase database components. TFIBDatabase, TFIBTab

{***************************************************************}
{ 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 AnsiChar;

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 CompareStrWA(const S1:string;const S2: AnsiString): Integer;
function AnsiCompareTextWA(const S1,S2: Pointer): Integer;

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

//from Me

function TrimCLRF(const s:String): String;

{procedure CopyChars(const Src:Ansistring; var  Dest:Ansistring;
 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: Ansistring); overload;
procedure DoAnsiUpperCase(var S: string); overload;
procedure DoWideUpperCase(var S: WideString);
procedure DoUtf8Decode(const s:Ansistring; 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 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; overload;
function PosCh1(aCh:AnsiChar; const s:Ansistring; StartPos:integer):integer; overload;
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,Str:String;
                     BeginPos,EndPos:integer;
             BegSub,EndSub:TCharSet
         ):integer;

function FirstPos(Search:array of Char ; const InString:String):integer; overload;
function FirstPos(Search:array of AnsiChar ; const InString:AnsiString):integer; overload;
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:Ansistring):boolean; {$IFDEF D6+} overload;{$ENDIF}
function  IsBeginPartStrWA(const PartStr:string; const TargetStr:Ansistring):boolean;
{$IFDEF D6+}
function  IsBeginPartStr(const PartStr,TargetStr:Widestring):boolean; overload;
{$ENDIF}
// Ansistring procedures
procedure DoLowerCase(var Str:string);overload;
procedure DoLowerCase(var Str:Ansistring);overload;
procedure DoTrim(var Str:string);


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

function FastTrim(const S: string): string;
function FastCopy(const S: String;Index:integer;Count:Integer): String; overload;
function FastCopy(const S: AnsiString;Index:integer;Count:Integer): AnsiString; overload;
// 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:AnsiString; var Name,Value:AnsiString);

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: PAnsiChar): Cardinal;

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

function GUIDAsString(const AGUID: TGUID): Ansistring; // fast GUIDToString
procedure GUIDAsStringToPChar(const AGUID: PGUID; Dest:PAnsiChar);
function StringAsGUID(const AStr: Ansistring): TGUID;
function CompareStrAndGuid(GUID:PGUID;const Str:AnsiString):integer;
function CompareStrAndGuidP(GUID:PGUID;const Str:PAnsiString):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}
;

function InternalAnsiUpperCase(const S: Ansistring): Ansistring;
var
  Len: Integer;
begin
  Len := Length(S);
  SetString(Result, PAnsiChar(S), Len);
  if Len > 0 then
    CharUpperBuffA(PAnsiChar(Result), Len);
end;

{$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 CharInSet(pStr^ , ['+','-']) do
    Inc(pStr);
  if pStr=pStrEnd then
  begin
   Result:=False;
   Exit;
  end;
  while pStr<pStrEnd do
  begin
   if CharInSet(pStr^ , ['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
// 买铕