{
    This file is part of Chentrah,
    Copyright (C) 2004-2008 Anton Rzheshevski (chebmaster@mail.ru).

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 2 of the License, or
    (at your option) any later version.

    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.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see http://www.gnu.org/licenses/

 **********************************************************************

    This file  contains  string handling routines.

 **********************************************************************}

{$ifdef fpc}
  {$codepage utf-8}
  {$mode delphi}
{$endif}

unit cl_strings;
interface
  uses SysUtils, Classes {$ifdef fpc}, strings{$endif};

Type Chars = Set of char;

Const
{  RussianChars: Chars = ['�'..'�', '�'..'�', '�', '�'];
  CyrillicChars: Chars = ['�'..'�', '�'..'�', '�', '�', '�', '�', '�', '�',
                          '�', '�', '�', '�', '�', '�', '�', '�', '�', '�',
                          '�', '�', '�', '�', '�', '�', '�', '�', '�', '�',
                          '�', '�', '�', '�'];}
  LatinChars: Chars = ['A'..'Z', 'a'..'z'];
  NumberChars: Chars = ['0'..'9'];
  ASCIISafeChars = [' '..'~'];

Function Clean(s: AnsiString): AnsiString; OVERLOAD;
Function Clean(s: WideString): WideString; OVERLOAD;

Function PCharToStr(P:PChar):AnsiString;
Function RanStr(s: WideString):WideString; //separator = '~'
//function UpCase(h: char): char;
//function LowCase(h: char): char;
//Function NumParm(s:AnsiString; n:integer):integer;

Function StrParm(s:AnsiString; n:integer{1..}; sep: Chars):AnsiString; OVERLOAD;
Function StrParm(s:WideString; n:integer{1..}; sep: WideChar):WideString; OVERLOAD;

{
Function StrDelSet(s:AnsiString;c:chars):AnsiString;
Function StrFilter(s:AnsiString;c:chars):AnsiString;

Function StrUpLett(s:AnsiString):AnsiString;
Function StrUpFirst(s: AnsiString): AnsiString;
Function StrLowLett(s:AnsiString):AnsiString;
}
Function StrDelAllSp(S:AnsiString):AnsiString;
Function StrCut (S:AnsiString;K:integer ):AnsiString;

Function StrSupplRight(S:AnsiString;K:integer;c:char ):AnsiString;
Function StrSupplLeft(S:AnsiString;K:integer;c:char ):AnsiString;

Function StrRepeat (S:AnsiString;K: integer):AnsiString;
Function StrReplace (S, zamenjaemoe, zamenjajushee:AnsiString):AnsiString;  OVERLOAD;
Function StrReplace (S, zamenjaemoe, zamenjajushee:WideString):WideString;  OVERLOAD;

function substr(S: AnsiString; start: integer; len: integer = 0): AnsiString; overload;
function substr(S: WideString; start: integer; len: integer = 0): WideString; overload;

Function StrContPos (S,w:AnsiString): integer;

Function ParIs(s: AnsiString): BOOLean;

Function OptiPath(s:  String): string;
Function OptiFileName(s:  String): string;

Function DateTimeToP(D: TDateTime; p: integer): string;

function chtrimrightspaces(w: widestring): widestring;


IMPLEMENTATION

function substr(S: AnsiString; start, len: integer): AnsiString;
begin
  if (start < 1) or (start > Length(S)) then Exit('');
  if len = 0 then len:= Length(S);
  if len > (Length(S) - start + 1) then len:= Length(S) - start + 1;
  if (len < 1) then Exit('');
  SetLength(Result, len);
  MOVE(S[start], Result[1], len*SizeOf(AnsiChar));
end;

function substr(S: WideString; start, len: integer): WideString;
begin
  if (start < 1) or (start > Length(S)) then Exit('');
  if len = 0 then len:= Length(S);
  if len > (Length(S) - start + 1) then len:= Length(S) - start + 1;
  if (len < 1) then Exit('');
  SetLength(Result, len);
  MOVE(S[start], Result[1], len*SizeOf(WideChar));
end;


  Function RanStr(s: WideString):WideString;
  var c :integer;
      EM: Array of WideString;
  begin
    SetLength(EM, 1);
    c:=0;
    Repeat
      inc(c);
      IF s[c]='~' then SetLength(EM, Length(EM) + 1)
                  else EM[Length(EM) - 1]:=EM[Length(EM) - 1]+S[c];
    Until c = Length(S);
    RanStr:=EM[Random(Length(EM))];
    SetLength(EM, 0);
  end;

