unit string_procs;

// some string procedures

interface

uses SysUtils, Classes, Windows, Graphics;

function UpperCaseFirstLetter(s: string): string;

function FirstWord(s: string): string;
function DeleteFirstWord(var s: string): string;
function IniStringFirstPart(s: string): string;
function IniStringSecondPart(s: string): string;

function SingleLetterDelete(var s: string): boolean;

function StrReplace(var s: string; const substr1, substr2: string; recurse: boolean): boolean;

function StrDeleteFirstNumber(var s: string): string;

function Comment(s: string): string; // retrieves a comment from a command line
function TextFromFile(filename: string): string;

function DumpFileName(var s: string): string;

function SplitValue(s: string; var strname: string;
         var chapter, fromverse, toverse: integer): boolean;

function WindowsUserName: string;
function WindowsDirectory: string;
function WindowsTempDirectory: string;

function Hex2Color(s: string): TColor;
function Color2Hex(col: TColor): string;

function ParseHTML(s, HTML: string): string;

function Get_ANAME_VerseNumber(s: string; start, iPos: integer): integer;

const
  DefaultHTMLFilter = '<b></b><i></i><u></u><h1></h1><h2></h2><h3></h3><h4></h4><h5></h5><h6></h6>';

implementation

function FirstWord(s: string): string;
var
  s1: string;
  i: integer;
begin
  Result := '';
  s1 := Trim(s);
  i := Pos(' ', s1);
  if i > 0
  then Result := Copy(s1, 1, i-1)
  else Result := s1;
end;

function DeleteFirstWord(var s: string): string;
var
  s1: string;
  i: integer;
begin
  Result := s;

  s1 := Trim(s);
  i := Pos(' ', s1);
  if i > 0 then begin
    Result := Copy(s, 1, i-1);
    s := Copy(s1, i+1, Length(s1));
  end
  else s := '';
end;

function IniStringFirstPart(s: string): string;
var
  i: integer;
begin
  i := Pos('=', s);
  if i > 0
  then Result := Trim(Copy(s,1,i-1))
  else Result := Trim(s);
end;

function IniStringSecondPart(s: string): string;
var
  i: integer;
begin
  i := Pos('=', s);
  if i > 0
  then Result := Trim(Copy(s,i+1,Length(s)))
  else Result := '';
end;

function StrReplace(var s: string; const substr1, substr2: string; recurse: boolean): boolean;
var
  i,len1: integer;
  res: string;
begin
  Result := true;

  i := Pos(substr1, s);
  if i = 0 then
  begin
    Result := false;
    Exit;
  end;

  len1 := Length(substr1);

  res := '';

  repeat
    res := res + Copy(s,1,i-1) + substr2;
    s := Copy(s,i+len1,Length(s));

    i := Pos(substr1, s);
  until (not recurse) or (i=0);

  s := res + s;
end;

function StrDeleteFirstNumber(var s: string): string;
var
  i,len: integer;
  ok: boolean;
begin
  len := Length(s);

  i := 0;
  repeat
    Inc(i);
    ok := (s[i] >= '0') and (s[i] <= '9');
  until (not ok) or (i = len);

  Result := Copy(s,1,i-1);
  s := Trim(Copy(s,i,len));
end;

function TextFromFile(filename: string): string;
var
  lines: TStrings;
begin
  lines := TStringList.Create;
  try
    lines.LoadFromFile(filename);
    Result := lines.Text;
  except
    Result := '';
  end;
  lines.Free;
end;

function Comment(s: string): string; // retrieves a comment from a command line
var
  i: integer;
begin
  i := Pos('$$$', s);
  if i > 0
  then Result := Trim(Copy(s, i+3, Length(s)))
  else Result := '';
end;