Function StrDelAllSp;
  var c: integer;
      cus: AnsiString;
begin
  cus:='';
  For c:=1 to Length(S) do
    IF S[c] <> ' ' Then cus:=cus+S[c];
  StrDelAllSp:=cus;
end;
{
Function StrUpLett;
var n: integer;
begin
  For n:=1 to Length(s) do s[n]:=UpCase(s[n]);
  StrUpLett:=s
end;

Function StrUpFirst;
begin
  s[1]:=UpCase(s[1]);
  StrUpFirst:=s;
end;

Function StrLowLett;
var n: integer;
begin
  Result:=LowerCase(s);
end;
}

Function StrContPos;
var b,n:integer;
begin
  b:=Length(s)-Length(w)+1;
  repeat
    Dec(b); n:=-1;
    repeat
      Inc(n);
    until (s[b+n]<>w[n+1]) or( n=Length(w)-1)
  until (b=0) or (n=Length(w)-1);
  StrContPos:=b;
end;


Function StrCut ;
begin
  IF K<Length(S) then StrCut:=copy(s,1,K)
                 else StrCut:=s;
end;

Function StrRepeat;
  var cy:integer; cus:AnsiString;
begin
  cus:= '';
  FOR cy:=1 to K do
              IF (255-Length(cus))>=Length(s) then cus:=cus+s
              ELSE if Length(CUS)<255 then
                        cus:=cus+StrCut(s,255-Length(cus));
  StrRepeat := cus;
end;

Function StrReplace (S, zamenjaemoe, zamenjajushee: AnsiString): AnsiString;
var p: integer;
    s2: AnsiString;
begin
  p:=Pos(zamenjaemoe, s);
  While p > 0 do begin
    s:=COPY(s, 1, p - 1) + zamenjajushee + COPY(s, p + Length(zamenjaemoe), Length(s));
    p:=Pos(zamenjaemoe, s);
  end;
  StrReplace:=s;
end;

Function StrReplace (S, zamenjaemoe, zamenjajushee:WideString):WideString;
var p: integer;
    s2: WideString;
begin
  p:=Pos(zamenjaemoe, s);
  While p > 0 do begin
    s:=COPY(s, 1, p - 1) + zamenjajushee + COPY(s, p + Length(zamenjaemoe), Length(s));
    p:=Pos(zamenjaemoe, s);
  end;
  StrReplace:=s;
end;

{
Function StrDelSet;
var cy:integer;Ul:AnsiString;
begin
  ul:='';
  For Cy:=1 to length(s) do
           IF not(s[cy] in c) then ul:=ul+s[cy];
  StrDelSet:=ul;
end;

Function StrFilter;
var cy:integer;Ul:AnsiString;
begin
  ul:='';
  For Cy:=0 to length(s) do
           IF not(s[cy] in c) then ul:=ul+s[cy];
  StrFilter:=ul;
end;
}

Function StrSupplLeft;
begin
  if Length(s)<K Then
        StrSupplLeft:=S+StrRepeat(c,k-Length(s))
  else StrSupplLeft:=s;
end;

Function StrSupplRight;
begin
  if Length(s)<K Then
        StrSupplRight:=StrRepeat(c,k-Length(s))+S
  else StrSupplRight:=s;
end;

{Function NumParm(s:AnsiString;n:integer):integer;
var st: AnsiString;
    i,j:integer;
begin
  st:=StrParm(s,n);
  VAL(st,i,j);
  NumParm:=i;
end;
}

Function StrParm(s:AnsiString; n:integer; sep: Chars):AnsiString;
var
  c,d,p,l: integer;
  h: char;
begin
  h:=#0;
  While not (h in sep) and (h < #255) do inc(h);
  s:=h + s + h + h;
  c:=1; d:=0; p:=0; l:=0;
  Repeat
    While (s[c] in sep) and (c<Length(s)) do Inc(c);
    if c=Length(s) then Break;
    inc(d);
    p:=c;
    While not(s[c] in sep) and (c<Length(s)) do Inc(c);
    l:=c-p;
  Until (d=n) or (c>=Length(s));
  If d=n then StrParm:=Copy(s,p,l) else StrParm:='';
end;

Function StrParm(s:WideString; n:integer; sep: WideChar):WideString;
var
  c,d,p,l: integer;
begin
  s:=sep + s + sep + sep;
  c:=1; d:=0; p:=0; l:=0;
  Repeat
    While (s[c] = sep) and (c < Length(s)) do Inc(c);
    if c=Length(s) then Break;
    inc(d);
    p:=c;
    While not(s[c] = sep) and (c < Length(s)) do Inc(c);
    l:=c-p;
  Until ( d = n ) or (c >= Length(s));
  If d=n then Result:=Copy(s, p, l) else Result:='';
end;


Function ParIs(s: AnsiString): BOOLean;
var c: integer;
begin
  ParIs:=False;
  For c:=1 to ParamCount do
    If UpperCase(ParamStr(c))=UpperCase(s) then ParIs:=True;
end;

{function UpCase(h: char): char;
begin
  Case h of
    'a'..'z': UpCase:=chr(ord(h)+(ord('Z')-ord('z')));
    '�'..'�': UpCase:=chr(ord(h)+(ord('�')-ord('�')));
    '�': UpCase:='�';   '�': UpCase:='�';
    '�': UpCase:='�';   '�': UpCase:='�';
    '�': UpCase:='�';   '�': UpCase:='�';
    '�': UpCase:='�';   '�': UpCase:='�';
    '�': UpCase:='�';   '�': UpCase:='�';
    '�': UpCase:='�';   '�': UpCase:='�';
    '�': UpCase:='�';   '�': UpCase:='�';
    '�': UpCase:='�';
  else
    UpCase:=h;
  end;
end;

function LowCase(h: char): char;
begin
  Case h of
    'A'..'Z': LowCase:=chr(ord(h)+(ord('z')-ord('Z')));
    '�'..'�': LowCase:=chr(ord(h)+(ord('�')-ord('�')));
    '�': LowCase:='�';    '�': LowCase:='�';
    '�': LowCase:='�';    '�': LowCase:='�';
    '�': LowCase:='�';    '�': LowCase:='�';
    '�': LowCase:='�';    '�': LowCase:='�';
    '�': LowCase:='�';    '�': LowCase:='�';
    '�': LowCase:='�';    '�': LowCase:='�';
    '�': LowCase:='�';    '�': LowCase:='�';
    '�': LowCase:='�';
  else
    LowCase:=h;
  end;
end; }

Function PCharToStr(P:PChar):AnsiString;
var
  i: integer;
  p2: PChar;
begin
  if not Assigned(P) then Result:=''
  else begin
    i:=0;
    p2:=p;
    while p2^ <> #0 do begin
      inc(p2);
      inc(i);
    end;
    SetLength(Result, i);
    if i > 0 then Move (p^, Result[1], i);
  end;
end;

Const
  PathSlash = {$ifdef win32}'\'{$else}'/'{$endif};

Function OptiPath(s: string): string;
var
  sl1, sl2: TStringList;
  j: integer;
begin
  sl1:=TStringList.Create;
  sl1.Text:=(StrReplace(StrReplace(ExtractFilepath(s), '\', #13), '/', #13));
  sl2:=TStringList.Create;
  For j:=0 to sl1.Count - 1 do begin
    if sl1[j]='..' then sl2.Delete(sl2.Count - 1)
                   else sl2.Add(sl1[j]);
  end;
  sl1.Free;
  Result:='';
  For j:=0 to sl2.Count - 1 do Result:=Result + sl2[j] + PathSlash;
  sl2.Free;
   {$ifdef win32}
     Result:=StrReplace(Result, '/', '\');
   {$else}
     Result:=StrReplace(Result, '\', '/');
   {$endif}
end;

Function OptiFileName(s:  String): string;
begin
  Result:=OptiPath(s) + ExtractFileName(s);
end;

function DateTimeToP(d: TDateTime; p: integer): string;
var
  s: TsystemTime;
begin
  datetimetosystemtime(d,s);
  Case p of
    0: Result:=IntToStr(s.Minute);
    1: Result:=format('%.2d.%.3d', [s.Second, s.MilliSecond]);
  end;
end;

Function Clean(s: AnsiString): AnsiString; OVERLOAD;
var i: integer;
begin
  For i:=1 to Length(s) do if ord(s[i]) < 32 then s[i]:=' ';
  Result:=s;
end;

Function Clean(s: WideString): WideString; OVERLOAD;
var i: integer;
begin
  For i:=1 to Length(s) do if ord(s[i]) < 32 then s[i]:=' ';
  Result:=s;
end;


function chtrimrightspaces(w: widestring): widestring;
var
  i: integer;
begin
  i:=length(w);
  while (i > 0) and (w[i] = ' ') do dec(i);
  Result:=Copy(w, 1, i);
end;

END.