function DumpFileName(var s: string): string;
begin
  Result := s;
  StrReplace(Result, ':', ' ', true);
  StrReplace(Result, '"', ' ', true);
  StrReplace(Result, '?', ' ', true);
  StrReplace(Result, '*', ' ', true);
  StrReplace(Result, '\', ' ', true);
  StrReplace(Result, '/', ' ', true);

  StrReplace(Result, '  ', ' ', true);
  StrReplace(Result, '  ', ' ', true);
  StrReplace(Result, '  ', ' ', true);

  Result := Trim(Result);
end;

function UpperCaseFirstLetter(s: string): string;
begin
  Result := AnsiUpperCase(Copy(s,1,1)) + AnsiLowerCase(Copy(s,2,Length(s)));
end;

// разбор записей типа Быт. 1 : 1- 25 для получения адреса отрывка
// для модуля bookmarks адреса выглядят так: 40.1:2-34

function SplitValue(s: string; var strname: string;
         var chapter, fromverse, toverse: integer): boolean;
var
  scopy: string;
  colonpos, dashpos, spacepos, pointpos, commapos: integer;
begin
  chapter := 1;
  fromverse := 0;
  toverse := 0;

  scopy := Trim(s);

  pointpos := Pos('.', scopy);
  if (pointpos > 0) and (Pos('.', Copy(scopy, pointpos+1, Length(scopy))) > 0)
  then pointpos := pointpos + Pos('.', Copy(scopy, pointpos+1, Length(scopy)));
  // в некоторых книгах две точки в сокращении имени, напр. Прем.Сол.

  spacepos := Pos(' ', scopy);
  if (pointpos = 0) or (spacepos > pointpos+1) then pointpos := spacepos;

  strname := Trim(Copy(scopy, 1, pointpos));

  colonpos := Pos(':', scopy);
  dashpos  := Pos('-', scopy);
  commapos := Pos(',', scopy);
  if dashpos = 0 then dashpos := commapos; // Быт.12:2,3

  try
    if colonpos <> 0 then
      chapter := StrToInt(Trim(Copy(scopy, pointpos+1, colonpos-pointpos-1)))
    else begin
      chapter := StrToInt(Trim(Copy(scopy, pointpos+1, Length(scopy))));

      fromverse := 0;
      toverse := 0;

      Result := true;
      Exit;
    end;

    if dashpos <> 0 then
    begin
      fromverse := StrToInt(Trim(Copy(scopy, colonpos+1, dashpos-colonpos-1)));
      toverse := StrToInt(Trim(Copy(scopy, dashpos+1, Length(scopy))));
    end else
    begin
      fromverse := StrToInt(Trim(Copy(scopy, colonpos+1, Length(scopy))));
      toverse := 0;
    end;

    Result := true;

  except
    Result := false;
  end;

end;

function WindowsUserName: string;
var
  p: PChar;
  s: string;
  i: integer;
begin
  s := 'default';
  SetLength(s, 256);
  for i:=8 to 256 do s[i] := ' ';

  p := PChar(s);
  i := 256;
  GetUserName(p, i);
  SetLength(s, i);

  Result := Trim(s);
end;

function WindowsTempDirectory: string;
var
  p: PChar;
  s: string;
  i: integer;
begin
  SetLength(s,256);
  p := PChar(s);
  i := GetTempPath(256, p);
  SetLength(s, i);

  Result := Trim(s);
  if Result[Length(Result)] <> '\' then Result := Result + '\';
end;

function WindowsDirectory: string;
var
  p: PChar;
  s: string;
  i: integer;
begin
  SetLength(s, 256);
  p := PChar(s);
  i := GetWindowsDirectory(p, 256);
  SetLength(s, i);

  Result := Trim(s);
  if Result[Length(Result)] <> '\' then Result := Result + '\';
end;

function SingleLetterDelete(var s: string): boolean;
var
  snew, sword: string;
begin
  Result := false;
  snew := '';

  while s <> '' do
  begin
    sword := DeleteFirstWord(s);
    if Length(sword) > 1
    then snew := snew + sword + ' '
    else Result := true;
  end;

  s := Trim(snew);
end;

function Char2Hex(c: char): integer;
begin
  if c <= '9'
  then Result := Ord(c)-Ord('0')
  else Result := Ord(c)-Ord('A')+10;
end;

function Hex2Color(s: string): TColor; // #xxyyzz -> TColor
var
  snew: string;
begin
  snew := AnsiUpperCase(s);
  Result := Char2Hex(snew[6]) * 16 + Char2Hex(snew[7]);
  Result := Result * 256;
  Result := Result + Char2Hex(snew[4]) * 16 + Char2Hex(snew[5]);
  Result := Result * 256;
  Result := Result + Char2Hex(snew[2]) * 16 + Char2Hex(snew[3]);
end;

function Color2Hex(col: TColor): string;
begin
  Result := Format('#%.2x%.2x%.2x',
    [col and $FF, (col and $FF00) shr 8, (col and $FF0000) shr 16]);
end;

function ParseHTML(s, HTML: string): string;
var
  Tokens: TStrings;
  i, minvalue: integer;
  tmp: string;
  bydefault: boolean;
begin
  bydefault := (HTML = DefaultHTMLFilter);

  if s = '' then
  begin
    Result := '';
    Exit;
  end;

  Tokens := TStringList.Create;

  i := 0;
  tmp := '';

  minvalue := 256;

  repeat
    Inc(i);

    if s[i] = '<' then
    begin
      Tokens.AddObject(tmp, Pointer(0));

      minvalue := 256;
      tmp := '<';
      continue;
    end;

    if s[i] = '>' then
    begin
      tmp := tmp + '>';
      if (minvalue <= Ord('z'))
      then Tokens.AddObject(tmp, Pointer(1))
      else Tokens.AddObject('&lt;' + Copy(tmp,2,Length(tmp)-2) + '&gt;', Pointer(0));

      // <русское слово> преобразовывается в [русское слово]
      // компонента браузера не показывает текст типа <русское слово>

      minvalue := 256;
      tmp := '';
      continue;
    end else

    if (s[i] <> ' ') and (Ord(s[i]) < minvalue) then
      minvalue := Ord(s[i]);

    tmp := tmp + Copy(s,i,1);

  until i = Length(s);

  Tokens.AddObject(tmp, Pointer(0));

  Result := '';

  for i := 0 to Tokens.Count-1 do
  begin
    if bydefault then
      tmp := AnsiLowerCase(Tokens[i])
    else
      tmp := FirstWord(AnsiLowerCase(Tokens[i]));

    if (Integer(Tokens.Objects[i]) <> 1)
    or (Pos(tmp,HTML) <> 0)
    then Result := Result + Tokens[i];
  end;

  Tokens.Free;
end;

function Get_ANAME_VerseNumber(s: string; start, iPos: integer): integer;
var
  anamepos, len, i: integer;
  sign: string;
begin
  i := start;

  repeat
    sign := '<a name="' + IntToStr(i) + '">';
    len := Length(sign);

    anamepos := Pos(sign, s);
    if (anamepos = 0) or (anamepos >= iPos-len) then break;
    Inc(i);
  until false;

  Result := i-1;
end;

end.
