{*******************************************************}
{                                                       }
{  SunWorld Library            by Sergey Mozharovsky    }
{  swStr v.2003.12                                      }
{                                                       }
{  String Unit                                          }
{  функции для работы со строками                       }
{                                                       }
{  (C) 1991 <SW>  http://uafo.ru/sw                     }
{                                                       }
{*******************************************************}

unit SWStr;

interface

Uses Windows,
     Classes,  // TStringList
     swTy;     // TProcErr, TProcErrP

type
  CharPtr = ^char;
  CharSet = Set of char;


const

(*============================================================================*)
(*                                                                            *)
(*  Предопределенные наборы символов   Set of char                            *)
(*                                                                            *)
(*============================================================================*)
  // Логические значения
  SetYES     = (['Y','y','Д','д','1','+']);      //  bool  TRUE
  SetNO      = (['N','n','Н','н','0','-']);      //  bool  FALSE

  // Числовые форматы
  SetDig     = (['0'..'9']);                     //  цифры
  SetNumbers = (['0'..'9','-','+','.','E','e']); //  вещественные числа
  SetHex     = (['0'..'9','A'..'F']);            //  HEX-символы

  // Символьные наборы
//SetBlanks  = ([#8,#10,#13,' ']   ); // символы эквивал-е пробелу для TRIM
  SetBlanks  = ([#9,#10,#13,' ']   ); // символы эквивал-е пробелу для TRIM
//SymbSet    = ([' '..'~','А'..'п','р'..'я']);   //  все печатные сиволы
  SymbSet    = ([' '..'я']);                     //  все печатные сиволы
  WinCyrSet  = (['Ё','ё','А'..'я'] ); // все русск.символы в кодировке WIN
  SetLat     = (['A'..'Z','a'..'z']); // все латинские буквы
  SetLat_    = (['_','A'..'Z','a'..'z']); // все латинские буквы + '_'
  SetId      = (['0'..'9','_','A'..'Z','a'..'z']); // все латинские буквы

  // Разделители таблиц
  SetFrameChars_   = (['|']);            //раздел-ль таблиц по умолчапнию
  SetFrameCharsDOS = (['|',#$B3..#$DA]); //DOS - разделители таблиц (рамки)
  SetFrameBottomChars = ([#$BC,#$C0,#$C1,#$C8,#$CA,#$D9]); // DOS - рамки
                    //    #$C4,  прямая линия
                    //    #$CD,  двойная линия
  SetFrameCharsWinEmu = ( ['|','-','T','¬','+','¦','L','г','='] );
                        (* символы WIN, к-рые эмулируют DOS-псевдографику *)
                        (* ['-','-','T','¬','+','+','+','¦','L','+','-',
                            'г','=','T','¬','¦','+','¦','¦','L','¦','-',
                            '-','T','¬','¦','+','¦','L','¦','-',
                            'г','T','¬','¦','+','¦','L','¦','-'] *)


(*============================================================================*)
(*                                                                            *)
(*  Обслуживание Exel                                                         *)
(*                                                                            *)
(*============================================================================*)

const

  ChExcelDecPoint : char    = '.'; (* типизированная константа *)



(*============================================================================*)
(*                                                                            *)
(*  Переменная определяющая разделители полей для текстовых таблиц            *)
(*                                                                            *)
(*============================================================================*)

var SetFrameChars : CharSet;

(*============================================================================*)
(*                                                                            *)
(*       Типы для таблиц символов, образующих 16- и 64-тиричные числа         *)
(*                                                                            *)
(*============================================================================*)

type
  THexChars = array [0..$F] of char; // таблица 16-ричных цифр
  T64Chars  = array [0..63] of char; // таблица 64-ричных цифр

const
  chBase64 : T64Chars =   (* для стандартного преобразования Base64 *)
  'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  ch1C64   : T64Chars =   (* стандарт 1С *)
  '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ^abcdefghijklmnopqrstuvwxyz~';
  ch64file : T64Chars =   (* стандарт SW для кодирования имен файлов *)
  '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_-';
  hexChars: THexChars = '0123456789ABCDEF';  (* 16-ричные числа *)


const    (* для вывода двоичных чисел *)
  BinStr: array[0..15] of string[4] = (
    '0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111',
    '1000', '1001', '1010', '1011', '1100', '1101', '1110', '1111');

(*============================================================================*)
(*                                                                            *)
(*       Для символьного вывода месяцев в преобразовании дата -> строка       *)
(*                                                                            *)
(*============================================================================*)

const
  MonthStr: array[1..12] of string[3] = (
    'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
    'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  MesStr: array[1..12] of string[3] = (
    'Янв', 'Фев', 'Мар', 'Апр', 'Май', 'Июн',
    'Июл', 'Авг', 'Сен', 'Окт', 'Ноя', 'Дек');

(*============================================================================*)
(*                                                                            *)
(*       Расширение типа TStringList для правильного освобождения памяти      *)
(*                                                                            *)
(*============================================================================*)

type
  TStrList = class(TStringList)
procedure Clear; override;
destructor Destroy; override;
  end;



(*============================================================================*)
(*                                                                            *)
(*       Расширения стандартных строковых функций SysUtils                    *)
(*                                                                            *)
(*============================================================================*)

(*================================================*)
(*             допролнения ф-ии pos               *)
(*================================================*)

function PosP(T:string;S:string;P1:integer):integer;  (* pos от позиции P1 *)
function posR(T,S:string):integer;                    (* pos справа налево *)
function PosSet(SC:CharSet;S:string):integer;     (* позиция CharSet    *)
function posa(var T;NT:integer;var S;NS:integer):integer;
function posts(T,S:string;var P:integer):string;
function posword(T,S:string):integer;(* позиция отдельного слова T в строке S *)
function PosNoBracke(T,sBrackets,S:string):integer;(* ищем T ВНЕ СКОБОК *)


(*================================================*)
(*             допролнения ф-ии copy              *)
(*================================================*)

function left(S:string;N:integer):string;  overload;
function left(S,subStr:string):string;     overload;
function right(S:string;N:integer):string;     overload;
function right(S:string;subStr:string):string; overload;
function rightfrom(S:string;N:integer):string;     overload;
function rightfrom(S:string;subStr:string):string; overload;
function leftbefore(S:string;subStr:string):string;
function copyfromto(S:string;N1,N2:integer):string;
function copyZ(S:string;I1,N:integer):string;
function Ch(const S:string;I:integer):char;(* I-ый символ слова S *)
procedure TruncAtChar(var S:string;Ch:char);

(*================================================*)
(*        замены, подстановки внутри строки       *)
(*================================================*)

function AnySt(S,sTpl:string):string; (* сделать S непустой строкой *)
procedure ReplaceChar(var S:string;ChIn,ChOut:char);
function SubstChar(S:string;ChIn,ChOut:char):string;

function SubstStr(S,SIn,SOut:string):string;
function TrimDublChar(S:string;ch:char):string;
function SubstInstWord(S,SDiv,SIns:string):string;
function TrimFields(S,SDiv:string):string;


function SubstLast(S,SIn,SOut:string):string; (* только последнее вхождение *)
function SubstCharSet(S:string;SC:CharSet;SOut:string):string;
function SubstCharFromSet(S,sSet:string;Ch:char):string;
(* подставить вместо N символов начиная с позиции J слово SOut *)
function SubstJ(S,SOut:string;J,N:integer):string;  overload;
function SubstJ(S,SOut:string;J:integer):string;  overload;
procedure ExtractBrackets(S,sBrackets:string;var sOut,sValue:string);
function UnBrackets(S,sBrackets:string):string;
function StripChars(S,sChars:string):string;
function UnBlanks(S:string):string;

(* вставить символ ch в позицию i в строке s *)
function sInsChAtPos(s:string;ch:char;i:integer):string;



(*============================================================================*)
(*============================================================================*)
(*============================================================================*)
(*                                                                            *)
(*                СТРОКОВЫЙ ВЫВОД                                             *)
(*                                                                            *)
(*============================================================================*)
(*============================================================================*)
(*============================================================================*)


(*============================================================================*)
(*                                                                            *)
(*             подготовка строки к выводу = форматирование                    *)
(*                                                                            *)
(*============================================================================*)
const
  JLeft1  = -2;    (* со смещением в левую  часть поля вывода + ' ' *)
  JLeft   = -1;    (* со смещением в левую  часть поля вывода       *)
  JCenter =  0;    (* с центрированием                              *)
  JRight  =  1;    (* со смещением в правую часть поля вывода       *)
  JRight1 =  2;    (* со смещением в правую часть поля вывода + ' ' *)

  ITabLength : integer = 8; (* шаг табуляции по умолчанию *)

function JustL(S:string;L1:integer):string;
function JustR(S:string;L1:integer):string;
function JustRNoTrunc(S:string;L1:integer):string;
function JustStr(S:string;L1:integer;Justify:shortint):string;

function StripBlanks(const S:string):string; (* удалить ведущ.и хвост.пробелы *)
function TrimAnyQuot(S:string;QuotChar:char):string;(* 'убрать к''авы''чки'   *)
function QuotedStr(S:string):string;        (* заключить строку в 'кавычки'   *)
function UnTab(S:string):string;            (* развернуть табуляции в пробелы *)
function ToTab(S:string):string;            (* свернуть пробелы в табуляции   *)

(*============================================================================*)
(*                                                                            *)
(*       Преобразования переменных разных типов в строку                      *)
(*                                                                            *)
(*============================================================================*)

function DWORDToS4(W:DWORD):string; (* DWORD -> в строку из 4-х символов *)
function S4ToDWORD(S:string):DWORD; (* строка из 4-х символов -> в DWORD *)
procedure StrToChars(S:string;var Chrs;LL:integer);(* string -> array of char *)

(*================================================*)
(*        перечисление -> в строку                *)
(*================================================*)

function BoolStr(Q:boolean):string;   (* true, false *)
function BoolChr10(Q:boolean):char;   (* 1   , 0     *)
function BSt(Q:boolean;sY,sN:string):string;  overload;
function BSt(I:integer;s0,s1:string):string;  overload;
function BSt(I:integer;s0,s1,s2:string):string;  overload;
function BSt(I:integer;s0,s1,s2,s3:string):string;  overload;
function BSt(I:integer;s0,s1,s2,s3,s4:string):string;  overload;
function CaseSt(I:integer;SL:TStrings):string;  (* счет от 1 до SL.Count *)
function CaseStr(S:string;SL:TStrings):integer;


(*================================================*)
(*         число    ->    в строку                *)
(*================================================*)

//function IntToStr(I:int64):string;
function ISt(I:integer):string;  overload;  (* ЦЕЛОЕ В СТРОКУ *)
function ISt(I:int64):string;    overload;  (* ЦЕЛОЕ В СТРОКУ *)
function ISt(R:real):string;     overload;
function NumStr(I:longint;D:integer):string;(*ЦЕЛОЕ В СТРОКУ С ВЕДУЩИМИ НУЛЯМИ*)
function NSt(I:Int64;D:integer):string;(*ЦЕЛОЕ В СТРОКУ С ВЕДУЩИМИ пробелами*)

function RSt(R:real):string;                overload;
function RSt(R:real;N:integer):string;      overload;
function RSt(R:real;N1,N2:integer):string;  overload;
function FSt(R:real;N,D:integer):string;    overload;
function FSt(R:real;D:integer):string;      overload; // D цифр после запятой
function FSt0(R:real;D:integer):string;               // D цифр после запятой
function FStN(R:real;N:integer):string;  overload;    // N значащих цифр
function FStN(R:real;N:integer;Q0:boolean):string;   overload;

function PerCentToStr(R: real): string;               // '%8.1f'
function ESt(R:real;N:integer):string;   (* N - число значащих цифр *)
function EFSt(R:real;N:integer):string;  (* наиболее короткое из ESt/FStN    *)
function EFSt0(R:real;N:integer):string; (* наиболее короткое из ESt/FSt при *)
                               overload; (* удалении незначащих нулей        *)
function EFSt0(R:real;N:integer;Q0:boolean):string;  overload;

function FESt0(R,RR:real;D:integer):string;  overload;
function FESt0(R:real;D:integer):string;     overload;
function FESt0(R:real;D:integer;Q0:boolean):string;     overload;


function RectSt(R:TRealRect;D:integer):String;


(*===========================================================*)
(* Адрес переменной / содерж.указателя -> в 16-ричную строку *)
(*===========================================================*)

function HexA(var V):string;                (* адрес переменной *)
function HexP(var V):string;                (* содержимое указателя *)
function HandleToStr(var V):string;


(*================================================*)
(*           число  ->  в 16-ричную строку        *)
(*================================================*)

function HexB(B:byte):string;            (* 2 символа  *)
function HexW(W:word):string;            (* 4 символа  *)
function HexL(L:longint):string;         (* 8 символов *)
function HexI(I:longint):string;         (* число в 16-тирич.строку мин.длины *)
function HexI8(I:longint):string;        (* число в 16-тирич.строку 8симв.    *)
function HexI4(I:longint):string;        (* число в 16-тирич.строку 4-8 симв. *)
function HexBuf(var Buf;N:integer):TStringList;              overload;
function HexBuf(var Buf;N:integer;Offset:Int64):TStringList; overload;
function IntToHex(var I;D:integer):string; (* числ.перем.произв.длины -> Hex *)

function BinB(B:byte):string;
function BinW(W:word):string;
function BinL(L:longint):string;
function Bin_L(L:longint):string;


(*================================================*)
(*           прочее                               *)
(*================================================*)

(* вывести номера установленных битов в 4-х байтовом слове *)
function SNBitsL(L:longint):string;

function SSt(S:string;N:integer):string; (* строка -> в строку задан.длинны *)
function ChSt(Ch:char;N:integer):string; (* строка из одинаковых символов *)
                                         (*      (ранее называлась SFill) *)
function TrimR0(S:string):string;  (* убрать нули в конце десятичного числа *)
function CharSetSt(chs:CharSet):string; (* CharSet -> в строку *)
function HWNDSt(h:HWND):string; (* имя и класс окна - в строку *)
(*====== Спец.случаи Число -> в Строку ===========*)
function Spin2Str(q2:integer):string; (* q2/2 в формате атомного спина *)

(* разворачиваем конструкции типа '(X0 X1 dX)'  *)
function SpreadNumLoop(S:string;var sErr:string):string;


function AReSt(A:TARe;L:integer):string;    overload;
function AReSt(A:TARe;n1,L:integer):string; overload;
function AReSL(A:TARe;L:integer):TStringList;
function PointsSL(A:TPointsArray;Dig:integer):TStringList;
function AInSt(A:TAIn):string;


(*============================================================================*)
(*============================================================================*)
(*============================================================================*)
(*                                                                            *)
(*                СТРОКОВЫЙ ВВОД                                              *)
(*                                                                            *)
(*============================================================================*)
(*============================================================================*)
(*============================================================================*)


(*================================================*)
(*       извлечь строки из буфера строк           *)
(*================================================*)

function Buf2Str(var V):string;         (* взять 1-ю строку из буфера строк *)
procedure Buf2Str2(var V;var S1,S2:string);              (* 2 первых строки *)


(*============================================================================*)
(*                                                                            *)
(*        Анализ строки, разбитой на слова пробелами и/или кавычками          *)
(*                                                                            *)
(*                 S - строка, J - позиция в строке, N - номер слова          *)
(*                                                                            *)
(*============================================================================*)

(*--------------------------------------------------------------------------*)
(* последовательный парсинг строки на слова с сохранением текущей позиции J *)
(*--------------------------------------------------------------------------*)

procedure PassBlank(const S:string; var J:integer);(* сойти J с пробелов      *)
procedure SercBlank(const S:string; var J:integer);(* переместить J на пробел *)
procedure SercBlankQuoted(const S:string; var J:integer;ChQuote:char);
procedure PassBlankBack(const S:string; var J:integer);(* назад на конец слова*)
procedure SercBlankBack(const S:string; var J:integer);(* пробел перед словом *)
procedure PassBlankEx(const S:string; var J:integer;BlankChSet:CharSet);
procedure SercBlankEx(const S:string; var J:integer;BlankChSet:CharSet);
procedure SercQuote(const S:string; var J:integer; chQuote:char);



(*--------------------------------------------------------------------------*)
(*    извлечь из строки для заданной текущей позиции J                      *)
(*--------------------------------------------------------------------------*)

function GetWord(const S:string;var J:integer):string;       (* взять слово *)
function GetQuotedWord(const S:string;var J:integer;ChQuote:char):string;
function GetWordEx(const S:string;var J:integer;BlankChSet:CharSet):string;

function GetStrEnd(const S:string;var J:integer):string;(* конец строки *)
function GetOneChar(const S:string;var J:integer):char;(* взять слово и из него первый символ *)

(*--------------------------------------------------------------------------*)
(*    извлечь из строки (поштучно) слово с заданным номером                 *)
(*--------------------------------------------------------------------------*)

function GetWordN(const S:string;N:integer):string; (* взять слово номер N *)
function GetQuotedWordN(const S:string;N:integer;ChQuote:char):string;
function GetBraketWordN(const S:string;N:integer;ChB1,ChB2:char):string;


function GetCurWord(const S:string;jpos:integer):string;
function CutWord(const S:string):string;          (* отрезать последнее слово *)
procedure CutLastWord(var S,SL:string);  (* отрезать последнее слово от других*)

(*--------------------------------------------------------------------------*)
(*    получить количество слов в строке                                     *)
(*--------------------------------------------------------------------------*)

function GetNWord(const S:string):integer; overload;  (* кол-во слов в строке *)
function GetNWord(const S:string;ChQuote,ChDiv:char):integer; overload;
function GetNQuotedWord(const S:string;ChQuote:char):integer;
function GetNBraketWord(const S:string;ChB1,ChB2:char):integer;
function GetNWordEx(const S:string;BlankChSet:CharSet):integer;

(*--------------------------------------------------------------------------*)
(*    получить номер слова по позиции и наоборот                            *)
(*--------------------------------------------------------------------------*)

function GetIWord(const S:string;jpos:integer):integer; (* № слова по позиции *)
function GetIQuotedWord(const S:string;jpos:integer;ChQuote:char):integer;

function GetWordNPos(const S:string;N:integer):integer;(* поз.нач.слова N *)

(*============================================================================*)
(*============================================================================*)
(*                                                                            *)
(*        Анализ строки, разбитой разделителями колонок                       *)
(*                                                                            *)
(*============================================================================*)
(*============================================================================*)

(*--------------------------------------------------------------------------*)
(*   извлечь из строки (поштучно) поля (колонку поля) с заданным номером    *)
(*--------------------------------------------------------------------------*)

function GetFldN(const S:string;D:char;N:integer):string;
function GetFldNWide(const S:string;D:char;N:integer):string;
function GetQuotedFldN(const S:string;D,DQ:char;N:integer):string;
function SLExtractFld(SL : TStrings;D:char;N:integer):TStringList;

(*--------------------------------------------------------------------------*)
(*                  получить информацию о разбиении                         *)
(*--------------------------------------------------------------------------*)

function GetNFld(const S:string;D:char):integer; (* число полей *)
function GetIFld(const S:string;jpos:integer;D:char):integer;(*№поля в позиции*)

(*--------------------------------------------------------------------------*)
(*         заменить значение в поле N на значение подстроки W               *)
(*--------------------------------------------------------------------------*)
function SetFldN(S,W:string;D:char;N:integer):string;

(*--------------------------------------------------------------------------*)
(*   выгрузить/загрузить строку с разделителями в/из [целого] массива       *)
(*--------------------------------------------------------------------------*)

function SetCSVStr(var V;T,D:char;N:integer):string;    (* заполнить строку *)
procedure UpLoadCSVStr(var VA;const S:string;T,D:char;MaxN:integer);(*S->VA *)


(*============================================================================*)
(*                                                                            *)
(*        Извлечь из строки значение по ключу                                 *)
(*                                                                            *)
(*============================================================================*)

(*   Parametr = 36.6  sKey='Parametr' возвращает '36.6'  *)
function ExtractWord(S,sKey:string):string;

(*============================================================================*)
(*                                                                            *)
(*                проверки на принадлежность наборам символов                 *)
(*                                                                            *)
(*============================================================================*)

function InDig(S:string):boolean;    (* строка S содержит только цифры? *)
function InHex(S:string):boolean;    (* строка S содержит только Hex цифры? *)
function InNumber(S:string):boolean; (* цифры, точка, минус, e *)
function InFrameChar(C:char):boolean;
(* символы принадлежат набору Chars и их не менее LMin *)
function StrInChars(S:string;Chars:CharSet;LMin:integer):boolean; overload;
function StrInChars(S:string;Chars:CharSet):boolean;              overload;
(* номер первого символа, к-рый не принадлежит Chars *)
function NotInChars(S:string;Chars:CharSet):integer;

(*--------------------------------------------------------------------------*)
(*   имеются ли символы принадлежащие CharSet CS ?                          *)
(*--------------------------------------------------------------------------*)

function HasCharSet(S:string;CS:CharSet):boolean;           (* хотя бы один  *)
function HasCharSetN(S:string;CS:CharSet;N:integer):boolean;(* подряд N симв.*)


(*============================================================================*)
(*                                                                            *)
(*              преобразования символов в строке, очистка строк               *)
(*                                                                            *)
(*============================================================================*)

function UpCase  (ch: char): char;
function DownCase(ch: char): char;
function StrUpCase  (S:string):string;
function StrDownCase(S:string):string;

function PurifyLet(S:string):string;(* удалить все симв.,кр.анг.и русск. букв *)

(* удалить вхождения STpl из S *)
function SweepOut(S,STpl:string;QAnyCase:boolean):string;
procedure StripComment(var S,SCom:string);(* удалить конец строки после SCom *)
function SweepOutKey(KeyChar:char;sKey,S:string):string;
function sInsE(S:string):string;(* сделать запись числа в E-формате корректной*)

(*============================================================================*)
(*                                                                            *)
(*              анализ последнего значащего символа в строке                  *)
(*                                                                            *)
(*============================================================================*)

function QLastSign(S:string;J:integer):boolean; (* имеет номер J *) overload;
function QLastSign(S:string;Ch:char  ):boolean; (* это Ch?       *) overload;

(*============================================================================*)
(*                                                                            *)
(*              сравнения строк                                               *)
(*                                                                            *)
(*============================================================================*)

function LessStrDig(S1,S2:string):boolean;(* сравнение строк, содержащих числа*)





(*============================================================================*)
(*============================================================================*)
(*                                                                            *)
(*              ПАРСИНГ СТРОКОВЫХ ЗНАЧЕНИЙ                                    *)
(*                                                                            *)
(*============================================================================*)
(*============================================================================*)


(*==========================================================================*)
(*                                                                          *)
(*      настраиваемые извне функции реакции на ошибки разбора значений      *)
(*                                                                          *)
(*==========================================================================*)
procedure ErrSW(sErr:string);(* для обработки ошибок *)
procedure ErrPSW(sErr:string;EPos:integer);(* для обработки ошибок *)



(*==========================================================================*)
(*                                                                          *)
(*      функции Строку -> в Число                                           *)
(*                                                                          *)
(*==========================================================================*)

function ChrToBool(ch:char):boolean;
function Val0(S:string):real;
//function StrToInt0(S:string):integer; (* с сообщ.об ошибке из SysUtils *)



function ValInt(S:string):integer;             overload;
function ValInt(S,sErrComment:string):integer; overload;
function ValInt(S:string;var IErr:integer):integer; overload;

function ValInt0(S:string):integer; overload;(* рез-т пустой строки = 0 *)
function ValInt0(S,sErrComment:string):integer; overload;


function GetTimeFile_17(S:string):DWORD; (* '11.11.10 12:12:42' => DateOfFile *)

procedure HMSReal(w:string;var R:real;var IErr:integer);
(* строка w = время в формате YYYYMMDD_hhmmss *)
procedure Dt_TiReal(w:string;var R:real;var IErr:integer);

function ValReal(S:string):real;                   overload;
function ValReal(S:string;var IErr:integer):real;  overload;

function ValReal0(S:string):real;
function ValHexB(S:string;var IErr:integer):byte;

procedure StrToARe(S:string;var A:TARe);


//function StrToColor(const S:string):TColor;













(*============================================================================*)
(*                                                                            *)
(*                   WideString и ASCIIZ СТРОКИ                               *)
(*                                                                            *)
(*============================================================================*)

function HTML_ENTITIEStoWideString(S:string):WideString;
function WideStringToHex(SW:WideString):string;
function HexToWideString(S:string):WideString;

function AsciiZ2Str(var AZ):string;
//function ASCIIZLength(var A) : Word;














(*============================================================================*)
(*                                                                            *)
(*              операции  со  StringList                                      *)
(*                                                                            *)
(*============================================================================*)

function StringsToSL(SL0:TStrings):TStringList;(* преобразование типа *)
procedure SLtoStrings(var SS:TStrings;SL:TStringList);
procedure SLCopy(SLSrc,SLDst:TStrings);                 overload;
procedure SLCopy(SLSrc,SLDst:TStrings;J1,J2:integer);   overload;
procedure SLCopy(SLSrc,SLDst:TStrings;s1,s2:string);    overload;

procedure SLRePlace(SLSrc,SLDst:TStrings);

//function SLTop(SL0:TStrings;N1:integer):TStringList;



procedure SLUnTab(SL:TStrings); (* развернуть табуляции в пробелы *) overload;
procedure SLUnTab(SL:TStrings;J1,J2:integer);                        overload;

(*-------------------------------------------------------*)
(* сумма Strings и StringList                            *)
(*-------------------------------------------------------*)
function SListAdd(SL1,SL2:TStrings):TStrings;        overload;
function SListAdd(SL1,SL2:TStringList):TStringList;  overload;
function SLMerge(SL1,SL2:TStrings):TStringList;
//procedure SListAddProc(var SL1:TStringList;SL2:TStringList);

(*-------------------------------------------------------*)
(* сравнение значений списков Strings (StringList)       *)
(*-------------------------------------------------------*)
function CompareSL(SL1,SL2:TStrings):integer;

(*-------------------------------------------------------*)
(* поиск строки в Strings (StringList)                   *)
(*-------------------------------------------------------*)
function FindStrings(S:string;SL:TStrings):integer;
function FindTrimmedStrings(S:string;SL:TStrings):integer;
function SLFindString    (S:string;SL:TStrings):integer;
function SLFindSubString (S:string;SL:TStrings):integer; overload;
function SLFindSubString (S:string;J1:integer;SL:TStrings):integer; overload;
function SLFindStringHead(S:string;SL:TStrings):integer; overload;
function SLFindStringHead(S,sDiv:string;SL:TStrings):integer; overload;
function SLFindStringHeadWd(S:string;SL:TStrings):integer;

function SLFindStringHeadL(S:string;L:integer;SL:TStrings):integer;
function SLCutStringHeadL(S:string;J0,L:integer;var SL:TStrings):integer;


(*-------------------------------------------------------*)
(* удаление комментраия (многострочного) из StringList   *)
(*-------------------------------------------------------*)
procedure SLStripMultiComm(SL:TStringList;sCommBeg,sCommEnd:string);(* много- *)
procedure SLStripLineComm (SL:TStringList;sCommBeg:string); (* одно-строчный *)


(*-------------------------------------------------------*)
(* вкл/выкл спец символа в строке                        *)
(*-------------------------------------------------------*)

//  LSOnOffChar(cbFITSrunCase.Items,'1Ldxx','*',not Q1);
procedure SLOnOffChar(SL:TStrings;STpl:string;Ch:char;Q:boolean);

(*-------------------------------------------------------*)
(* строку делим на список строк по заданному разделителю *)
(*-------------------------------------------------------*)
function StrToSList(S:string;D:Char):TStringList;    overload;
function StrToSList(S:string;SD:string):TStringList; overload;
function StrToSList(S:string;SC:CharSet):TStringList;overload;
function StrToSList(S:string):TStringList;    overload;

function SListToStr(SL:TStrings):string;(* SL собираем в строку с CR/LF *)
function SListList(SL:TStrings):string;
procedure SLSWAP(SL:TStrings); (* меняем местами первые и последние строки *)


(*-----------------------------------------------------------------*)
(*     ТЕКСТОВЫЕ ТАБЛИЦЫ, РАЗМЕЩЕННЫЕ ВО ФРАГМЕНТЕ StringList      *)
(*                                                                 *)
(*  (под таблицей понимаем строки с одинаковым числом слов в них)  *)
(* таблица ВЫРОВНЕНА, если все колонки расположены одна под другой *)
(*                                                                 *)
(* словом может считаться                                          *)
(*   1 всё между пробелами                                         *)
(*   2 всё между пробелами + констукциями заключенными в кавычки   *)
(*   3 все в промежутке между каждым из разделителй                *)
(*  примеры:                                                       *)
(*   1 этот набор слов состоит из восьми слов                      *)
(*   2 этот "набор слов" "состоит из" шести слов                   *)
(*   3|этот набор| слов состоит из ||пяти слов, четвертое - пустое *)
(*-----------------------------------------------------------------*)

(* найти верхнюю и нижнюю границы текстовой таблицы *)
procedure FindTabBegEnd(SL:TStrings;JS:integer;var J1,J2:integer); overload;
procedure FindTabBegEnd(SL:TStrings;JS:integer;var J1,J2:integer;
                        ChQuote,ChDiv:char);                       overload;

(* сортировка может быть в пределах не всей таблицы, а       *)
(* фрагмента, заданного в Edit-полях, к-рые содержат S1 и S2 *)
(* проверяем корректность границ, заданных в S1,S2           *)
procedure GetCheckInterfaceS1S2(SL:TStrings;
                                S1,S2:string; (* содержимое Edit-полей *)
                                JS:integer;   (* номер строки в SL *)
                                var J1,J2:integer);(*результат- крайние строки*)


(* в текстовой таблице выравнять колонки *)
procedure LineTabStrings(SL:TStrings;JS:integer); overload;
procedure LineTabStrings(SL:TStrings;JS:integer;ChQuote,ChDiv:char); overload;
(* Версия процедуры Async позволяет иметь разное число слов в строке *)
procedure LineTabStringsAsync(SL:TStrings);

(* сортировка строк в таблице по колонке, на которую указывает курсор *)
procedure SortTabCol(SL:TStrings;JS,IP,J01,J02:integer;QDesc:boolean);overload;
procedure SortTabCol(SL:TStrings;JS,IP,J01,J02:integer;QDesc:boolean;
                                                  ChQuote,ChDiv:char);overload;
procedure SortTabCol(SL:TStrings;JS,IP,J01,J02:integer);              overload;
procedure SortTabCol(SL:TStrings;JS,IP,J01,J02:integer;ChQuote,ChDiv:char);
                                                                      overload;

procedure SortSLByFld(SL:TStrings;D:char;IFld,J01,J02:integer;QDesc:boolean);

(* извлечение и вставка колонки *)


function sCutCol(s:string;IB,IW:integer):string;


(* извлечь колонку в строку, разделенную CRLF *)
function SLGetCol(SL:TStrings;JS1,JS2,IB,IW:integer):string;
(* извлечь колонку, удалив пробелы из слов *)
function SLGetColTrimmed(SL:TStrings;JS1,JS2,IB,IW:integer):string;
(* извлечь колонку, преобразовав числа к формату Excel *)
function SLGetColForExcel(SL:TStrings;JS1,JS2,IB,IW:integer):string;

(* вырезать колонку *)
function SLCutCol(SL:TStrings;JS1,JS2,IB,IW:integer):string;
(* вклеить колонку из строки S2, поделенной с помощью CRLF *)
procedure SLPasteCol(SL:TStrings;S2:string;JS1,JS2,IB:integer); overload;

(* вклеить в SL колонку из SL2, она должна состоять из одиночных слов *)
procedure SLPasteCol(SL,SL2:TStrings;JS1,JS2,IB:integer); overload;

(* извлечь колонку и привести числа к формату, принятому в EXCEL *)
function SLToExcelString(SL:TStrings;JS:integer):string;
(* замениить табуляции пробелами и по CRLF разделить строку на SL *)
function SLFromExcelString(SS:string):TStringList;
procedure SLTabSlice(SL:TStrings;N,JS:integer);
function SLFromExcel:TStringList;  (* из буфера обмена, полученного от EXEL *)
function SLFromExcelFilled:TStringList;
function SLFromClpBrd:TStringList; (* из буфера обмена *)
procedure SLCopyToExcel(SL:TStrings;JS:integer);  (* в буфер обмена *)
function CheckExcelWord(S:string):string;


function sColMoveRight(s:string;iCol:integer):string;
function sColMoveLeft (s:string;iCol:integer):string;
function sColSwap(s:string;IB1,IW1,IB2,IW2:integer):string;
function sInsNPPCol(s:string;IPP,L,IB:integer):string;
function sInsWord(s,w:string;IB:integer):string;
function sDelWord(s:string;ND,IB:integer):string;

procedure SLColMoveRight(SL:TStrings;JS1,JS2,IC:integer); (* right move  *)
procedure SLColMoveLeft(SL:TStrings;JS1,JS2,IC:integer);  (* left  move  *)
procedure SLColSwap(SL:TStrings;JS1,JS2,IB1,IW1,IB2,IW2:integer);
procedure SLInsNPPCol(SL:TStrings;JS1,JS2,IB:integer);
procedure SLInsWord(SL:TStrings;W:string;JS1,JS2,IB:integer);
procedure SLDelWord(SL:TStrings;ND:integer;JS1,JS2,IB:integer);


(*-----------------------------------------------------------------*)
(*          СТРУКТУРА ДЛЯ АНАЛИЗА ТЕКСТОВОЙ ТАБЛИЦЫ                *)
(*                                                                 *)
(*-----------------------------------------------------------------*)

(* анализ текстовой таблицы *)
(* количество полей *)
(* количество строк *)
(* список полей :   *)
(*   ширина поля    *)
(*   начало поля    *)

type
PTabField = ^TTabField;
TTabField = record
  I0 : integer; (* кол-во пробелов от предыдущ.поля до текущего *)
  IB : integer; (* позиция начала слова в колонке               *)
  IW : integer; (* ширина самого длинного слова в колонке       *)
end;

TTextTabStruct = class(TList)
//Self : TList;       (* список колонок (полей типа TTabField) *)
//Count: integer;         число колонок = эл-тов списка
//constructor Create;
procedure AddCol(I00,IB0,IW0:integer);
procedure Done;                                  (* освободить память *)
destructor Destroy; override;
function GetIC(IP:integer):integer;              (* номер колонки по позиции *)
procedure GetBeWi(IC:integer;var I0,IB,IW:integer);(* начало и длина колонки *)
class function ClassReport:TStringList;
function Report:TStringList;

end; (* TTextTabStruct *)

(* получить параметры предварительно выравненной текстовой таблицы *)
procedure TabAnalize(CurTT:TTextTabStruct;SL:TStrings;JS1,JS2:integer);overload;
procedure TabAnalize(CurTT:TTextTabStruct;
                       SL:TStrings;JS1,JS2:integer;ChQuote,ChDiv:char);overload;





(*----------------------------------------*)
(*      система сообщений об ошибках      *)
(*----------------------------------------*)


(* модуль swStr если надо сообщить об ошибке обращается к проц.е ErrSW(sErr)  *)
(* Процедура ErrSW в свою очередь обращается к процедурной переменной         *)
(* ErrorNotification(sErr)                                                    *)
(* по умолчанию ей присвоена ссылка на LocalWarn, который вызывает MessageBox *)
(*                                                                            *)
(*  Внешний модуль, который использует swStr для парсинга текстовых подстрок  *)
(*  в переменные подменяет на время своей работы ф-ю LocalWarn своей          *)
(*  собственной функцией сообщения об ошибке, к которой добавляет известную   *)
(*  из контекста информацию                                                   *)


function SplitWords(S,sSplitWord:string):string;(* VAR=VALUE  =>  VAR = VALUE *)













function sLastErrorRus(IErr:integer):string;






(*============================================================================*)
(*============================================================================*)
(*============================================================================*)
implementation

uses
  SysUtils,   (* SysUtils.FmtStr для PerCentToStr *)
  ClipBrd,
  SetBit;
//  f90_Profiling;
//  swSayer; //для отладки


(*============================================================================*)
(* модуль swStr если надо сообщить об ошибке обращается к проц.е ErrSW(sErr)  *)
(* Процедура ErrSW в свою очередь обращается к процедурной переменной         *)
(* ErrorNotification(sErr)                                                    *)
(* по умолчанию ей присвоена ссылка на LocalWarn, который вызывает MessageBox *)

//type TProcErr = procedure (sErr:string);
var  ErrorNotification  : TProcErr;
     ErrorNotificationP : TProcErrP;

procedure ErrSW(sErr:string);
begin
  ErrorNotification(sErr);
end;

procedure ErrPSW(sErr:string;EPos:integer);(* для обработки ошибок *)
begin
  ErrorNotificationP(sErr,EPos);
end;


procedure LocalWarn(sErr:string);
begin
  MessageBox(GetActiveWindow,PChar(sErr),'Ошибка обработки строк!',MB_OK);
end;

procedure LocalWarnP(sErr:string;EPos:integer);
var S : string;
begin
  S := sErr + ' позиция ошибки = '+ISt(EPos);
  MessageBox(GetActiveWindow,PChar(S),'Ошибка обработки строк!',MB_OK);
end;




function sLastErrorRus(IErr:integer):string;
var S : string;
begin
  case IErr of
1: S:='Неверная функция';
2: S:='Не удается найти указанный файл';
3: S:='Системе не удается найти указанный путь';
4: S:='Системе не удается открыть файл';
5: S:='Отказано в доступе';
6: S:='Неверный дескриптор';
7: S:='Повреждены управляющие блоки памяти';
8: S:='Недостаточно памяти для обработки команды';
9: S:='Неверный адрес управляющего блока памяти';
10: S:='Ошибка в среде';
11: S:='Была сделана попытка загрузить программу, имеющую неверный формат';
12: S:='Код доступа неверен';
13: S:='Недопустимые данные';
14: S:='Недостаточно памяти для завершения операции';
15: S:='Системе не удается найти указанный диск';
16: S:='Не удается удалить папку';
17: S:='Системе не удается переместить файл на другой диск';
18: S:='Больше файлов не осталось';
19: S:='Носитель защищен от записи';
20: S:='Системе не удается найти указанное устройство';
21: S:='Устройство не готово';
22: S:='Устройство не опознает команду';
23: S:='Ошибка в данных (CRC)';
24: S:='Длина выданной программой команды слишком велика';
25: S:='Не удается найти заданную область или дорожку на диске';
26: S:='Нет доступа к диску или дискете';
27: S:='Не удается найти заданный сектор на диске';
28: S:='Нет бумаги в принтере';
29: S:='Системе не удается произвести запись на устройство';
30: S:='Системе не удается произвести чтение с устройства';
31: S:='Присоединенное к системе устройство не работает';
32: S:='Процесс не может получить доступ к файлу, так как этот файл занят другим процессом';
33: S:='Процесс не может получить доступ к файлу, так как часть этого файла заблокирована другим процессом';
36: S:='Слишком много файлов открыто для совместного доступа';
38: S:='Достигнут конец файла';
39: S:='Нет места на диске';
50: S:='Такой запрос не поддерживается';
51: S:='Невозможно найти сетевой путь. Убедитесь, что сетевой путь указан верно, а конечный компьютер включен и не занят. Если система вновь не сможет найти путь, обратитесь к сетевому администратору';
52: S:='Вы не подключены, т.к. такое же имя уже существует в этой сети. Для присоединения к домену откройте компонент панели управления "Система", измените имя компьютера и повторите попытку. Для присоединения к рабочей группе выберите другое имя рабочей группы';
53: S:='Не найден сетевой путь';
54: S:='Сеть занята';
55: S:='Сетевой ресурс или устройство более недоступно';
56: S:='Достигнут предел числа команд NetBIOS';
57: S:='Аппаратная ошибка сетевой платы';
58: S:='Указанный сервер не может выполнить требуемую операцию';
59: S:='Непредвиденная сетевая ошибка';
60: S:='Несовместимый удаленный контроллер';
61: S:='Очередь печати переполнена';
62: S:='На сервере нет места для хранения ожидающего печати файла';
63: S:='Ваш файл, находившийся в очереди вывода на печать, был удален';
64: S:='Указанное сетевое имя более недоступно';
65: S:='Нет доступа к сети';
66: S:='Неверно указан тип сетевого ресурса';
67: S:='Не найдено сетевое имя';
68: S:='Превышен предел числа имен для сетевого адаптера локального компьютера';
69: S:='Превышен предел по числу сеансов NetBIOS';
70: S:='Сервер сети был остановлен или находится в процессе запуска';
71: S:='Дополнительные подключения к этому удаленному компьютеру в настоящее время невозможны, поскольку число подключений к компьютеру достигло предела';
72: S:='Работа указанного принтера или дискового накопителя была остановлена';
80: S:='Файл существует';
82: S:='Не удается создать файл или папку';
83: S:='Сбой прерывания INT 24';
84: S:='Недостаточно памяти для обработки запроса';
85: S:='Имя локального устройства уже используется';
86: S:='Сетевой пароль указан неверно';
87: S:='Параметр задан неверно';
88: S:='Ошибка записи в сети';
89: S:='В настоящее время системе не удается запустить другой процесс';
else S := 'КАКАЯ-ТО ОШИБКА LastError, код='+ISt(IErr);
end; (* case *)
  result := S;
end;



(*============================================================================*)
(* строка w = время в формате от 'hh:mm' до 'hh:mm:ss.ddd' *)
(* 2007-05-25T11:36:00.000  *)
procedure Dt_T_TiReal(w:string;var R:real;var IErr:integer);
var RH : real; s : string; Y,M,D : integer; T : TDateTime;
begin
  IErr := 1;
  if length(w) <> 23 then Exit;
  IErr := 11;
  if w[11] <> 'T' then Exit;

  HMSReal(rightfrom(w,'T'),RH,IErr);
  if IErr <> 0 then Exit;


  IErr := NotInChars(w,['-','0'..'9']);
  if IErr > 0 then Exit;

  Y := swStr.ValInt(copy(w,1,4));
  M := swStr.ValInt(copy(w,6,2));
  D := swStr.ValInt(copy(w,9,2));
  if ((Y+M+D)=0) then T := 0 else T := EncodeDate(Y,M,D);

  R := T + RH;
end;

(*============================================================================*)
(* строка w = время в формате от 'hh:mm' до 'hh:mm:ss.ddd' *)
procedure HMSReal(w:string;var R:real;var IErr:integer);
var n,h,m,s,d : integer; rd : real;
begin
  n := length(w); s := 0; d := 0; rd := 0; R := 0;
  IErr := NotInChars(w,[':','.','0'..'9']);
  if IErr > 0 then Exit;

  if n < 3         then begin IErr := n; Exit; end;
  if (w[3] <> ':') then begin IErr := 3; Exit; end;

  h := swStr.ValInt(copy(w,1,2));
  if (n >= 5) then begin
    m := swStr.ValInt(copy(w,4,2));
    if (n > 5) and (w[6] <> ':') then begin IErr := 6; Exit; end;

    if (n >= 8) then begin
      s := swStr.ValInt(copy(w,7,2));
      if (n > 8) then begin
        if (w[9] <> '.') then begin IErr := 6; Exit; end;
        d := swStr.ValInt(copy(w,10,n-9));
        case n-9 of
          1 : rd := d/10;
          2 : rd := d/100;
          3 : rd := d/1000;
        end; (* case *)
      end;
    end;
  end;
  R := ((((rd+s)/60+m)/60)+h)/24;
end;


(*============================================================================*)
(* строка w = время в формате YYYYMMDD_hhmmss *)
procedure Dt_TiReal(w:string;var R:real;var IErr:integer);
var n,nh,nd,p,Y,M,D,  h,i,s : integer; wd,wh,sEr : string; RH,RD : real;
  T : TDateTime; IE1,IE2,IE3 : integer;
begin
  R := 0; IErr := 0;
  n := length(w);
  p := pos('_',w);

  if ((Not (n IN [6,8,15])) and (p=0)) then begin IErr := 1; Exit end;



// 202501 20250101 20250101_100000

  IErr := NotInChars(w,['_','0'..'9']);
  if IErr > 0 then Exit;

  if p > 0 then begin
    wd := left(w,'_');
    wh := rightfrom(w,'_');
  end
  else
  if n = 8 then begin wd := w; wh := '' end
  else
  if n = 6 then begin wd := ''; wh := w end;

  nh := length(wh);
  nd := length(wd);

  RH := 0;
  if nh >= 2 then begin
    h := 0; i := 0; s := 0;
    h := swStr.ValInt(copy(wh,1,2),IErr);
    if IErr > 0 then Exit;
    if (n >= 4) then begin
      i := swStr.ValInt(copy(wh,3,2),IErr);
      if IErr > 0 then begin IErr := IErr + 2; Exit; end;
      if (n = 6) then begin
        s := swStr.ValInt(copy(wh,5,2),IErr);
        if IErr > 0 then begin IErr := IErr + 4; Exit; end;
      end;
    end;
    RH := ((((d/10+s)/60+m)/60)+h)/24;
  end;

  RD := 0;
  if nd = 6 then begin
    D := swStr.ValInt(copy(wd,5,2),IE1);
    M := swStr.ValInt(copy(wd,3,2),IE2);
    Y := swStr.ValInt(copy(wd,1,2),IE3) + 2000;
    IErr := IE1+IE2+IE3;
    if IErr > 0 then Exit;
  end
  else
  if nd = 8 then begin
    D := swStr.ValInt(copy(wd,7,2),IE1);
    M := swStr.ValInt(copy(wd,5,2),IE2);
    Y := swStr.ValInt(copy(wd,1,4),IE3);
    IErr := IE1+IE2+IE3;
    if IErr > 0 then Exit;
  end
  else begin IErr := 68; Exit end;

  if Y + M + D = 0 then T := 0
                   else try begin T := EncodeDate(Y,M,D); end
                        except begin T:= 0;
                           sEr := ISt(Y)+':'+ISt(M)+':'+ISt(D);
                           ErrPSW(sEr,IErr);
                               end;
                        end;       
  T := T + RH / SecsPerDay;
  R := T;
end;






function ValReal(S:string):real;
var R : real;
 IErr : integer;
 sEr : string;
 jsig : integer;
begin
  S := Trim(S);
  (* проверим на ситуацию -123+12 вместо -123E+12 *)
  jsig := PosSet(['-','+'],RightFrom(S,2));

  if jsig > 0 then  (* нашли знаки +/- не в начальной позиции *)
    if S[jsig] in ['0'..'9','.'] then  (* S[jsig] - это символ перед "+/-" *)
      S := left(S,jsig)+'E'+rightfrom(S,jsig+1);

//R := 0; (* для гарантии *)
  Val(S,R,IErr);
  if IErr>0 then begin
    (* попытаемся интерпретировать строку как время hh:mm[:ss[.ddd]] *)
    HMSReal(S,R,IErr);
    if IErr>0 then begin
      (* попытаемся интерпретировать строку как время YYYYMMDD_hhmm[:ss] *)
      Dt_TiReal(S,R,IErr);
      if IErr>0 then begin
        Dt_T_TiReal(S,R,IErr);
        if IErr>0 then begin
           sEr := 'Ошибка ValReal или HMSReal при вводе действительного числа <'
                   +S+'>';
           ErrPSW(sEr,IErr);
         end;  
      end;
    end;
  end;
  ValReal:=R;
end;


function ValReal(S:string;var IErr:integer):real;
var R : real; S0 : string;
 jsig : integer;
begin
  S := Trim(S);
  S0 := S;
  (* проверим на ситуацию -123+12 вместо -123E+12 *)
  jsig := PosSet(['-','+'],RightFrom(S,2));
  if jsig > 0 then
    if S[jsig] in ['0'..'9','.'] then  (* S[jsig] - это символ перед "+/-" *)
      S := left(S,jsig)+'E'+rightfrom(S,jsig+1);

//R := 0; (* для гарантии *)
  Val(S,R,IErr);
  if (IErr > 0) then
    HMSReal(S0,R,IErr);
  if (IErr > 0) then
    Dt_TiReal(S0,R,IErr);
  if (IErr > 0) then
    Dt_T_TiReal(S0,R,IErr);
  ValReal:=R;
end;



function ValReal0(S:string):real;
begin
  if trim(S) = '' then begin result := 0; Exit end;
  result := ValReal(S);
end;


function ValHexB(S:string;var IErr:integer):byte;
var I,K,M,N : integer; Ch : char;
begin
  N := length(S);
  for I := 1 to N do
    if Not (S[I] in SetHex) then begin
      result := 0;
      IErr := I;
      Exit;
    end;

  IErr := 0;
  M := 0;
  for I := 1 to N do begin
    Ch := S[I];
    if Ch <= '9' then K := Ord(Ch) - Ord('0')
                 else K := Ord(Ch) - Ord('A') + 10;
    M := M * 16 + K;
  end;
  result := M;
end;



(*  S = 'Parametr = 36.6 '  sKey='Parametr'     возвращает '36.6'  *)
function ExtractWord(S,sKey:string):string;
var II,I2 : integer;
begin
  result := '';
  II := System.pos(sKey,S); if II = 0 then Exit;
  II := II + length(sKey);
  I2 := PosP('=',S,II);     if I2 = 0 then Exit;
  if I2 > II then
  if Trim(copy(S,II,I2-II+1)) <> '' then Exit; (* есть символы кроме SKey *)
  I2 := I2 + 1;
  result := GetWord(S,I2);(* взять слово из строки*)
end;


{
function  GetWord:string;
function  GetStrEnd:string;  (* остаток строки от позиции J *)
function  GetOneChar:char;   (* взять слово и из него первый символ *)
function  ValNum(SF:string):longint;
function  ValJ2(SF:string):INTEGER;
function  ValReal(SF:string):real;
function  GetNum:longint;                    overload;
function  GetNum(iMin,iMax:integer):longint; overload;
function  GetReal:real;
}



procedure TStrList.Clear;
var I : integer;
begin
{
  for I := Count-1 downto 0 do begin
    Self.Strings[I] := '';
    inherited Delete(I);
  end;
}
  inherited Clear;
end;

destructor TStrList.Destroy;
begin
  Self.Clear;
  inherited Destroy;
end;


function DWORDToS4(W : DWORD):string;
var S:string;
  C4 : array[1..4] of char absolute W;
  I : integer;
begin
  S := '';
  I := 1;
  while (C4[I] <> #0) and (I <= 4) do begin
    S := S + C4[I];
    inc(I);
  end;
  DWORDToS4 := S;
end;


function S4ToDWORD(S:string):DWORD;
var W : DWORD;
    C4 : array[1..4] of char absolute W;
    I,L : integer;
begin
  L := length(S);
  if L > 4 then L := 4;
  for I := 1 to L do C4[I] := S[I];
  for I := L+1 to 4 do C4[I] := #0;
  S4ToDWORD := W;
end;


procedure WarnAbs(S:string);                 (* локальный неподавляемый WARN *)
begin
  MessageBox(GetActiveWindow,PChar(S),
    PChar('swStr Предупреждение или напоминание'),MB_OK);
end;




function RealLoopToStr(X0,X1,dX:real;L:integer):string;
var X : real;
  S : string;
begin
  X := X0;
  S := EFSt0(X,L);
  X := X + dX;
  if dX > 0 then begin
    while X < X1 do begin
      S := S + ' ' + EFSt0(X,L);
      X := X + dX;
    end;
  end
  else begin
    while X > X1 do begin
      S := S + ' ' + EFSt0(X,L);
      X := X + dX;
    end;
  end;
  if abs(X1-X) < abs(dX)/1000 then S := S + ' ' + EFSt0(X,L);
  result := S;
end;



(* если есть ошибки в строке S - вернуть NIL в массиве A *)
procedure StrToARe(S:string;var A:TARe);
var AA : TARe; I,IErr,N : integer; R : real;
begin
  N := GetNWord(S);
  SetLength(AA,N+1);
  for I := 1 to N do begin
    R := ValReal(GetWordN(S,I),IErr);
    if IErr <> 0 then begin
      Finalize(AA);
      A := NIL;
      Exit;
    end;
    AA[I] := R;
  end;
  SetLength(A,N+1);
  for I := 1 to N do A[I] := AA[I];
  Finalize(AA);
end;

(* L - число цифр *)
function AReSt(A:TARe;L:integer):string;
var S : string; I,N : integer;
begin
  result := '';
  if Not Assigned(A) then Exit;
  N := length(A)-1;
  if N < 1 then Exit;
  S := EFSt0(A[1],L);
  for I := 2 to N do S := S + ' ' + EFSt0(A[I],L);
  result := S;
end;

(* вывести в строку только первые n1 чисел из массива *)
function AReSt(A:TARe;n1,L:integer):string; overload;
var S,se : string; I,N : integer;
begin
  result := '';
  if Not Assigned(A) then Exit;
  N := length(A)-1;
  if N < 1 then Exit;
  se := '';
  if n1 < N then begin
    N := n1;  (* только первые n1 чисел *)
    se := ' ...';
  end;
  S := EFSt0(A[1],L);
  for I := 2 to N do S := S + ' ' + EFSt0(A[I],L);

  result := S + se;
end;


function AReSL(A:TARe;L:integer):TStringList;
var S : string; I,N : integer; SL : TStringList;
begin
  SL := TStringList.Create;
  result := SL;
  if Not Assigned(A) then Exit;
  N := length(A)-1;
  if N < 1 then Exit;
  for I := 1 to N do begin
    S := EFSt0(A[I],L);
    SL.Add(S);
  end;
  result := SL;
end;


function PointsSL(A:TPointsArray;Dig:integer):TStringList;
var S : string; I,N : integer; SL : TStringList;
begin
  SL := TStringList.Create;
  result := SL;
  if Not Assigned(A) then Exit;
  N := length(A)-1;
  if N < 1 then Exit;
  for I := 0 to N do begin
    S := FSt0(A[I].X,Dig)+' '+FSt0(A[I].Y,Dig);
    SL.Add(S);
  end;
  result := SL;
end;





function AInSt(A:TAIn):string;
var S : string; I,N : integer;
begin
  result := '';
  if Not Assigned(A) then Exit;
  N := length(A)-1;
  if N < 1 then Exit;
  S := ISt(A[1]);
  for I := 2 to N do S := S + ' ' + ISt(A[I]);
  result := S;
end;


(* разворачиваем конструкции типа '(X0 X1 dX)'  *)
function SpreadNumLoop(S:string;var sErr:string):string;
var P1, P2, l, ll : integer;
  SS,W : string;
  X0,X1,dX : real;
  IErr : integer;

begin
  sErr := '';
  P1 := pos('(',S);
  P2 := swStr.PosP(')',S,P1);
  while ((P1>0) and (P2>0)) do begin
    SS := copy(S,P1+1,P2-P1-1);

    if (pos('>',SS) > 0) or    (* это не разворачивающаяся последовательность *)
       (pos('<',SS) > 0) or    (* а SQL - запрос?                             *)
       (pos('=',SS) > 0)
    then begin
      P1 := swStr.PosP('(',S,P2);
      P2 := swStr.PosP(')',S,P1);
      Continue;              (* тогда пропускаем конструкцию *)
    end;

    if swStr.GetNWord(SS) = 3 then begin
      W  := GetWordN(SS,1); ll := length(W);
      X0 := ValReal(W,IErr);
      if IErr = 0 then begin
        W:=GetWordN(SS,2); l := length(W); if l>ll then ll:=l;
        X1 := ValReal(W,IErr);
        if IErr = 0 then begin
          W:=GetWordN(SS,3); l := length(W); if l>ll then ll:=l;
          dX := ValReal(W,IErr);
          if IErr = 0 then begin
            if dX*(X1-X0) <= 0 then begin
              sErr := 'В конструкции '+SS+' ошибка в знаках чисел!';
            end
            else begin
              SS := RealLoopToStr(X0,X1,dX,ll+2);
            end;
          end;
        end;
      end;
    end;
    if IErr <> 0 then
      sErr := 'ОШИБКА! В конструкции '+SS+' должно быть три числа!';

    if sErr = '' then S := left(S,P1-1)+' '+SS+' '+rightfrom(S,P2+1);
             //  else S не меняется
(*  P2 не корректируем, т.к. внутри SS все равно скобки быть не может *)

    P1 := swStr.PosP('(',S,P2);
    P2 := swStr.PosP(')',S,P1);
  end; (* while *)
  result := S;
end;
















(* ф-я получает удвоенное спиновое кв.число, результат - 4 символа *)
function Spin2Str(q2:integer):string;
begin
  if (q2 MOD 2) > 0
  then result := NSt(q2,2)        +'/2'
  else result := NSt((q2 div 2),2)+'  ';
end;

function Buf2Str(var V):string;
var VV : array [1..64000] of char absolute V;
  I : integer;
  S : string;
begin
  I := 1;
  while (Not (VV[I] in [#0,#10,#13])) and (I < 64000) do inc(I);
  SetLength(S,I);
  move(VV[1],S[1],I);
  result := S;
end;

procedure Buf2Str2(var V;var S1,S2:string);
var VV : array [1..64000] of char absolute V;
  I1,I : integer;
begin
  I := 1; I1 := I;
  while (Not (VV[I] in [#0,#10,#13])) and (I < 64000) do inc(I);
  if I = I1 then S1 := '' else begin
    SetLength(S1,I-I1);
    move(VV[I1],S1[1],I-I1);
  end;
  if I < 64000 then begin
    inc(I); if VV[I] in [#10,#13] then inc(I);   (* 2-й символ в паре CR/LF *)
  end;
  I1 := I;
  while (Not (VV[I] in [#0,#10,#13])) and (I < 64000) do inc(I);
  if I = I1 then S2 := '' else begin
    SetLength(S2,I-I1);
    move(VV[I1],S2[1],I-I1);
  end;
end;



procedure SortTabCol(SL:TStrings;JS,IP,J01,J02:integer);
begin
  SortTabCol(SL,JS,IP,J01,J02,false);
end;

procedure SortTabCol(SL:TStrings;JS,IP,J01,J02:integer;ChQuote,ChDiv:char);
begin
  SortTabCol(SL,JS,IP,J01,J02,false,ChQuote,ChDiv);
end;



procedure SortTabCol(SL:TStrings;JS,IP,J01,J02:integer;QDesc:boolean);
var IW  : integer;
  J1,J2 : integer;
  QNumb : boolean;
  Q     : boolean;
  IHead : integer;
  LCol  : integer;
//LN,LD,PP : integer;
  L     : integer;
  R1,R2 : real;
  W1,W2 : string;
  IErr  : integer;
  N,I   : integer;
  AI    : TAIn;
  SL2   : TStringList;
begin
  if JS > SL.Count then Exit;
  if (JS > J02) or (JS < J01) then Exit;
  if (J02 > SL.Count) then begin
//  J02 := SL.Count;
    WarnAbs('SortTabCol-Err заказана сотрировка, где LastRow='+ISt(J02)+
            ' > RowCount='+ISt(SL.Count));
    Exit;
  end;

(* узнать номер слова, на к-рый указывает курсор *)
  IW := swStr.GetIWord(SL.Strings[JS-1],IP);




  QNumb := true; (* предполагаем, что колонка содержит числа *)
  LCol  := 0;
{
  LN    := 0;
  LD    := 0;
}



  (*-------- первый проход по таблице ---------*)
  (* анализируем данные в поле - числа ли они? *)
  (* начинаем с последней строки, ищем         *)
  (* первое нечисловое значение                *)

  for J1 := J02 downto J01 do begin
    W1 := GetWordN(SL.Strings[J1-1],IW);
    L  := length(W1); if L > LCol then LCol := L;
    if QNumb then begin
      if Not swStr.InNumber(W1)  (* 0..9,-,+,E *)
      then begin
        QNumb := false;
        IHead := J1-J01+1; (* номер крайней строки с нечисловым полем *)
      end
      else begin
        (* текущ.поле - очередное число *)
      end;
    end;
  end;


  (* допускаем, что заголовок может состоять максимум из трёх строк, *)
  (* если IHead больше, полагаем, что в колонке строковые данные     *)

  if IHead > 3 then IHead := 0 else QNumb := true;



  (*---------- второй проход по таблице -------------*)
  (* составляем вектор индексов и сортируем индексы! *)



  (*-- готовим матрицу индексов --*)
  N := J02 - (J01+IHead) + 1;
  SetLength(AI,N);
  I := 0;
  for J1 := J01+IHead to J02 do begin
    AI[I] := J1-1; (* от "наших" номеров строк переходим к индексам SL *)
    inc(I);
  end;
  (*------------------------------*)

  if QNumb then begin
    for J1 := 0 to N-2 do begin
      W1 := GetWordN(SL.Strings[AI[J1]],IW); R1 := ValReal(W1);
      for J2 := J1 + 1 to N-1 do begin
        W2 := GetWordN(SL.Strings[AI[J2]],IW); R2 := ValReal(W2);
        if QDesc then Q := (R1 < R2) else Q := (R2 < R1);
        if Q then begin
          swap(AI[J1],AI[J2]);
          R1 := R2;
        end;
      end; (* for J2 *)
    end;  (* for J1 *)
  end
  else begin
    for J1 := 0 to N-2 do begin
      W1 := GetWordN(SL.Strings[AI[J1]],IW);
      for J2 := J1 + 1 to N-1 do begin
        W2 := GetWordN(SL.Strings[AI[J2]],IW);
        if QDesc then Q := (W1 < W2) else Q := (W2 < W1);
        if Q then begin
          swap(AI[J1],AI[J2]);
          W1 := W2;
        end;
      end; (* for J2 *)
    end;  (* for J1 *)
  end;




  (* далее преобразуем StringList *)
  SL2 := TStringList.Create;
  if IHead > 0 then swStr.SLCopy(SL,SL2,0,J01-1+IHead-1);
  for J1 := 0 to N-1 do SL2.Add(SL.Strings[AI[J1]]);
  swStr.SLCopy(SL,SL2,J02+1,SL.Count-1);

  SL.Clear;
  swStr.SLCopy(SL2,SL);
  SL2.Clear;




{
  for J1 := J01+IHead to J02-1 do begin
    W1 := GetWordN(SL.Strings[J1-1],IW);
    if QNumb then R1 := ValReal(W1);   //          Val(W1,R1,IErr);

    for J2 := J1 + 1 to J02 do begin
      W2 := GetWordN(SL.Strings[J2-1],IW);
      if QNumb then R2 := ValReal(W2); //          Val(W2,R2,IErr);

      if QDesc then begin
        if QNumb then Q := (R1 < R2)
                 else Q := (W1 < W2);
      end
      else begin
        if QNumb then Q := (R2 < R1)
                 else Q := (W2 < W1);
      end;

      if Q then begin
        SL.Move(J1-1,J2-1);
        SL.Move(J2-2,J1-1);
        if QNumb then R1 := R2
                 else W1 := W2;
      end;
    end; (* for J2 *)
  end;  (* for J1 *)
}




end; (* SortTabCol *)



(* сортировать, если известен номер колонки *)
procedure SortSLByFld(SL:TStrings;D:char;IFld,J01,J02:integer;QDesc:boolean);
var IW  : integer;
  J1,J2 : integer;
  QNumb : boolean;
  Q     : boolean;
  IHead : integer;
  LCol  : integer;
//LN,LD,PP : integer;
  L     : integer;
  R1,R2 : real;
  W1,W2 : string;
  IErr  : integer;
begin
  if Not Assigned(SL) or (SL.Count <= 0) then Exit;

  IW  := IFld;
//J02 := SL.Count; J01 := 1;

  QNumb := true;
  LCol  := 0;

  for J1 := J02 downto J01 do begin
    W1 := GetFldN(SL.Strings[J1-1],D,IW);
    L  := length(W1); if L > LCol then LCol := L;
    if QNumb then begin
      if Not swStr.InNumber(W1) then begin
        QNumb := false;
        IHead := J1-J01+1;
      end
      else begin     (* текущ.поле - очередное число *)
      end;
    end;
  end;

  if IHead > 3 then IHead := 0 else QNumb := true;

  for J1 := J01+IHead to J02-1 do begin
    W1 := GetFldN(SL.Strings[J1-1],D,IW);
    if QNumb then Val(W1,R1,IErr);

    for J2 := J1 + 1 to J02 do begin
      W2 := GetFldN(SL.Strings[J2-1],D,IW);
      if QNumb then Val(W2,R2,IErr);

      if QDesc then begin
        if QNumb then Q := (R1 < R2)
                 else Q := (W1 < W2);
      end
      else begin
        if QNumb then Q := (R2 < R1)
                 else Q := (W2 < W1);
      end;

      if Q then begin
        SL.Move(J1-1,J2-1);
        SL.Move(J2-2,J1-1);
        if QNumb then R1 := R2
                 else W1 := W2;
      end;
    end; (* for J2 *)
  end;  (* for J1 *)
end; (* SortSLByFld *)



procedure SortTabCol(SL:TStrings;JS,IP,J01,J02:integer;QDesc:boolean;
                                                  ChQuote,ChDiv:char);
var IW  : integer;
  J1,J2 : integer;
  QNumb : boolean;
  Q     : boolean;
  IHead : integer;
  LCol  : integer;
//LN,LD,PP : integer;
  L     : integer;
  R1,R2 : real;
  W1,W2 : string;
  IErr  : integer;
begin
  if JS > SL.Count then Exit;
  if (JS > J02) or (JS < J01) then Exit;
  if (J02 > SL.Count) then begin
  //J02 := SL.Count;
    WarnAbs('SortTabCol-Err заказана сотрировка, где LastRow='+ISt(J02)+
            ' > RowCount='+ISt(SL.Count));
    Exit;
  end;

(* узнать номер слова, на к-рый указывает курсор *)
  if ChDiv = ' '
  then IW := GetIQuotedWord(SL.Strings[JS-1],IP,ChQuote)
  else IW := GetIFld(SL.Strings[JS-1],IP,ChDiv);



  QNumb := true;
  LCol  := 0;

  for J1 := J02 downto J01 do begin

    if ChDiv = ' '
    then W1 := GetQuotedWordN(SL.Strings[J1-1],IW,ChQuote)
    else W1 := GetFldN(SL.Strings[J1-1],ChDiv,IW);

    L  := length(W1); if L > LCol then LCol := L;
    if QNumb then begin
      if Not InNumber(W1) then begin
        QNumb := false;
        IHead := J1-J01+1;
      end
      else begin     (* текущ.поле - очередное число *)
{
        PP := pos('.',W1);
        if PP > 0 then begin
          if (LN < PP-1)   then LN := PP-1;
          if (LD < L - PP) then LD := L - PP;
        end
        else if (LN < L) then LN := L;
}
      end;
    end;
  end;

  if IHead > 3 then IHead := 0 else QNumb := true;

  for J1 := J01+IHead to J02-1 do begin
    if ChDiv = ' '
    then W1 := GetQuotedWordN(SL.Strings[J1-1],IW,ChQuote)
    else W1 := GetFldN(SL.Strings[J1-1],ChDiv,IW);

    if QNumb then Val(W1,R1,IErr);

    for J2 := J1 + 1 to J02 do begin
      if ChDiv = ' '
      then W2 := GetQuotedWordN(SL.Strings[J2-1],IW,ChQuote)
      else W2 := GetFldN(SL.Strings[J2-1],ChDiv,IW);

      if QNumb then Val(W2,R2,IErr);

      if QDesc then begin
        if QNumb then Q := (R1 < R2)
                 else Q := (W1 < W2);
      end
      else begin
        if QNumb then Q := (R2 < R1)
                 else Q := (W2 < W1);
      end;

      if Q then begin
        SL.Move(J1-1,J2-1);
        SL.Move(J2-2,J1-1);
        if QNumb then R1 := R2
                 else W1 := W2;
      end;
    end; (* for J2 *)
  end;  (* for J1 *)

end; (* SortTabCol *)





(* сортировка может быть в пределах не всей таблицы, а       *)
(* фрагмента, заданного в Edit-полях, к-рые содержат S1 и S2 *)
(* проверяем корректность границ, заданных в S1,S2           *)
procedure GetCheckInterfaceS1S2(SL:TStrings;
                                S1,S2:string; (* содержимое Edit-полей *)
                                JS:integer;   (* номер строки в SL *)
                                var J1,J2:integer);(*результат- крайние строки*)
var J10,J20,IErr : integer;
begin
(* уточнить верхнюю и нижнюю границы таблицы *)
  FindTabBegEnd(SL,JS,J10,J20,'"',' ');

  J1 := 0; J2 := 0;
  Val(S1,J1,IErr);   (* попробуем взять указанные в интерфейсе *)
  if IErr = 0 then
  Val(S2,J2,IErr);
  if IErr = 0 then
  if J2 > J20 then IErr := -1 else
  if J1 < J10 then IErr := -1;

  if IErr <> 0 then begin
    if IErr < 0 then
      WarnAbs('Заданные границы таблицы (JS1='+ISt(J1)+
              ' JS2='+ISt(J2)+') лежат вне реальной таблицы,'+#13#10+
              'которая занимает строки от '+ISt(J10)+' до '+ISt(J20)
              +#13#10+
              'Выбираем для сортировки границы автоматически!');
    J1 := J10;
    J2 := J20;
  end
  else begin
    if (JS < J1) or (JS > J2) then begin
      WarnAbs('Текущая строка JS='+ISt(JS)+
              ' не попадает в рамки заданных границ (JS1='+ISt(J1)+
              ' JS2='+ISt(J2)+')'+#13#10+
              'Выбираем для сортировки границы автоматически от '
              +ISt(J10)+' до '+ISt(J20));
      J1 := J10;
      J2 := J20;
    end;
  end;

end;




(* найти верхнюю и нижнюю границы текстовой таблицы *)
procedure FindTabBegEnd(SL:TStrings;JS:integer;var J1,J2:integer);
var NW : integer;
     J : integer;
begin
//Time_routine('swStr.FindTabBegEnd',true);
  if JS > SL.Count then Exit;
  J := JS-1;
  NW := swStr.GetNWord(SL.Strings[J]);
  if NW = 0 then begin
    J1 := JS; J2 := JS; Exit;
  end;

  while (J >= 0) and (NW = swStr.GetNWord(SL.Strings[J])) do dec(J);
  inc(J); J1 := J+1;
  J := JS-1;
  while (J < SL.Count) and (NW = swStr.GetNWord(SL.Strings[J])) do inc(J);
  dec(J); J2 := J+1;
//Time_routine('swStr.FindTabBegEnd',false);
end;


(* найти верхнюю и нижнюю границы текстовой таблицы, если заданы кавычки *)
(* или разделитель полей *)
procedure FindTabBegEnd(SL:TStrings;JS:integer;var J1,J2:integer;
                        ChQuote,ChDiv:char);
var NW : integer;
     J : integer;
begin
  if JS > SL.Count then Exit;
  J := JS-1;
  NW := swStr.GetNWord(SL.Strings[J],ChQuote,ChDiv);
  while (J >= 0) and (NW = GetNWord(SL.Strings[J],ChQuote,ChDiv)) do dec(J);
  inc(J); J1 := J+1;
  J := JS-1;
  while (J<SL.Count) and (NW=GetNWord(SL.Strings[J],ChQuote,ChDiv)) do inc(J);
  dec(J); J2 := J+1;
end;


(* выбрать колонку из SL от строки JS1 до JS2 от позиции IB шириной IW *)
(* в одну строку, разделенную с помощью вставленных CRLF               *)
function SLGetCol(SL:TStrings;JS1,JS2,IB,IW:integer):string;
var J : integer;
  S : string;
  W,W0 : string;
begin
  S := '';
  setlength(W0,IW); FillChar(W0[1],IW,' '); W0 := W0 + #13#10;
  for J := JS1-1 to JS2-1 do begin
    if (J<0) or (J>=SL.Count) then S := S+W0
    else begin
      W := copyZ(SL.Strings[J],IB,IW)+#13#10;
      S := S + W;
    end;
  end;
  result := S;
end;

(* все слова с номером IC от строки JS1 до строки JS2 *)
(* сдвинуть на пробел вправо                          *)
procedure SLColMoveRight(SL:TStrings;JS1,JS2,IC:integer); (* right move  *)
var
  I,J,N : integer;
  S : string;
  SL2 : TStringList;
begin
  if Not Assigned(SL) then begin
    WarnAbs('SLColMoveRight исходный список строк не задан!');
    Exit;
  end;
  N := JS2 - JS1;
  if (N < 100) then begin
    for J := JS1-1 to JS2-1 do begin
      SL.Strings[J] := sColMoveRight(SL.Strings[J],IC);
    end;
  end
  else begin
    SL2 := TStringList.Create;
    for J := 0 to JS1-2        do SL2.Add(SL.Strings[J]);
    for J := JS1-1 to JS2-1    do SL2.Add(sColMoveRight(SL.Strings[J],IC));
    for J := JS2 to SL.Count-1 do SL2.Add(SL.Strings[J]);
    SL.Clear;
    for J := 0 to SL2.Count-1  do SL.Add(SL2.Strings[J]);
    SL2.Clear;
  end;
end;


function sColMoveRight(s:string;iCol:integer):string;
var i : integer;
begin
  i := GetWordNPos(s,iCol);
  if (i > 0) then s := sInsChAtPos(s,' ',i);
  result := s;
end;


function sInsChAtPos(s:string;ch:char;i:integer):string;
begin
  result := copy(s,1,i-1) + ch + copy(s,i,length(S)-I+1);
end;





(* все слова с номером IC от строки JS1 до строки JS2    *)
(* сдвинуть на позицию влево, если не произойдет слияния *)
(* слов хотя бы в одной строке                           *)
procedure SLColMoveLeft(SL:TStrings;JS1,JS2,IC:integer); (* right move  *)
var
  I,J,N : integer;
  S : string; SL2 : TStringList;
begin
  (* проверяем, что во всех строках есть IC колонок *)
  if Not Assigned(SL) then begin
    WarnAbs('SLColMoveRight исходный список строк не задан!');
    Exit;
  end;

  (* сперва делаем проверку - есть ли 2 пробела перед словом IC *)
  (* в каждой строке SL                                         *)
  for J := JS1-1 to JS2-1 do begin
    (* получить начальную позицию слова номер IC в строке *)
    S := SL.Strings[J];
    I := GetWordNPos(S,IC);
    if I > 0 then begin
      if IC = 1 then begin (* нужен только 1 пробел *)
        if (I < 2) or (S[I-1] <> ' ') then Exit;
      end
      else begin
        if (S[I-1] <> ' ') or (S[I-2] <> ' ') then Exit;
      end;
    end;
  end;

  (* выполняем сдвиг *)
  N := JS2 - JS1;
  if (N < 100) then begin
    for J := JS1-1 to JS2-1 do begin
      SL.Strings[J] := sColMoveLeft(SL.Strings[J],IC);
    end;
  end
  else begin
    SL2 := TStringList.Create;
    for J := 0 to JS1-2        do SL2.Add(SL.Strings[J]);
    for J := JS1-1 to JS2-1    do SL2.Add(sColMoveLeft(SL.Strings[J],IC));
    for J := JS2 to SL.Count-1 do SL2.Add(SL.Strings[J]);
    SL.Clear;
    for J := 0 to SL2.Count-1  do SL.Add(SL2.Strings[J]);
    SL2.Clear;
  end;
end;


function sColMoveLeft(s:string;iCol:integer):string;
var i : integer;
begin
  (* проверка наличия 2-х пробелов перед словом *)
  (* должна быть сделана заранее!!!             *)
  i := GetWordNPos(s,iCol);
  result := copy(s,1,i-2) + copy(s,i,length(s)-i+1);
end;





(* меняем две колонки в фикс.позициях, от IB1 шириной IW1 и от IB2 шириной IB2*)
procedure SLColSwap(SL:TStrings;JS1,JS2,IB1,IW1,IB2,IW2:integer);
var J,N : integer; SL2 : TStringList;
begin

  N := JS2 - JS1;
  if (N < 100) then begin
    for J := JS1-1 to JS2-1 do begin
      SL.Strings[J] := sColSwap(SL.Strings[J],IB1,IW1,IB2,IW2);
    end;
  end
  else begin
    SL2 := TStringList.Create;
    for J := 0 to JS1-2        do SL2.Add(SL.Strings[J]);
    for J := JS1-1 to JS2-1 do SL2.Add(sColSwap(SL.Strings[J],IB1,IW1,IB2,IW2));
    for J := JS2 to SL.Count-1 do SL2.Add(SL.Strings[J]);
    SL.Clear;
    for J := 0 to SL2.Count-1  do SL.Add(SL2.Strings[J]);
    SL2.Clear;
  end;

//  for J := JS1-1 to JS2-1 do begin
//    if (J>=0) and (J<SL.Count)
//    then begin
//      SL.Strings[J] := sColSwap(SL.Strings[J],IB1,IW1,IB2,IW2);
//    end;
//  end;
end;

function sColSwap(s:string;IB1,IW1,IB2,IW2:integer):string;
var I1,I2 : integer;
  S1,SM,S2 : string;
  W1,W2 : string;
begin
  I2 := IB2+IW2;
  I1 := IB1+IW1;
  S1 := copyZ(s,1,IB1-1);
  S2 := copyZ(s,I2,length(S)-I2+1);
  SM := copyZ(s,I1,IB2-I1);
  W1 := copyZ(s,IB1,IW1);
  W2 := copyZ(s,IB2,IW2);
  result := S1 + W2 + SM + W1 + S2;
end;



(* копируем колонку в фиксированной позиции, начиная от IB шириной IW *)
function SLGetColTrimmed(SL:TStrings;JS1,JS2,IB,IW:integer):string;
var J : integer;
  S : string;
  W : string;
begin
  S := '';
  for J := JS1-1 to JS2-1 do begin
    if (J<0) or (J>=SL.Count) then S := S+#13#10
    else begin
      W := TRIM(copyZ(SL.Strings[J],IB,IW))+#13#10;
      S := S + W;
    end;
  end;
  result := S;
end;


(* копируем колонку в фиксированной позиции, начиная от IB шириной IW *)
function SLGetColForExcel(SL:TStrings;JS1,JS2,IB,IW:integer):string;
var J : integer;
  S : string;
  W : string;
begin
  S := '';
  for J := JS1-1 to JS2-1 do begin
    if (J<0) or (J>=SL.Count) then S := S+#13#10
    else begin
      W := TRIM(copyZ(SL.Strings[J],IB,IW));
      W := CheckExcelWord(W)+#13#10;
      S := S + W;
    end;
  end;
  result := S;
end;




(* вставить колонку номеров по порядку *)
(* 2 пробела до, 0 пробелов после      *)
procedure SLInsNPPCol(SL:TStrings;JS1,JS2,IB:integer);
var W,S,S1,S2 : string;
    I,J,K,N,L : integer; SL2 : TStringList;
begin
  N := JS2 - JS1 + 1;
  W := ISt(N); L := length(W)+2;
  K := 0;

  if (N < 100) then begin
    for J := JS1-1 to JS2-1 do begin
      inc(K);
      SL.Strings[J] := sInsNPPCol(SL.Strings[J],K,L,IB);
    end;
  end
  else begin
    SL2 := TStringList.Create;
    for J := 0 to JS1-2        do SL2.Add(SL.Strings[J]);
    for J := JS1-1 to JS2-1 do begin
      inc(K);
      SL2.Add(sInsNPPCol(SL.Strings[J],K,L,IB));
    end;
    for J := JS2 to SL.Count-1 do SL2.Add(SL.Strings[J]);
    SL.Clear;
    for J := 0 to SL2.Count-1  do SL.Add(SL2.Strings[J]);
    SL2.Clear;
  end;


//for J := JS1-1 to JS2-1 do begin
//  if (J>=0) and (J<SL.Count)
//  then begin
//    inc(K);
//    SL.Strings[J] := sInsNPPCol(SL.Strings[J],K,L,IB);
//  end;
//end;
end;

function sInsNPPCol(s:string;IPP,L,IB:integer):string;
var W,S1,S2 : string;
begin
  W  := NSt(IPP,L);
  S1 := copyZ(s,1,IB-1);            (* до колонки    *)
  S2 := copyZ(s,IB,length(s)-IB+1); (* после колонки *)
  result := S1 + W + S2;
end;


(* вырезать колонку *)
function SLCutCol(SL:TStrings;JS1,JS2,IB,IW:integer):string;
var J,N : integer;
  S : string; SL2 : TStringList;
begin
  S := '';
  for J := JS1-1 to JS2-1 do begin
    S := S + copyZ(SL.Strings[J],IB,IW) + #13#10;
  end;
  result := S;

  N := JS2-JS1;
  if (N < 100) then begin
    for J := JS1-1 to JS2-1 do SL.Strings[J] := sCutCol(SL.Strings[J],IB,IW);
  end
  else begin
    SL2 := TStringList.Create;
    for J := 0 to JS1-2        do SL2.Add(SL.Strings[J]);
    for J := JS1-1 to JS2-1    do SL2.Add(sCutCol(SL.Strings[J],IB,IW));
    for J := JS2 to SL.Count-1 do SL2.Add(SL.Strings[J]);
    SL.Clear;
    for J := 0 to SL2.Count-1  do SL.Add(SL2.Strings[J]);
    SL2.Clear;
  end;
end;


function sCutCol(s:string;IB,IW:integer):string;
begin
  result := left(s,IB-1)+rightfrom(s,IB+IW);
end;





(* в списке строк SL от строки JS1 до строки JS2 (считая от 1) *)
(* вставить подстроку W, начиная с позиции IB                  *)
procedure SLInsWord(SL:TStrings;W:string;JS1,JS2,IB:integer);
var J,N : integer; S : string; SL2 : TStringList;
begin
  if W = '' then Exit;
  N := JS2 - JS1;
  if (N < 100) then begin
    for J := JS1-1 to JS2-1 do begin
      if (J>=0) and (J<SL.Count)
      then SL.Strings[J] := sInsWord(SL.Strings[J],W,IB);
    end;
  end
  else begin
    SL2 := TStringList.Create;
    for J := 0 to JS1-2        do SL2.Add(SL.Strings[J]);
    for J := JS1-1 to JS2-1 do
      if (J>=0) and (J<SL.Count)
        then SL2.Add(sInsWord(SL.Strings[J],W,IB));
    for J := JS2 to SL.Count-1 do SL2.Add(SL.Strings[J]);
    SL.Clear;
    for J := 0 to SL2.Count-1  do SL.Add(SL2.Strings[J]);
    SL2.Clear;
  end;
end;

function sInsWord(s,w:string;IB:integer):string;
begin
  result := left(s,IB-1)+w+rightfrom(s,IB);
end;



(* из списка строк SL от строки JS1 до строки JS2 (считая от 1)     *)
(* удалить фрагмент строки длиной ND символов, начиная с позиции IB *)
procedure SLDelWord(SL:TStrings;ND:integer;JS1,JS2,IB:integer);
var J,N : integer; S : string; SL2 : TStringList;
begin
  if ND <= 0 then Exit;

  N := JS2 - JS1;
  if (N < 100) then begin
    for J := JS1-1 to JS2-1 do begin
      SL.Strings[J] := sDelWord(SL.Strings[J],ND,IB);
    end;
  end
  else begin
    SL2 := TStringList.Create;
    for J := 0 to JS1-2        do SL2.Add(SL.Strings[J]);
    for J := JS1-1 to JS2-1    do SL2.Add(sDelWord(SL.Strings[J],ND,IB));
    for J := JS2 to SL.Count-1 do SL2.Add(SL.Strings[J]);
    SL.Clear;
    for J := 0 to SL2.Count-1  do SL.Add(SL2.Strings[J]);
    SL2.Clear;
  end;

//for J := JS1-1 to JS2-1 do begin
//  if (J>=0) and (J<SL.Count)
//  then begin
//    S := SL.Strings[J];
//    SL.Strings[J] := left(S,IB-1)+rightfrom(S,IB+ND);
//  end;
//end;
end;

function sDelWord(s:string;ND,IB:integer):string;
begin result := left(s,IB-1)+rightfrom(s,IB+ND); end;


(* вклеить в SL колонку из SL2, она должна состоять из одиночных слов *)
(* если SL2 длинее JS2-JS1, конец усекается                           *)
(* если короче в нижние строки дописывается '000...0'                 *)
procedure SLPasteCol(SL,SL2:TStrings;JS1,JS2,IB:integer); overload;
var J,JJ,N : integer;
  S,SS : string;
  sb0,sb1 : string;
  W,W0 : string;
  L,LL : integer;
  Q0 : boolean;  (* 1-й символ во вставл-ой колонке <>' ' *)
  SL3 : TStringList;
begin
  if Not Assigned(SL2) then Exit;
  if SL2.Count = 0 then Exit;

  L := 0; Q0 := false;
  for JJ := 0 to SL2.Count-1 do begin
    S := SL2.Strings[JJ]; LL := length(S);
    if LL > L then L := LL;  (* L - самая большая длина подстроки *)
    if LL > 0 then           (* строка не пустая *)
      if S[1] <> ' ' then    (* и первый символ отличен от пробела *)
        Q0 := true;
  end;

  if Q0   then sb0 := ' ' else sb0 := '';
  if IB=1 then sb1 := ' ' else sb1 := '';

  setlength(W0,L); FillChar(W0[1],L,'0');  (* W0 - пустое слово *)
  W0 := sb0 + W0 + sb1;

  JJ := 0;

//for J := JS1-1 to JS2-1 do begin
//    как мы будем присваивать SL.Strings[J] := если J<0 или > Count ???
//  if (J<0) or (J>=SL.Count) or (JJ >= SL2.Count) then W := W0
//  else begin
//    inc(JJ);
//  end;
//  W := sb0 + JustL(SL2.Strings[JJ],L) + sb1; inc(JJ);
//  SL.Strings[J] := sInsWord(SL.Strings[J],W,IB);
//end;

  N := JS2 - JS1;
  if (N < 100) then begin
    for J := JS1-1 to JS2-1 do begin
      if JJ >= SL2.Count then W := W0 else begin
        W := sb0 + JustL(SL2.Strings[JJ],L) + sb1; inc(JJ);
      end;
      SL.Strings[J] := sInsWord(SL.Strings[J],W,IB);
    end;
  end
  else begin
     SL3 := TStringList.Create;
    for J := 0 to JS1-2        do SL3.Add(SL.Strings[J]);
    for J := JS1-1 to JS2-1    do begin
      if JJ >= SL2.Count then W := W0 else begin
        W := sb0 + JustL(SL2.Strings[JJ],L) + sb1; inc(JJ);
      end;
      SL3.Add(sInsWord(SL.Strings[J],W,IB));
    end;
    for J := JS2 to SL.Count-1 do SL3.Add(SL.Strings[J]);
    SL.Clear;
    for J := 0 to SL3.Count-1  do SL.Add(SL3.Strings[J]);
    SL3.Clear;
  end;

end; (* SLPasteCol *)


procedure SLPasteCol(SL:TStrings;S2:string;JS1,JS2,IB:integer);
var {J,JJ : integer;
  S,SS : string;
  W,W0 : string;      }
  SL2 : TStringList;
{  L,LL : integer;
  Q0 : boolean;          }
begin
  if S2 = '' then Exit;
  SL2 := StrToSList(S2,#13#10); (* делим на список строк по разделителю CR/LF *)
  SLPasteCol(SL,SL2,JS1,JS2,IB);
{
  Exit;


  L := 0; Q0 := false;

  for JJ := 0 to SL2.Count-1 do begin
    S := SL2.Strings[JJ]; LL := length(S);
    if LL > L then L := LL;  (* L - самая большая длина подстроки *)
    if LL > 0 then           (* строка не пустая *)
      if S[1] <> ' ' then    (* и первый символ отличен от пробела *)
        Q0 := true;
  end;

  setlength(W0,L); FillChar(W0[1],L,' ');  (* W0 - пустое слово *)
  JJ := 0;
  for J := JS1-1 to JS2-1 do begin
    if (J<0) or (J>=SL.Count) or (JJ >= SL2.Count) then W := W0
    else begin
      W := JustL(SL2.Strings[JJ],L);
      inc(JJ);
    end;
    if Q0 then W := ' '+W;
    if (IB=1) then W := W + ' '; (* вставляем в начало строки *)
    SS := SL.Strings[J];
    SS := left(SS,IB-1)+W+rightfrom(SS,IB);
    SL.Strings[J] := SS;
  end;
}
end; (* SLPasteCol *)


function SLToExcelString(SL:TStrings;JS:integer):string;
var J,J1,J2 : integer;
  S0,S,SS,W,D : string;
  I,NC : integer;
begin
  FindTabBegEnd(SL,JS,J1,J2);
  J := J1-1;
  S0 := SL.Strings[J];
  NC := GetNWord(S0);
  SS := '';
  for J := J1-1 to J2-1 do begin
    S0 := SL.Strings[J];
    S := '';  D := '';
    for I := 1 to NC do begin
      W := GetWordN(S0,I);
//    W := StrSubst(W,'.',',');
      S := S + D + W;
      D := #9;
    end;
    SS := SS + S + #13#10;
  end;
  //ClipBoard.AsText := SS;
  result := SS;
end;


function SLFromExcelString(SS:string):TStringList;
var SL : TStringList;
begin
//SS := ClipBoard.AsText;
  SS := SubstStr(SS,#9,' ');
  SL := StrToSList(SS,#13#10);
  LineTabStrings(SL,1);  (* выравнять колонки в SL *)
  result := SL;
end;

(* строк таблицы будет в N раз меньше, чем было *)
(* - каждые N строк объединять в одну           *)
(*     с N раз большим количеством слов         *)
procedure SLTabSlice(SL:TStrings;N,JS:integer);
var I,K,J,JJ,JN,J1,J2,NC : integer;
  S,W,SS : string;
  SL2 : TStringList;
begin
  FindTabBegEnd(SL,JS,J1,J2);
  if (J2-J1+1) mod N <> 0 then begin
    WarnAbs('В таблице '+ISt(J2-J1+1)+
    ' строк, невозможно распределить по '+ISt(N)+
    ' остаются лишние!');
    Exit;
  end;

  SL2 := TStringList.Create;

  S := SL.Strings[J1-1];
  NC := GetNWord(S);

  J := J1 - 1;
  for JN := 1 to (J2-J1+1) div N do begin
    SS := '';
    for I := 1 to NC do begin
      for JJ := 0 to N-1 do begin
        W := GetWordN(SL.Strings[J+JJ],I);
        SS := SS + ' ' + W;
      end;
    end;
    SL2.Add(SS);
    inc(J,N);
  end;

  LineTabStrings(SL2,1);  (* выровнять по колонкам *)

  for J := J2-1 downto J1-1 do SL.Delete(J);
  for J := SL2.Count-1 downto 0 do SL.Insert(J1-1,SL2.Strings[J]);
  SL2.Clear;
  SL2.Destroy;

end;

function SLFromExcel:TStringList;
var SS : string;
  SL : TStringList;
begin                       
//  Time_routine('swStr.SLFromExcel',true);
  SS := ClipBoard.AsText;
  SS := SubstStr(SS,#9,' ');
  SL := StrToSList(SS,#13#10);
  LineTabStrings(SL,1);
  result := SL;
//  Time_routine('swStr.SLFromExcel',false);
end;



function SLFromExcelFilled:TStringList;
var SS : string;
  SL : TStringList;
begin
//  Time_routine('swStr.SLFromExcel',true);
  SS := ClipBoard.AsText;
  SS := TrimFields(SS,#9);
  SS := SubstInstWord(SS,#9,'-');
  SS := SubstStr(SS,' ','_');
  SS := SubstStr(SS,#9,' ');
  SL := StrToSList(SS,#13#10);
  LineTabStrings(SL,1);
  result := SL;
//  Time_routine('swStr.SLFromExcel',false);
end;




function SLFromClpBrd:TStringList;
var SS : string;
  SL : TStringList;
begin
  SS := ClipBoard.AsText;
  SS := SubstStr(SS,#9,' ');
  if pos(#13,SS) = 0 then begin
    SL := TStringList.Create;
    SL.Add(SS);
  end
  else begin
    SL := StrToSList(SS,#13#10);
    if SL.Count > 1 then LineTabStrings(SL,1);
  end;
  result := SL;
end;




function CheckExcelWord(S:string):string;
var jsig : integer;
begin
  if Not InNumber(S) then begin result := S; Exit end;

  (* преобразовать цифровую величину к формату Excel *)
  (* проверим на ситуацию -123+12 вместо -123E+12 *)
  jsig := PosSet(['-','+'],RightFrom(S,2));
  if jsig > 0 then
    if S[jsig] in ['0'..'9'] then  (* S[jsig] - это символ перед "+/-" *)
      S := left(S,jsig)+'E'+rightfrom(S,jsig+1);

  (* Может потребоваться заменить десятичную точку на запятую *)
  if ChExcelDecPoint <> '.' then
    S := SubstStr(S,'.',ChExcelDecPoint);

  result := S;
end;



procedure SLCopyToExcel(SL:TStrings;JS:integer);
var J,J1,J2 : integer;
  S0,S,SS,W,D : string;
  I,NC : integer;
begin
  FindTabBegEnd(SL,JS,J1,J2);
  J := J1-1;
  S0 := SL.Strings[J];
  NC := GetNWord(S0);
  SS := '';
  for J := J1-1 to J2-1 do begin
    S0 := SL.Strings[J];
    S := '';  D := '';
    for I := 1 to NC do begin
      W := GetWordN(S0,I);
      W := CheckExcelWord(W);
      S := S + D + W;
      D := #9;
    end;
    SS := SS + S + #13#10;
  end;
  ClipBoard.AsText := SS;
end;



(*---------------------------------------------*)
(*--- в текстовой таблице выравнять колонки ---*)
(*---------------------------------------------*)
(*-------------------------------------------------*)
(*    Таблица понимается как набор строк, каждая   *)
(*    из которых имеет одинаковое количество слов  *)
(*    разделенных пробелами                        *)
(* Автоматически устанавливаем верхнюю и нижнюю границу таблицы *)
(* строковые поля выравниваем влево *)
(* числовые поля выравниваем вправо *)
(* если есть десятичная точка, выравниваем по точке и прижимаем вправо *)
procedure LineTabStrings(SL:TStrings;JS:integer);
var I,J,JP,JP0,L,NW,J1,J2 : integer;
  ALW,ALF,ALN,ALD,AIHd : array of integer; (* динамический массив *)
  AQN : array of boolean;
  S0,S,D,W0,W : string;
  JJ : integer;

  QNumb : boolean;
  IHead : integer;
  LF : integer;
  PP,LN,LD : integer;

  SL2 : TStringList;

begin
  if JS < 1 then begin
    WarnAbs('В процедуре swStr.LineTabStrings счёт строк идёт от 1, вы задали '+
            ISt(JS)+'!');
    Exit;
  end;

  if Not Assigned(SL) then begin
    WarnAbs('swStr.LineTabStrings-Err: SL Not Assigned!');
    Exit;
  end;

  J := JS-1;
  if J >= SL.Count then Exit;
  NW := GetNWord(SL.Strings[J]);
  FindTabBegEnd(SL,JS,J1,J2);    (* верхняя J1 и нижняя J2 границы таблицы *)
  SetLength(ALW,NW+1);
  SetLength(ALF,NW+1);
  SetLength(ALN,NW+1);
  SetLength(ALD,NW+1);
  SetLength(AIHd,NW+1);
  SetLength(AQN,NW+1);

  for I := 0 to NW do begin
    ALW[I] := 0;              (* макс. ширина слова в колонке   *)
    ALF[I] := 0;              (* макс.ширина колонки (поля)     *)
    ALN[I] := 0;              (* макс.число цифр ДО точки       *)
    ALD[I] := 0;              (* макс.кол-во знаков после точки *)
    AIHd[I]:= 0;              (* кол-во нечисловых строк сверху *)
    AQN[I] := true;           (* это числовая колонка?          *)
  end;

  (* первый проход, определяем длины полей *)
  (*       и длины полей с учетом пробелов *)
{
  QNumb := true;
  IHead := 0;
  LD := 0;
  LN := 0;
}

  for J := J2-1 downto J1-1 do begin (* нач.с нижней строки *)
    S := SL.Strings[J];
    JP := 1;                    (* тек.поз.для анализа строки *)
    for I := 1 to NW do begin   (* цикл по колонкам (полям)   *)
      JP0 := JP;                (* запоминаем текущ.позицию   *)
      W := GetWordEx(S,JP,[#9,' ']);(* тек.слово              *)
      LF := JP - JP0;           (* "размах" колонки           *)
      L := length(W);           (* длина слова в колонке      *)
      if L  > ALW[I] then ALW[I] := L;
      if LF > ALF[I] then ALF[I] := LF;

      if AQN[I] then begin      (* если колонка считается числовой *)
        if Not swStr.InNumber(W) then begin (* перестала быть числовой *)
          AQN[I]  := false;
          AIHd[I] := J-(J1-1)+1; (* уст.высоту заголовка *)
        end
        else begin     (* текущ.поле - очередное число *)
          PP := pos('.',W);
          if PP > 0 then begin   (* есть десятичная точка в числе *)
            if (ALN[I] < PP-1)   then ALN[I] := PP-1;   (* цифры до точки *)
            if (ALD[I] < L - PP) then ALD[I] := L - PP; (* знаки после    *)
          end
          else if (ALN[I] < L) then ALN[I] := L; (* число без точки = целое *)
        end;
      end;
    end; (* for I - перебор полей *)
  end; (* for J - перебор строк *)


  (* уточняем размеры полей с учетом десятичных чисел *)
  for I := 1 to NW do begin
    if AIHd[I] <= 3 then     (* титульных строк не более трех *)
      if ALW[I] < ALN[I]+1+ALD[I] then
        if (ALD[I] > 0) then ALW[I] := ALN[I]+1+ALD[I];
  end;



  for I := 1 to NW do begin
    if ALD[I] = 0 then begin
      if ALW[I] < ALN[I] then ALW[I] := ALN[I] else
      if ALN[I] < ALW[I] then ALN[I] := ALW[I];
    end
    else begin
      if ALW[I] < ALN[I]+1+ALD[I] then ALW[I] := ALN[I]+1+ALD[I] else
      if ALN[I] < ALW[I]-1-ALD[I] then ALN[I] := ALW[I]-1-ALD[I];
    end;
  end;

{
    if AIHd[I] <= 3 then begin    (* титульных строк не более трех *)
      if ALW[I] < ALN[I]+1+ALD[I] then
        if (ALD[I] > 0) then ALW[I] := ALN[I]+1+ALD[I];
      if ALD[I] = 0
      then if ALW[I] > ALN[I] then ALN[I] := ALW[I]
      else if ALW[I] > ALN[I] + 1 + ALD[I] then ALN[I] := ALW[I] - 1 - ALD[I];
    end
    else begin
    (* корректировать не надо, т.к. всегда будет вывод как строк, а не чисел *)
    (* ??? *)
    end;
  end;
}




{
SL2 := TStringList.Create;
for I := 1 to NW do begin
  S := NSt(I,2)+' Hd='+NSt(AIHd[I],2)+' W='+NSt(ALW[I],2)+
  ' N='+NSt(ALN[I],2)+' D='+ISt(ALD[I]);
  SL2.Add(S);
end;
WARNAbs(SListToStr(SL2));
}

  (* служебная строка из пробелов *)
  setlength(W0,255);
  FillChar(W0[1],255,' ');

  (* второй проход - выравниваем поля *)

  SL2 := TStringList.Create;

  for J := 0 to J1-2 do begin  (* индекс строки в SL *)
    S := SL.Strings[J];
    SL2.Add(S);
  end;

  for J := J1-1 to J2-1 do begin  (* индекс строки в SL *)
    S0 := SL.Strings[J];
    JP := 1;
    S := '';
    D := ' ';
    JJ := J - (J1-1) + 1;         (* номер строки в таблице *)
    for I := 1 to NW do begin
      S := S + D; //copy(W0,1,AL[I]-AW[I]);
      W := Trim(GetWord(S0,JP));
      if JJ <= AIHd[I] then S := S + JustL(W,ALW[I])
      else begin
        if ALD[I] = 0 then S := S + JustR(W,ALW[I]) else begin
          PP := pos('.',W);
          if PP = 0
          then S := S + JustR(W,ALN[I])+copy(W0,1,1+ALD[I])
          else S := S + JustR(copy(W,1,PP-1),ALN[I])+
                        JustL(copy(W,PP,length(W)-PP+1),ALD[I]+1);
        end;
      end;
      D := '  ';
    end;


//  SL.Strings[J] := S;
    SL2.Add(S);
  end;

  for J := J2 to SL.Count-1 do begin  (* индекс строки в SL *)
    S := SL.Strings[J];
    SL2.Add(S);
  end;

  SL.Clear;

  for J := 0 to SL2.Count-1 do begin  (* индекс строки в SL *)
    S := SL2.Strings[J];
    SL.Add(S);
  end;
  SL2.Clear;
end; (* LineTabStrings *)





(*---------------------------------------------*)
(*--- в текстовой таблице выравнять колонки ---*)
(*---------------------------------------------*)
(*-------------------------------------------------*)
(*    Таблица понимается как набор строк, каждая   *)
(*    из которых имеет одинаковое количество полей *)
(*    разделенных знаками ChDiv                    *)
(*    если ChDiv -пробел, работаем особым способом *)
(* Автоматически устанавливаем верхнюю и нижнюю границу таблицы *)
(* строковые поля выравниваем влево *)
(* числовые поля выравниваем вправо *)
(* если есть десятичная точка, выравниваем по точке и прижимаем вправо *)
(*-------------------------------------------------*)
(* если задана ChQuote <> #0, то содержимое между  *)
(* двумя кавычками считается одним словом          *)



procedure LineTabStrings(SL:TStrings;JS:integer;ChQuote,ChDiv:char);
var I,I1,J,JP,JP0,L,NW,J1,J2 : integer;
  ALW,ALF,ALN,ALD,AIHd : array of integer; (* динамический массив *)
  AQN : array of boolean;
  S0,S,D,W0,W : string;
  JJ : integer;

  QNumb : boolean;
  IHead : integer;
  LF : integer;
  PP,LN,LD : integer;

  SL2 : TStringList;

begin
  J := JS-1;

  NW := GetNWord(SL.Strings[J],ChQuote,ChDiv);


  FindTabBegEnd(SL,JS,J1,J2,ChQuote,ChDiv);
  SetLength(ALW,NW+1);
  SetLength(ALF,NW+1);
  SetLength(ALN,NW+1);
  SetLength(ALD,NW+1);
  SetLength(AIHd,NW+1);
  SetLength(AQN,NW+1);

  for I := 0 to NW do begin
    ALW[I] := 0;              (* макс. ширина слова в колонке   *)
    ALF[I] := 0;              (* макс.ширина колонки (поля)     *)
    ALN[I] := 0;              (* макс.число цифр ДО точки       *)
    ALD[I] := 0;              (* макс.кол-во знаков после точки *)
    AIHd[I]:= 0;              (* кол-во нечисловых строк сверху *)
    AQN[I] := true;           (* это числовая колонка?          *)
  end;

  (* первый проход, определяем длины полей *)
  (*       и длины полей с учетом пробелов *)


  for J := J2-1 downto J1-1 do begin (* нач.с нижней строки *)
    S := SL.Strings[J];
    JP := 1;                    (* тек.поз.для анализа строки *)


    if ChDiv = ' ' then I1 := 1 else I1 := 0;
    for I := I1 to NW do begin  (* цикл по колонкам (полям)   *)
      JP0 := JP;                (* запоминаем текущ.позицию   *)
                                                 (* тек.слово *)
      if ChDiv = ' ' then begin
        if Not (ChQuote in [#0,' '])
          then W := GetQuotedWord(S,JP,ChQuote)
          else W := GetWordEx(S,JP,[#9,' ']);
      end
      else W := GetFldN(S,ChDiv,I);

      LF := JP - JP0;           (* "размах" колонки           *)
      L := length(W);           (* длина слова в колонке      *)
      if L  > ALW[I] then ALW[I] := L;
      if LF > ALF[I] then ALF[I] := LF;

      if AQN[I] then begin      (* если колонка считается числовой *)
        if Not swStr.InNumber(W) then begin (* перестала быть числовой *)
          AQN[I]  := false;
          AIHd[I] := J-(J1-1)+1; (* уст.высоту заголовка *)
        end
        else begin     (* текущ.поле - очередное число *)
          PP := pos('.',W);
          if PP > 0 then begin   (* есть десятичная точка в числе *)
            if (ALN[I] < PP-1)   then ALN[I] := PP-1;   (* цифры до точки *)
            if (ALD[I] < L - PP) then ALD[I] := L - PP; (* знаки после    *)
          end
          else if (ALN[I] < L) then ALN[I] := L; (* число без точки = целое *)
        end;
      end;
    end; (* for I - перебор полей *)
  end; (* for J - перебор строк *)

  (* уточняем размеры полей с учетом десятичных чисел *)
  for I := I1 to NW do begin
    if AIHd[I] <= 3 then     (* титульных строк не более трех *)
      if ALW[I] < ALN[I]+1+ALD[I] then
        if (ALD[I] > 0) then ALW[I] := ALN[I]+1+ALD[I];
  end;



  for I := I1 to NW do begin
    if ALD[I] = 0 then begin
      if ALW[I] < ALN[I] then ALW[I] := ALN[I] else
      if ALN[I] < ALW[I] then ALN[I] := ALW[I];
    end
    else begin
      if ALW[I] < ALN[I]+1+ALD[I] then ALW[I] := ALN[I]+1+ALD[I] else
      if ALN[I] < ALW[I]-1-ALD[I] then ALN[I] := ALW[I]-1-ALD[I];
    end;
  end;


  (* служебная строка из пробелов *)
  setlength(W0,255);
  FillChar(W0[1],255,' ');




  (* второй проход - выравниваем поля *)


  SL2 := TStringList.Create;

  for J := 0 to J1-2 do begin
    S := SL.Strings[J];
    SL2.Add(S);
  end;

  for J := J1-1 to J2-1 do begin  (* индекс строки в SL *)
    S0 := SL.Strings[J];
    JP := 1;
    S := '';
    D := ' ';
    JJ := J - (J1-1) + 1;         (* номер строки в таблице *)


    for I := I1 to NW do begin
      S := S + D; //copy(W0,1,AL[I]-AW[I]);
//    W := GetWord(S0,JP);
      if ChDiv = ' ' then begin
        if Not (ChQuote in [#0,' '])
          then W := GetQuotedWord(S0,JP,ChQuote)
          else W := GetWordEx(S0,JP,[#9,' ']);
      end
      else W := GetFldN(S0,ChDiv,I);

      W := Trim(W);

      if JJ <= AIHd[I] then S := S + JustL(W,ALW[I])
      else begin
        if ALD[I] = 0 then S := S + JustR(W,ALW[I]) else begin
          PP := pos('.',W);
          if PP = 0
          then S := S + JustR(W,ALN[I])+copy(W0,1,1+ALD[I])
          else S := S + JustR(copy(W,1,PP-1),ALN[I])+
                        JustL(copy(W,PP,length(W)-PP+1),ALD[I]+1);
        end;
      end;

      if ChDiv = ' ' then D := '  ' else D := '' + ChDiv;
    end;

//  SL.Strings[J] := S;
    SL2.Add(S);
  end;

  for J := J2 to SL.Count - 1 do begin
    S := SL.Strings[J];
    SL2.Add(S);
  end;

  SL.Clear;

  for J := 0 to SL2.Count - 1 do begin
    S := SL2.Strings[J];
    SL.Add(S);
  end;
  SL2.Clear;

end;





procedure TTextTabStruct.AddCol(I00,IB0,IW0:integer);
var P : PTabField;
begin
  GetMem(P,SizeOf(TTabField));
  P^.I0:= I00; P^.IB := IB0; P^.IW := IW0;
  Self.Add(P);
end;


function TTextTabStruct.Report:TStringList;
var SL : TStringList;  S : string; P : PTabField;
  I,IC,I0,IB,IW : integer;
begin
  SL := ClassReport;

  if Not Assigned(Self)
    then begin
       Result := SL;
       Exit;
    end;


  S := 'Count='+ISt(Self.Count)+
       ' Capacity='+ISt(Self.Capacity)
       ;
  SL.Add(S);
  if Count > 0 then begin
    SL.Add('КОЛОНКИ от 1 до '+ISt(Count)+':');
    SL.Add(' №  I0  Beg Wide');
  end;
  for I := 0 to Count-1 do begin
    IC := I+1;
    GetBeWi(IC,I0,IB,IW);
    S := NSt(IC,3)+NSt(I0,4)+NSt(IB,4)+' '+NSt(IW,4);
    SL.Add(S);
  end;
  result := SL;
end;




class function TTextTabStruct.ClassReport:TStringList;
var SL : TStringList;  S : string;
  S1,S2,S3,S4,S5,S6 : string; P : pointer;


begin
  SL := TStringList.Create;
  SL.Add('Отчет TextTabStruct:');
  if Self = NIL then begin
    SL.Add('TextTabStruct = NIL !!!');
    result := SL;
    Exit;
  end;
  if Not Assigned(Self) then begin
    SL.Add('TextTabStruct NOT Assigned !!!');
    result := SL;
    Exit;
  end;
  S1 := Self.ClassName;
  P  := MethodAddress('ClassReport');
  S2 := HexP(P);
  S3 := Self.MethodName(P);
  S4 := ISt(Self.InstanceSize);
  S5 := HexA(Self);
  S6 := HexP(Self);
  S  := 'ClassName='+S1+
//      ' ClassReport_MethodAddress='+S2+
//      ' MethodName='+S3+
        ' TextTabStruct_Size='+S4+
        ' Adress='+S5+
        ' Pointer='+S6
        ;
  SL.Add(S);
  result := SL;
end;






destructor TTextTabStruct.Destroy;
begin
  Done;
  Inherited Destroy;
end;


procedure TTextTabStruct.Done;
var I : integer; P : pointer;
begin
  if Not Assigned(Self) then Exit;
  for I := Count-1 downto 0 do begin
    (* память в TextTabStruct распределяли вручную - вручную надо освободить *)
    P := Items[I];
    if Assigned(P) then FreeMem(P,SizeOf(TTabField));
    Delete(I);
  end;
  Clear;
end;



(* получить номер колонки по позиции *)
(*  - таблица должна быть выровнена  *)
(* колонки считаем от 1 до Count     *)
function TTextTabStruct.GetIC(IP:integer):integer;
var I,II : integer;
  P : PTabField;
begin
  if Not Assigned(Self) then begin WarnAbs(
    'swStr.TextTabStruct.GetIC('+ISt(IP)+') Структура Not Assigned!');
    Exit;
  end;

  result := 0;

{
  if Not Assigned(LC) then begin WarnAbs(
    'swStr.TextTabStruct.GetIC('+ISt(IP)+') список колонок LC Not Assigned!');
    Exit;
  end;
}

//WarnAbs('LC='+LC.ClassName);

  for I := 0 to Count-1 do begin
    P := Items[I];      (* I-ая колонка (считаем от 0) *)
    II := P^.IB-P^.I0;  (* позиция посл.символа предыдущ колонки *)
    if IP < II then begin
      result := I-1+1;  (* номер предыдущей колонки + 1 (считая от 1) *)
      Exit
    end;
  end;
  result := Count;
end;

(* начало и длина колонки :                         *)
(* I0  кол-во пробелов от предыдущ.поля до текущего *)
(* IB  позиция начала слова в колонке               *)
(* IW  ширина самого длинного слова в колонке       *)
procedure TTextTabStruct.GetBeWi(IC:integer;var I0,IB,IW:integer);
var P : PTabField;
begin
  if Not Assigned(Self) then begin WarnAbs(
    'swStr.TextTabStruct.GetBeWi('+ISt(IC)+') Структура Not Assigned!');
    Exit;
  end;

  if (IC > Count) or (IC < 1) then
  begin
    I0:= 0; IB := 0; IW := 0;
//  if Not ((IC = 0) and (Count = 0)) then
    WarnAbs('TextTabStruct.GetBeWi текущая строка IC='+ISt(IC)+
      ' вне строчек! NC='+ISt(Count));
    Exit;
  end;
  P := Items[IC-1];
  I0 := P^.I0; IB := P^.IB; IW := P^.IW;
end;

(* разбор выравненной по полям таблицы *)
procedure TabAnalize
  (CurTT:TTextTabStruct;SL:TStrings;JS1,JS2:integer;ChQuote,ChDiv:char);

(* JS - номера строк, считаем от 1-цы *)
(* предполагается, что таблица уже выровнена по полям *)
var // TA : TTextTabStruct;
  I,I1,J,JP,JP0,NW : integer;
  AI0,AIW,AIB,AIE : array of integer; (* динамический массив *)
  LW,BW,B0 : integer;
  S,W : string;
begin
  if Assigned(CurTT)
    then CurTT.Done
    else begin
      WarnAbs('CurTT(2) Not Assigned!!!');
      CurTT := TTextTabStruct.Create;
    end;

  if (JS2-JS1) <= 0 then Exit;
  if JS1 > SL.Count then Exit;
  if JS2 > SL.Count then JS2 := SL.Count;

  J := JS1-1;
  S := SL.Strings[J];

  NW := GetNWord(S,ChQuote,ChDiv);

  if NW = 0 then begin (* нечего заполнять *)
    Exit;
  end;


                              (* подготовим массивы данных о колонках: *)
  SetLength(AI0,NW+1);        (* число пробелов до предыдущ. колонки   *)
  SetLength(AIW,NW+1);        (* ширина колонки            *)
  SetLength(AIB,NW+1);        (* начальная позиция колонки *)
  SetLength(AIE,NW+1);        (* конечная  позиция колонки *)

  (* пройдем первую строку *)
  JP0:=1; JP := 1;            (* тек.поз.для анализа строки *)

  if ChDiv = ' ' then I1 := 1  (* список слов нач-ся от 1 *)
                 else I1 := 0; (* а список полей -   от 0 *)

  for I := I1 to NW do begin   (* цикл по колонкам (полям)  *)
    if (ChDiv = ' ')
    then W := GetQuotedWord(S,JP,ChQuote)   (* тек.слово              *)
    else W := GetFldN(S,ChDiv,I);

    LW := length(W);          (* длина слова в колонке      *)
    BW := JP - LW;            (* позиция начала колонки     *)
    AIE[I] := JP;             (* поз.конца колонки          *)
    AIW[I] := LW;             (* ширина значений            *)
    AIB[I] := BW;             (* поз.начала колонки         *)
    AI0[I] := BW - JP0;
    JP0    := JP;
  end;

  for J := JS1-1+1 to JS2-1 do begin (* пробегаем остальные строки *)
    S := SL.Strings[J];
    JP0:= 1; JP := 1;           (* тек.поз.для анализа строки *)
    for I := I1 to NW do begin   (* цикл по колонкам (полям)   *)
      if (ChDiv = ' ')
      then W := GetQuotedWord(S,JP,ChQuote)   (* тек.слово              *)
      else W := GetFldN(S,ChDiv,I);

      LW := length(W);          (* длина слова в колонке      *)
      BW := JP - LW;            (* позиция начала колонки     *)
      B0 := BW - JP0;

      if JP > AIE[I] then AIE[I] := JP;
      if LW > AIW[I] then AIW[I] := LW;
      if BW < AIB[I] then AIB[I] := BW;
      if B0 < AI0[I] then AI0[I] := B0;
      JP0 := JP;
    end; (* for I - перебор полей *)
  end; (* for J - перебор строк *)

  JP := AIE[I1];   (* поз.конца первой колонки *)
  AI0[I1] := AIB[I1]-1;
  AIW[I1] := AIE[I1]-AIB[I1];

  for I := I1+1 to NW do begin
    if AIB[I] < JP then begin
      if (JS2-JS1 > 3) then begin
(*
        Warn('В текстовой таблице в окне редактора'+#13#10+
        'поле №'+ISt(I-1)+' кончается_ в позиции '+ISt(JP)+' ,а'+#13#10+
        'поле №'+ISt(I  )+' начинается в позиции '+ISt(AIB[I])+#13#10+
        '- требуется выровнять колонки по ширине!');
*)
      end
      else (* скорее всего, это не таблица *) ;
      Exit;
    end;
    AI0[I] := AIB[I]-JP;
    AIW[I] := AIE[I]-AIB[I];
    JP := AIE[I];
  end;

  for I := 1 to NW do begin
    CurTT.AddCol(AI0[I],AIB[I],AIW[I]);
  end;

end; (* TabAnalize *)


procedure TabAnalize(CurTT:TTextTabStruct;SL:TStrings;JS1,JS2:integer);
(* JS - номера строк, считаем от 1-цы *)
(* предполагается, что таблица уже выровнена по полям *)
var // TA : TTextTabStruct;
  I,J,JP,JP0,NW : integer;
  AI0,AIW,AIB,AIE : array of integer; (* динамический массив *)
  LW,BW,B0 : integer;
  S,W : string;
begin
  if Assigned(CurTT)
    then CurTT.Done
    else begin
      WarnAbs('CurTT(1) Not Assigned!!!');
      CurTT := TTextTabStruct.Create;
    end;

  if (JS2-JS1) <= 0 then Exit;
  if JS1 > SL.Count then Exit;
  if JS2 > SL.Count then JS2 := SL.Count;

  J := JS1-1;
  S := SL.Strings[J];
  NW := GetNWordEx(S,[#9,' ']);

                              (* готовим массивы под данные о колонках: *)
  SetLength(AI0,NW+1);        (* число пробелов до предыдущ. колонки    *)
  SetLength(AIW,NW+1);        (* ширина колонки            *)
  SetLength(AIB,NW+1);        (* начальная позиция колонки *)
  SetLength(AIE,NW+1);        (* конечная  позиция колонки *)

  (* пройдем первую строку *)
  JP0 := 1;                   (* номер 1-го символа колонки *)
  JP  := 1;                   (* тек.поз.для анализа строки *)
  for I := 1 to NW do begin   (* цикл по колонкам (полям)   *)
    W := GetWordEx(S,JP,[#9,' ']);(* тек.слово              *)
    LW := length(W);          (* длина слова в колонке      *)
    BW := JP - LW;            (* позиция начала колонки     *)
    AIE[I] := JP;             (* поз.конца колонки          *)
    AIW[I] := LW;             (* ширина значений            *)
    AIB[I] := BW;             (* поз.начала колонки         *)
    AI0[I] := BW - JP0;       (* число пробелов перед кол.  *)
    JP0    := JP;             (* начало следующей колонки   *)
  end;

  for J := JS1-1+1 to JS2-1 do begin (* пробегаем остальные строки *)
    S := SL.Strings[J];
    JP0 := 1;                   (* номер 1-го символа колонки *)
    JP  := 1;                   (* тек.поз.для анализа строки *)
    for I := 1 to NW do begin   (* цикл по колонкам (полям)   *)
      W := GetWordEx(S,JP,[#9,' ']);(* тек.слово              *)
      LW := length(W);          (* длина слова в колонке      *)
      BW := JP - LW;            (* позиция начала колонки     *)
      B0 := BW - JP0;           (* число пробелов перед кол-й *)

      if JP > AIE[I] then AIE[I] := JP; (* поз.конца   может увеличится  *)
      if LW > AIW[I] then AIW[I] := LW; (* длина слова может увеличиться *)
      if BW < AIB[I] then AIB[I] := BW; (* начало может сдвинуться влево *)
      if B0 < AI0[I] then AI0[I] := B0; (* пробелов ДО может уменьшиться *)
      JP0 := JP;
    end; (* for I - перебор полей *)
  end; (* for J - перебор строк *)

  JP := AIE[1];
  for I := 2 to NW do begin
    if AIB[I] < JP then begin
      if ((JS2 - JS1) > 3)
      then begin

(*
        Warn('В текстовой таблице в окне редактора'+#13#10+
        'поле №'+ISt(I-1)+' кончается_ в позиции '+ISt(JP)+' ,а'+#13#10+
        'поле №'+ISt(I  )+' начинается в позиции '+ISt(AIB[I])+#13#10+
        '- требуется выровнять колонки по ширине!');
*)        
      end
      else (* скорее всего, это не таблица *) ;

      Exit;
    end;
    JP := AIE[I];
  end;

  for I := 1 to NW do begin
    CurTT.AddCol(AI0[I],AIB[I],AIW[I]);
  end;
//result := TA;
end; (* TabAnalize *)



{
function EncodeBase64(const inStr: string): string;

  function Encode_Byte(b: Byte): char;
  const
    Base64Code: string[64] =
      'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  begin
    Result := Base64Code[(b and $3F)+1];
  end;

var
  i: Integer;
begin
  i := 1;
  Result := '';
  while i <= Length(InStr) do
  begin
    Result := Result + Encode_Byte(Byte(inStr[i]) shr 2);
    Result := Result + Encode_Byte((Byte(inStr[i]) shl 4) or (Byte(inStr[i+1]) shr 4));
    if i+1 <= Length(inStr) then
      Result := Result + Encode_Byte((Byte(inStr[i+1]) shl 2) or (Byte(inStr[i+2]) shr 6))
    else
      Result := Result + '=';
    if i+2 <= Length(inStr) then
      Result := Result + Encode_Byte(Byte(inStr[i+2]))
    else
      Result := Result + '=';
    Inc(i, 3);
  end;
end;

// Base64 decoding
function DecodeBase64(const CinLine: string): string;
const
  RESULT_ERROR = -2;
var
  inLineIndex: Integer;
  c: Char;
  x: SmallInt;
  c4: Word;
  StoredC4: array[0..3] of SmallInt;
  InLineLength: Integer;
begin
  Result := '';
  inLineIndex := 1;
  c4 := 0;
  InLineLength := Length(CinLine);

  while inLineIndex <= InLineLength do
  begin
    while (inLineIndex <= InLineLength) and (c4 < 4) do
    begin
      c := CinLine[inLineIndex];
      case c of
        '+'     : x := 62;
        '/'     : x := 63;
        '0'..'9': x := Ord(c) - (Ord('0')-52);
        '='     : x := -1;
        'A'..'Z': x := Ord(c) - Ord('A');
        'a'..'z': x := Ord(c) - (Ord('a')-26);
      else
        x := RESULT_ERROR;
      end;
      if x <> RESULT_ERROR then
      begin
        StoredC4[c4] := x;
        Inc(c4);
      end;
      Inc(inLineIndex);
    end;

    if c4 = 4 then
    begin
      c4 := 0;
      Result := Result + Char((StoredC4[0] shl 2) or (StoredC4[1] shr 4));
      if StoredC4[2] = -1 then Exit;
      Result := Result + Char((StoredC4[1] shl 4) or (StoredC4[2] shr 2));
      if StoredC4[3] = -1 then Exit;
      Result := Result + Char((StoredC4[2] shl 6) or (StoredC4[3]));
    end;
  end;
end;
}


(* сравнение строк, содержащих числа *)
function LessStrDig(S1,S2:string):boolean;
  var I1,I2 : integer; (* индексы для строк *)
      K1,K2 : integer; (* индексы для подстрок составляемых из цифр *)
      C1,C2 : char;    (* копии текущих букв каждой строки  *)
      Q01,Q02 : boolean;    (* для ведущих нулей *)
      SS1,SS2 : string[80]; (* подстроки         *)
  begin
    I1 := 1; I2 := 1; C1 := S1[I1]; C2 := S2[I2]; K1 := 1; K2 := 1;
    REPEAT
    Q01 := false; Q02 := false;               (* для ведущих нулей         *)
    if (C1 >= '0') and (C1 <= '9') and        (* в обоих строках теку-     *)
       (C2 >= '0') and (C2 <= '9') then begin (*    щий символ - это цифра *)
        repeat
          if Q01 or (C1 <> '0')     (* ведущие нули пропускаем *)
            then begin Q01 := true; SS1[K1] := C1; inc(K1); end;
          inc(I1); C1 := S1[I1];
        until (I1 > length(S1)) or (C1 < '0') or (C1 > '9');
        repeat
          if Q02 or (C2 <> '0')     (* ведущие нули пропускаем *)
            then begin Q02 := true; SS2[K2] := C2; inc(K2); end;
          inc(I2); C2 := S2[I2];
        until (I2 > length(S2)) or (C2 < '0') or (C2 > '9');
        dec(K1); dec(K2);
        if K1 <> K2 then begin LessStrDig := (K1 < K2); Exit end;
        for K1 := 1 to K2 do begin
          if SS1[K1] <> SS2[K1]
          then begin LessStrDig := (SS1[K1] < SS2[K1]); Exit end;
        end;
        K1 := 1; K2 := 1;
      end
      else begin
        if C1 <> C2 then begin
          LessStrDig := (C1 < C2); Exit
        end;
        inc(I1); inc(I2); C1 := S1[I1]; C2 := S2[I2];
      end;
    UNTIL (I1 > length(S1)) or (I2 > length(S2));
    LessStrDig := length(S1) < length(S2);
  end;


(* string -> array of char *)
procedure StrToChars(S:string;var Chrs;LL:integer);
var L : integer;
begin
//LL := SizeOf(Chrs);
  FillChar(Chrs,LL,' ');
  L := length(S);
  if L>= LL then move(S[1],Chrs,LL)
            else move(S[1],Chrs,L);
end;




(* строку делим на список строк *)
(* повторяющиеся символы D считаются одним разделителем *)
function StrToSList(S:string;D:Char):TStringList;
var SL : TStringList; SS : string;
  J0,J : integer; DD : char;
begin
//  Time_routine('swStr.StrToSList(D)',true);
  (* разбросаем S по отдельным строчкам *)
  if S = '' then begin result := Nil; Exit; end;
  SL := Classes.TStringList.Create;
  J0 := 1; // индекс в строке S, счёт идёт от единицы
  DD := D;
  for J := 1 to length(S) do begin
    if S[J] = D then begin          // это разделитель
      if D <> DD then               // он не равен предыдущему символу
      begin              // D = #10
        if J = J0 then SS := ''
                  else SS := copy(S,J0,J-J0);
        SL.Add(SS);
      end;
      J0 := J + 1;
    end;
    DD := S[J];
  end;
{
if pos('Находка',S) > 0 then begin
  WARN(S+' J0='+ISt(J0)+' L='+ISt(Length(S)));
end;
}
  if J0 <= length(S) then begin
    SS := copy(S,J0,Length(S)+1-J0);
    SL.Add(SS);
  end;
  result := SL;
//  Time_routine('swStr.StrToSList(D)',false);
end;


(* строку делим на список строк *)
function StrToSList(S:string;SD:string):TStringList;
var SL : TStringList; SS : string;
  P,LD : integer;
  L,I,J,P0  : integer;
  Q : boolean;
  ch : char;
begin
//  Time_routine('swStr.StrToSList(SD)',true);

  (* разбросаем S по отдельным строчкам *)
  if S = '' then begin result := Nil; Exit; end;



  L := length(S);

  LD := length(SD);
  SL := Classes.TStringList.Create;



{
  P := pos(SD,S);
  while P > 0 do begin
    SS := copy(S,1,P-1);
    S := copy(S,P+LD,length(S)-(P+LD-1));
    SL.Add(SS);
    P := pos(SD,S);
  end;
}
  I := 1; J := 1; Q := false; ch := SD[1]; P0 := 1;
  while (I <= L) do begin
    if (Not Q) then begin        // мы не в поле разделителя
      if (S[I] = ch) then begin
        P := I;
        Q := true;
        inc(J);
      end
      else ;                    // ничего не меняется
    end
    else begin                  // мы были в поле разделителя
      if (J > LD) then begin    //   и он наконец кончился
        SS := copy(S,P0,P-P0);
        SL.Add(SS);             // копируем строку
        Q := false;             // отменяем поле разделителя
        P0 := I;                // назначаем индекс начала след.строки
        P := 0;                 // сбрасываем индекс начала разделителя
        J := 1;

        if (S[I] = ch) then begin  // тут мог начатся следующий разделитель!
          P := I;
          Q := true;
          inc(J);
        end;
      end
      else                       // продолжаем находится в теле разделителя
        if (S[I] <> SD[J]) then begin // и он оборвался
          Q := false;
          J := 1;
          P := 0;
        end
        else begin  // разделитель успешно продолжается
          inc(J);
        end;
    end;  // конец обработки поля разделителя
    inc(I);
  end; // while
  if (P0 <= L) then begin
    SS := copy(S,P0,L-P0);
    SL.Add(SS);              // копируем строку
  end;




//if S <> '' then SL.Add(S);
  result := SL;
//  Time_routine('swStr.StrToSList(SD)',false);
end;


(* строку делим на список строк *)
function StrToSList(S:string;SC:CharSet):TStringList; overload;
var SL : TStringList; SS : string;
  J0,J : integer;
  QDiv : boolean; (* вошли в зону разделителя *)
begin
//  Time_routine('swStr.StrToSList(SC)',true);
  (* разбросаем S по отдельным строчкам *)
  if S = '' then begin result := Nil; Exit; end;
  SL := Classes.TStringList.Create;
  QDiv := false;
  J0 := 1;
  for J := 1 to length(S) do begin
    if QDiv then begin
      if Not (S[J] in SC) then begin     (* вышли из зоны разделителя *)
        QDiv := false;
        J0 := J;
      end;
    end
    else begin
      if S[J] in SC then begin
        QDiv := true;
        if J = J0 then SS := ''
                  else SS := copy(S,J0,J-J0);
        SL.Add(SS);
      end;
    end;
  end;

  if J0 <= length(S) then begin
    SS := copy(S,J0,Length(S)+1-J0);
    Trim(SS);
    SL.Add(SS);
  end;
  result := SL;
//  Time_routine('swStr.StrToSList(SC)',true);
end;

function StrToSList(S:string):TStringList;
begin

result := StrToSList(S,[#10,#13]);

end;


procedure SLSWAP(SL:TStrings);
var S : string; N, I, I1, I2 : integer; SL2 : TStringList;
begin

  SL2 := TStringList.Create;

  N := SL.Count;
  for I := 1 to N do begin
    I1 := I-1;
    I2 := N-I;
    SL2.Add(SL.Strings[I2]);
  end;
  SL.Clear;
  for I := 0 to SL2.Count do SL.Add(SL2.Strings[I]);
  SL2.Clear;

{
  for I := 1 to (N div 2) do begin
    I1 := I-1;
    I2 := N-I;
    S  := SL.Strings[I1];
    SL.Strings[I1] := SL.Strings[I2];
    SL.Strings[I2] := S;
  end;
}
end;


function SListToStr(SL:TStrings):string;
var S,D : string; I,N : integer;
begin
  S := '';
  if Assigned(SL) then begin
    N := SL.Count;
    if N > 1000 then begin
      WarnAbs('Проверьте программу! SListToStr не должен вызываться '+#13#10+
      'для списка из '+ISt(N)+ ' строк!');
      N := 1000;
    end;
    for I := 0 to N-1 do begin
      S := S + D + SL.Strings[I];
      D := #13#10;
    end;
  end;
  result := S;
end;


function SListList(SL:TStrings):string;
var S,D : string; I,N : integer;
begin
  S := ''; D := '';
  if Assigned(SL) then begin
    N := SL.Count;
    if N > 1000 then begin
      WarnAbs('Проверьте программу! SListList не должен вызываться '+#13#10+
      'для списка из '+ISt(N)+ ' строк!');
      N := 1000;
    end;
    for I := 0 to SL.Count-1 do begin
      S := S + D + ISt(I)+' <'+SL.Strings[I]+'>';
      D := #13#10;
    end;
  end;
  result := S;
end;



function StringsToSL(SL0:TStrings):TStringList;
var I : integer; SL : TStringList;
begin
  if (Not Assigned(SL0)) then begin result:=NIL; Exit end;
  SL := TStringList.Create;
  for I := 0 to SL0.Count-1 do SL.Add(SL0.Strings[I]);
  result := SL;
end;
{
function SLTop(SL0:TStrings;N1:integer):TStringList;
var I : integer; SL : TStringList;
begin
  if (Not Assigned(SL0)) then begin result:=NIL; Exit end;
  SL := TStringList.Create;
  for I := 0 to N1-1 do SL.Add(SL0.Strings[I]);
  result := SL;
end;
}

procedure SLtoStrings(var SS:TStrings;SL:TStringList);
var I : integer;
begin
  if Not Assigned(SS) then begin
    WarnAbs('SLtoStrings ERR: Strings Not Assigned!'); Exit; end;
  if Not Assigned(SL) then begin
    WarnAbs('SLtoStrings ERR: StringList Not Assigned!'); Exit; end;
  for I := 0 to SL.Count-1 do SS.Add(SL.Strings[I]);
end;




function SListAdd(SL1,SL2:TStringList):TStringList;
var I : integer;
begin
  if (Not Assigned(SL1)) then begin result:=SL2; Exit end;
  if (Not Assigned(SL2)) then begin result:=SL1; Exit end;
  for I := 0 to SL2.Count-1 do SL1.Add(SL2.Strings[I]);
  result := SL1;
end;
{
procedure SListAddProc(var SL1:TStringList;SL2:TStringList);
var I : integer;
begin
  for I := 0 to SL2.Count-1 do SL1.Add(SL2.Strings[I]);
end;
}


function SListAdd(SL1,SL2:TStrings):TStrings;
var I : integer;
begin
  if (Not Assigned(SL1)) then begin result:=SL2; Exit end;
  if (Not Assigned(SL2)) then begin result:=SL1; Exit end;
  for I := 0 to SL2.Count-1 do SL1.Add(SL2.Strings[I]);
  result := SL1;
end;


(* вкл/выкл спец символа Ch в конце строки, к-рая включает в себя sTpl *)
procedure SLOnOffChar(SL:TStrings;STpl:string;Ch:char;Q:boolean);
var I,IP : integer; SL2 : TStringList; S : string; QFind : boolean;
begin
  if Not Assigned(SL) then begin
    WarnAbs('swStr.SLOnOffChar ERR: SL Not Assigned!');
    Exit;
  end;
  if SL.Count = 0 then begin
    WarnAbs('swStr.SLOnOffChar ERR: SL.Count=0!');
    Exit;
  end;
  QFind := false;

  (* пробегаем по всем строкам     *)
  (* ищем в строках подстроку STpl *)
  for I := 0 to SL.Count-1 do begin
    IP := pos(sTpl,SL.Strings[I]);
    if IP > 0 then begin
      QFind := true;
      S := SL.Strings[I];
      IP := PosR(Ch,S);
      if Q then begin // добавляем
        if IP = 0 then S := S + Ch
                  else ;  // сохраняем
      end
      else begin // удаляем
        if IP > 0 then S := copy(S,1,IP-1)
                  else ;  // нечего удалять
      end;
      SL.Strings[I] := S;
    end;
  end;

  if Not QFind then begin
    WarnAbs('swStr.SLOnOffChar ERR: не найдена подстрока <'+sTpl+'>!');
  end;
end;



procedure SLStripLineComm(SL:TStringList;sCommBeg:string);
var I,IP : integer; SL2 : TStringList;
begin
  if Not Assigned(SL) then Exit;
  SL2 := TStringList.Create;
  for I := 0 to SL.Count-1 do begin
    IP := pos(sCommBeg,SL.Strings[I]);
    if IP > 0 then begin
      if IP = 1 then SL2.Add('')
                else SL2.Add(copy(SL.Strings[I],1,IP-1));
      end
      else SL2.Add(SL.Strings[I]);
  end;
  SL.Clear;
  for I := 0 to SL2.Count-1 do SL.Add(SL2.Strings[I]);
  SL2.Clear;
end;

procedure SLStripMultiComm(SL:TStringList;sCommBeg,sCommEnd:string);
var I,J,IP1,IP2,L2 : integer;
 QComm : boolean;
 S : string;
 SL2 : TStringList;
begin
  if Not Assigned(SL) then Exit;

  QComm := false;

  SL2 := TStringList.Create;

  for I := 0 to SL.Count-1 do begin

    if QComm then begin  (* вошли в строку с QComm = true *)
      IP2 := pos(sCommEnd,SL.Strings[I]);
      if IP2 = 0 then begin
        (* комментарий не кончился *)
 //     SL.Strings[I] := '';
        SL2.Add('');
      end
      else begin
        QComm := false;  (* комментарий кончился *)
        L2 := IP2+length(sCommEnd)-1;
        if L2 = length(SL.Strings[I])
//      then SL.Strings[I] := ''
        then SL2.Add('')
        else begin
          S := SL.Strings[I];
          for J := 1 to L2 do S[J] := ' ';
//        SL.Strings[I] := S;
          SL2.Add(S);
        end;
      end;
    end;

    if Not QComm then begin
      IP1 := pos(sCommBeg,SL.Strings[I]);
      if IP1 = 0 then SL2.Add(SL.Strings[I]);
      while IP1 > 0 do begin
        (* стразу поищем окончание комментария *)
        IP2 := PosP(sCommEnd,SL.Strings[I],IP1+length(sCommBeg));
        if IP2 > 0 then begin
          L2 := IP2+length(sCommEnd)-1;
          if L2 = length(SL.Strings[I])
          then begin
            if IP1 = 1
//          then SL.Strings[I] := ''
//          else SL.Strings[I] := copy(SL.Strings[I],1,IP1-1);
            then SL2.Add('')
            else SL2.Add(copy(SL.Strings[I],1,IP1-1));
          end
          else begin
            S := SL.Strings[I];
            for J := 1 to L2 do S[J] := ' ';
//          SL.Strings[I] := S;
            SL2.Add(S);
          end;
          IP1 := 0; IP2 := 0;
          IP1 := pos(sCommBeg,SL.Strings[I]);
        end
        else begin
          (* есть начало комментария и нет конца *)
          if IP1 = 1
//          then SL.Strings[I] := ''
//          else SL.Strings[I] := copy(SL.Strings[I],1,IP1-1);
            then SL2.Add('')
            else SL2.Add(copy(SL.Strings[I],1,IP1-1));
          IP1 := 0;
          QComm := true; (* далее - строки комментария *)
        end;
      end;  (* while - конец обработки комментария внутри строки *)

    end;

  end;  (* for I *)

  SL.Clear;
  for I := 0 to SL2.Count-1 do SL.Add(SL2.Strings[I]);
  SL2.Clear;


end;


procedure SLCopy(SLSrc,SLDst:TStrings);
var I : integer;
begin
  if Not Assigned(SLSrc) then begin
    WarnAbs('SLCopy-err: StringList - источник Not Assigned!');
    Exit;
  end;
  if Not Assigned(SLDst) then begin
    WarnAbs('SLCopy-err: StringList - приёмник Not Assigned!');
    Exit;
  end;
  (* SLDst должен быть создан в вызывающей процедуре!!!!! *)
  for I := 0 to SLSrc.Count-1 do SLDst.Add(SLSrc.Strings[I]);
end;

procedure SLRePlace(SLSrc,SLDst:TStrings);
var I : integer;
begin
  if Not Assigned(SLSrc) then begin
    WarnAbs('SLRePlace-err: StringList - источник Not Assigned!');
    Exit;
  end;
  if Not Assigned(SLDst) then begin
    WarnAbs('SLRePlace-err: StringList - приёмник Not Assigned!');
    Exit;
  end;
  (* SLDst должен быть создан в вызывающей процедуре!!!!! *)
  SLDst.Clear;
  for I := 0 to SLSrc.Count-1 do SLDst.Add(SLSrc.Strings[I]);
end;



procedure SLCopy(SLSrc,SLDst:TStrings;J1,J2:integer);
var I : integer; S : String;
begin
  if Not Assigned(SLSrc) then Exit;
  if Not Assigned(SLDst) then Exit;
  (* SLDst должен быть создан в вызывающей процедуре!!!!! *)
  if J1 > J2 then Swap(J1,J2);

  if J1 < 0 then begin
//  WArnAbs('swStr.SLCopy J1='+ISt(J1)+' => 0');
    J1 := 0;
  end;

  if (J2 > (SLSrc.Count-1)) then begin
//  WArnAbs('swStr.SLCopy J2='+ISt(J2)+' => '+ISt(SLSrc.Count-1));
    J2 := SLSrc.Count-1;
  end;

  for I := J1 to J2 do begin
    SLDst.Add(SLSrc.Strings[I]);
  end;

//WarnAbs('SLCopy '+ISt(J1)+' '+ISt(J2)+' => '+ISt(SLDst.Count));
end;

(* скопировать фрагмент от s1 (первое вхождение) *)
(*   до s2 (первое вхождение после s1)           *)
(* s1 = '' - от начала; s2 = '' - до конца       *)
procedure SLCopy(SLSrc,SLDst:TStrings;s1,s2:string);
var I,J1,J2 : integer; S : String;
begin
  if Not Assigned(SLSrc) then Exit;
  if Not Assigned(SLDst) then Exit;
  (* SLDst должен быть создан в вызывающей процедуре!!!!! *)

  if s1 = '' then J1 := 0
             else begin
               J1 := swStr.SLFindSubString(s1,SLSrc);
               if J1 < 0 then Exit;
             end;

  if s2 = '' then J2 := SLSrc.Count-1
             else begin
               J2 := swStr.SLFindSubString(s2,J1,SLSrc);
               if J2 < 0 then J2 := SLSrc.Count-1
             end;

  for I := J1 to J2 do begin
    SLDst.Add(SLSrc.Strings[I]);
  end;
end;





procedure SLUnTab(SL:TStrings); (* развернуть табуляции в пробелы *)
var J : integer; SL2 : TStringList;
begin
  if Not Assigned(SL) then Exit;
  SL2 := TStringList.Create;
  for J := 0 to SL.Count-1 do SL2.Add(UnTab(SL.Strings[J]));
  SL.Clear;
  for J := 0 to SL2.Count-1 do SL.Add(SL2.Strings[J]);
  SL2.Clear;
end;

procedure SLUnTab(SL:TStrings;J1,J2:integer);(* развернуть табуляции в пробелы*)
var J : integer;
const ChTab = #9;
begin
  if Not Assigned(SL) then Exit;
  if J2 > SL.Count then J2 := SL.Count;
  if J2 < J1 then Exit;
  for J := J1-1 to J2-1 do
  begin
    if pos(ChTab,SL.Strings[J])>0 then
      SL.Strings[J] := UnTab(SL.Strings[J]);
  end;
end;



function CompareSL(SL1,SL2:TStrings):integer;
var I,L,L1,L2 : integer;
begin
  L1 := SL1.Count;
  L2 := SL2.Count;
  if L1 < L2 then L := L1-1 else L := L2-1;
  for I := 0 to L do begin
    if SL1.Strings[I] < SL2.Strings[I] then begin result :=  1; Exit end;
    if SL2.Strings[I] < SL1.Strings[I] then begin result := -1; Exit end;
  end;
  if L1 < L2 then begin result :=  1; Exit end;
  if L2 < L1 then begin result := -1; Exit end;
  result := 0;
end;


function FindStrings(S:string;SL:TStrings):integer;
var I : integer; S0 : string;
begin
  result := -1;
  if Not Assigned(SL) then Exit;
  for I := 0 to SL.Count-1 do begin
    S0 := SL[I]; //   Strings.  [I];
    if S0 = S then begin result := I; Exit end;
  end;
end;


function SLMerge(SL1,SL2:TStrings):TStringList;
var I : integer; SL : TStringList;
begin
  SL := TStringList.Create;
  if Not Assigned(SL1) then SLCopy(SL2,SL) else begin
    SLCopy(SL1,SL);
    if Assigned(SL2) then begin
      for I := 0 to SL2.Count-1 do begin
        if (FindStrings(SL2.Strings[I],SL) < 0)
          then SL.Add(SL2.Strings[I]);
      end;
    end;
  end;
  result := SL;
end;


function SLFindString(S:string;SL:TStrings):integer;
var I : integer; S0 : string;
begin
  result := -1;
  if Not Assigned(SL) then Exit;
  for I := 0 to SL.Count-1 do begin
    S0 := SL[I]; //   Strings.  [I];
    if S = S0 then begin result := I; Exit end;
  end;
end;


function SLFindSubString(S:string;SL:TStrings):integer;
var I : integer; S0 : string;
begin
  result := -1;
  if Not Assigned(SL) then Exit;
  for I := 0 to SL.Count-1 do begin
    S0 := SL[I]; //   Strings.  [I];
    if pos(S,S0) > 0 then begin result := I; Exit end;
  end;
end;

function SLFindSubString(S:string;J1:integer;SL:TStrings):integer;
var I : integer; S0 : string;
begin
  result := -1;
  if Not Assigned(SL) then Exit;
  for I := J1 to SL.Count-1 do begin
    S0 := SL[I]; //   Strings.  [I];
    if pos(S,S0) > 0 then begin result := I; Exit end;
  end;
end;



function SLFindStringHead(S:string;SL:TStrings):integer;
var I : integer; S0 : string;
begin
  result := -1;
  if Not Assigned(SL) then Exit;
  for I := 0 to SL.Count-1 do begin
    S0 := SL[I]; //   Strings.  [I];
    if pos(S,S0) = 1 then begin
      result := I; Exit
    end;
  end;
end;


(* сравнивать слово в начале строки *)
(* если есть знак "=" - отсекать по нему *)
function SLFindStringHeadWd(S:string;SL:TStrings):integer;
var I : integer; S0,S1 : string;
begin
  result := -1;
  if Not Assigned(SL) then Exit;
  for I := 0 to SL.Count-1 do begin
    S0 := SL[I]; //   Strings.  [I];
    S1 := GetWordN(S0,1);
    S1 := left(S1,'=');
    if (S = S1) then begin
      result := I; Exit
    end;
  end;
end;




function SLFindStringHeadL(S:string;L:integer;SL:TStrings):integer;
var I : integer; S0 : string;
begin
  result := -1;
  if Not Assigned(SL) then Exit;
  for I := 0 to SL.Count-1 do begin
    S0 := SL[I]; //   Strings.  [I];
    if pos(S,S0) = 1 then begin
      if Trim(swStr.left(S0,L)) = S then begin
        result := I; Exit
      end;
    end;
  end;
end;



function SLCutStringHeadL(S:string;J0,L:integer;var SL:TStrings):integer;
var I : integer; S0 : string;
begin
  result := -1;
  if Not Assigned(SL) then Exit;
  for I := SL.Count-1 downto J0 do begin
    S0 := SL[I]; //   Strings.  [I];
    if pos(S,S0) = 1 then begin
      if Trim(swStr.left(S0,L)) = S then begin
        SL.Delete(I);
      end;
    end;
  end;
end;





function SLFindStringHead(S,sDiv:string;SL:TStrings):integer; 
var I : integer; S0 : string;
begin
  result := -1;
  if Not Assigned(SL) then Exit;
  for I := 0 to SL.Count-1 do begin
    S0 := Trim(left(SL[I],sDiv));//отбрасываем всё, начиная с разделителя sDiv
    if (S = S0) then begin result := I; Exit end;
  end;
end;



(* в комбобоксах пустые строки содержат 1 пробел! *)
function FindTrimmedStrings(S:string;SL:TStrings):integer;
var I : integer; S0 : string;
begin
  result := -1;
  if Not Assigned(SL) then Exit;
  S := trim(S);
  for I := 0 to SL.Count-1 do begin
    S0 := trim(SL[I]); //   Strings.  [I];
    if S0 = S then begin result := I; Exit end;
  end;
end;



(*----------------------------------------------------------*)
(*  ПРОЦЕДУРЫ, заменяющие аналоги из SysUtils               *)
(*----------------------------------------------------------*)

function UpCase(ch: char): char;
begin
  if (ch in ['a'..'z', 'а'..'я'])
  then result := chr(ord(ch) - 32)
  else result := ch;
end;

function DownCase(ch: char): char;
begin
  if (ch in ['A'..'Z', 'А'..'Я'])
  then result := chr(ord(ch) + 32)
  else result := ch;
end;



(* trim из SysUtils удаляет также CRLF и Tab !!! *)
function trim0(const S:string):string;
var J1, J2 : integer;
begin
  J1 := 1;         while (J1 <= length(S)) and (S[J1]=' ') do inc(J1);
  J2 := length(S); while (J2 > J1)         and (S[J2]=' ') do dec(J2);
  if J2 >= J1 then Result := copy(S,J1,J2-J1+1) else Result := '';
end;










function AsciiZ2Str(var AZ):string;
  var A : array [1..257] of char absolute AZ;
      S : string;
      i : integer;
  begin
    i := 1;
    while (A[i] <> #0) and (i<255) do begin
//    S[i] := A[i];
      inc(i);
    end;
    dec(i);
    SetLength(S,i);
    move(A[1],S[1],i);
    AsciiZ2Str := S;
  end;

(*
function ASCIIZLength(var A) : Word;
  begin
  {-Return the length of an Asciiz string}
//  inline
  asm
  ($5F/                      {pop  di       ;get pointer to ASCIIZ}
    $07/                     {pop  es       ; into es:di}
    $89/$FB/                 {mov  bx,di    ;store initial offset}
    $B9/$FF/$FF/             {mov  cx,$FFFF ;check maximum length}
    $B0/$00/                 {mov  al,0     ;look for null}
    $FC/                     {cld           ;forward direction}
    $F2/                     {repne}
    $AE/                     {scasb         ;scan while equal}
    $29/$DF/                 {sub  di,bx    ;get the number of bytes scanned}
    $89/$F8/                 {mov  ax,di    ;return in ax}
    $48);                    {dec  ax       ;null doesn't count}
  end;
*)


function HTML_ENTITIEStoWideString(S:string):WideString;
var N,I,K,IErr : integer;
   ss : string;
   Ch : char;
   W  : word;
   QA : boolean;
   QN : boolean;
   WS : WideString;
   S2 : string;
   W2 : WideString;
begin
  (* &#12467;&#12531;  - пример HTML_ENTITIES кода *)
  result := '';
  N := length(S); if N = 0 then Exit;
  SetLength(W2,1);
  SetLength(S2,1);
  QA := false;       (* только что миновали амперсанд *)
  QN := false;       (* мы выбираем цифры для &# конструкции *)
  SetLength(WS,N*2); (* отводим память с запасом      *)
  K := 1;            (* счетчик WideChar - символов   *)
  ss := '';    (* готовим подстроку для сбора цифр *)
  for I := 1 to N do begin
    Ch := S[I];
    if (Ch = '&') and (Not QA) and (Not QN) then begin
      QA := true;  (* включаем ожидание диеза          *)
    end else
    if (Ch = '#') and QA then begin (* после амперсанда должен следовать диез *)
      QN := true;
      QA := false;
    end else
    if (Ch in SetDig) and QN then begin
      ss := ss + Ch;      (* добавим цифру в подстроку *)
    end else
    if (Ch = ';') and QN then begin (* конец WideChar - заносим его в Wide строку *)
      QN := false;
      Val(ss,W,IErr);
      ss := '';    (* готовим подстроку для сбора цифр *)
      if IErr > 0 then Exit; (* НЕ МОЖЕТ ТАКОГО БЫТЬ *)
      WS[K] := WideChar(W);
      inc(K);      (* следующий WideChar               *)
    end
    else begin
      (* попался "обычный" символ, переводим его ANSI => WIDECHAR *)
      S2[1] := Ch;
      MultiByteToWideChar( CP_ACP, 0, PChar(S2), 1, PWideChar(W2), 2);
      WS[K] := W2[1];
      inc(K);      (* следующий WideChar               *)
    end;
  end; (* for I *)
  dec(K);
  SetLength(WS,K);        (* усекаем строку *)
  result := WS;
  W2 := ''; S2 := ''; ss := '';
end;

function WideStringToHex(SW:WideString):string;
var I,J,N : integer; S : string;
  WC : WideChar; B2 : packed array[1..2] of byte absolute WC;
begin
  N := length(SW);
  SetLength(S,4*N);
  J := 0;
  for I := 1 to N do begin
    WC := SW[I];
    inc(J); S[J] := hexChars[B2[2] shr 4];
    inc(J); S[J] := hexChars[B2[2] and $F];
    inc(J); S[J] := hexChars[B2[1] shr 4];
    inc(J); S[J] := hexChars[B2[1] and $F];
  end;

  Result := S;
end;

function HexToWideString(S:string):WideString;
var I,J,J1,K,N : integer; SW : WideString; Ch : char;
  WC : WideChar; W : word absolute WC;
begin
  N := length(S) div 4;
  SetLength(SW,N);
  J1 := 1;
  for I := 1 to N do begin
    W := 0;
    for J := J1 to (J1 + 3) do begin
      Ch := S[J];
      if Ch <= '9' then K := Ord(Ch) - Ord('0')
                   else K := Ord(Ch) - Ord('A') + 10;
      W := W * 16 + K;
    end;
    J1 := J1 + 4;
    SW[I] := WC;
  end;
  Result := SW;
end;

function HexB(B:byte):string;
begin HexB:=hexChars[B shr 4]+hexChars[B and $F]; end;

(* представление байта в виде двоичной строки *)
function BinB(B:byte):string;
begin BinB := BinStr[B shr 4]+BinStr[B and $F]; end;

function BinW(W:word):string;
begin BinW := BinB(Hi(W))+BinB(Lo(W)) end;

(* представление в виде двоичной строки *)
function BinL(L:longint):string;
var B4 : array [1..4] of byte absolute L;
begin
  BinL:=BinB(B4[4])+BinB(B4[3])+BinB(B4[2])+BinB(B4[1]);
end;

function Bin_L(L:longint):string;
var B4 : array [1..4] of byte absolute L;
begin
  Bin_L:=BinB(B4[4])+'_'+BinB(B4[3])+'_'+BinB(B4[2])+'_'+BinB(B4[1]);
end;


function HexW(W:word):string;
begin HexW:=HexB(Hi(W))+HexB(Lo(W)) end;

function HexA(var V):string;                (* адрес переменной *)
type PtrRec = record O,S : word end;
var A : PtrRec;
    P : pointer absolute A;
begin
  P := @V;
  HexA := '$'+HexW(A.S)+':'+HexW(A.O);
end;

function HexP(var V):string;                (* содержимое указателя *)
type PtrRec = record O,S : word end;        (* или адреса процедуры *)
var A : PtrRec absolute V;
begin
  HexP := '$'+HexW(A.S)+':'+HexW(A.O);
end;

function HandleToStr(var V):string;
var S : string;
begin
  if (DWORD(V) = Windows.INVALID_HANDLE_VALUE) then
                   S := 'INVALID_HANDLE_VALUE' else
  S := 'hAdr='+HexL(DWORD(V))+'_hVal='+HexP(V);
  result := S;
end;


(* сформировать из байтововго буфера *)
(* строки для 16-ричного редактора   *)
function HexBuf(var Buf;N:integer):TStringList;
const NCtrlChars = 16;
var BB : array[1..MaxInt] of byte absolute Buf;
  B : byte; Ch : char; I : integer;
  S1, S2 : string;
  SL : TStringList;
begin
  SL := TStringList.Create;
  S1 := ''; S2 := '';
  for I := 1 to N do begin
    B := BB[I]; if B < NCtrlChars then Ch := '.' else Ch := char(B);
    S1 := S1 + HexB(B); S2 := S2 + Ch;
    if (I mod  2) = 0 then S1 := S1 + ' ';
    if (I mod 16) = 0 then begin SL.Add(S1+'  '+S2); S1 := ''; S2 := ''; end;
  end;
  if S1 <> '' then SL.Add(S1+'  '+S2);
  result := SL;
end;

(* сформировать из байтововго буфера строки *)
(* для 16-ричного редактора с адресами,     *)
(* которые отсчитываются от Offset          *)
function HexBuf(var Buf;N:integer;Offset:Int64):TStringList; overload;
const NCtrlChars = 16;
type
  T_Int64DW = packed record Lo,   Hi    : DWORD; end;
  T_Int64W  = packed record W4,W3,W2,W1 :  WORD; end;
var BB : array[1..MaxInt] of byte absolute Buf;
  B : byte; Ch : char; I : integer;
  Sa, S1, S2 : string;
  SL : TStringList;
  Of2 : T_Int64DW absolute Offset;
  Of4 : T_Int64W  absolute Offset;
begin
  SL := TStringList.Create;
  S1 := ''; S2 := '';
  for I := 1 to N do begin
    B := BB[I];
    if B < NCtrlChars then Ch := '.' else Ch := char(B);
    S1 := S1 + HexB(B); S2 := S2 + Ch;
    if (I mod 2) = 0 then S1 := S1 + ' ';
    if (I mod 16) = 0 then begin
      if Of2.Hi <> 0 then Sa := HexW(Of4.W1)+'-'+HexW(Of4.W2)+' '
                     else Sa := '';
      Sa := Sa + HexW(Of4.W3)+'-'+HexW(Of4.W4)+':  ';
      SL.Add(Sa+S1+'  '+S2); S1 := ''; S2 := '';
      Offset := Offset + 16;
    end;
  end;
  if S1 <> '' then SL.Add(S1+'  '+S2);
  result := SL;
end;


(* числовую переменную произвольной длины -> Hex *)
function IntToHex(var I;D:integer):string;
var S : string; K : integer; BA : array[1..32767] of byte absolute I;
begin
  S := '';
  for K := 1 to ((D+1) div 2) do S := HexB(BA[K]) + S;
  if D mod 2 = 1 then S := copy(S,2,Length(S)-1);
  Result := S;
end;


(* вывести номера установленных битов в 4-х байтовом слове *)
function SNBitsL(L:longint):string;
var I : integer; S : string;
begin
  S := '';
  for I := 0 to 31 do if IsBit(L,I) then S := S + ' ' + ISt(I);
  result := StripBlanks(S);
end;

{
function IntToStr(I:int64):string;
var S : string;
begin Str(I,S); Result := S end;
}

{
function ISt(I:longint):string;             (* ЦЕЛОЕ В СТРОКУ *)
//begin FmtStr(Result, '%d', [I]) end;
var S : string;
begin Str(I,S); Result := S end;
}

function ISt(I:integer):string;
begin
  result := IntToStr(I);          (* I : integer    *)
end;

function ISt(I:int64):string;     (* ЦЕЛОЕ В СТРОКУ *)
begin
  result := IntToStr(I);          (* I : Int64      *)
end;

function ISt(R:real):string;
begin
  result := IntToStr(round(R));
end;

(* убрать незначащие нули из строки, похожей на десятичное число *)
function TrimR0(S:string):string;
var P,PE : integer; S1 : string; I : integer;
begin
  P  := pos('.',S); if P = 0 then begin result := S; Exit; end;
  PE := posP('E',S,P); if PE = 0 then PE := posP('e',S,P); (* 1.10e-03 *)
                       if PE = 0 then PE := posP('+',S,P); (* 1.10+12  *)
                       if PE = 0 then PE := posP('-',S,P);
  if PE > 0 then S1 := RightFrom(S,PE) else S1 := '';
  if PE > 0 then I := PE - 1 else I := length(S);
  while (I > 1) and (S[I] = '0') do dec(I);
  if I <> length(S) then S := copy(S,1,I);
  result := S + S1;
end;


(* с заданным числом цифр после запятой *)
(*  ведущий 0 удаляем                   *)
function FSt(R:real;D:integer):string;
var N,I : integer; K : int64; E: real; S : string;
begin
  if ABS(R) > High(int64) then begin
    result := ESt(R,D);
    Exit;
  end;

  E := 1; for I := 1 to D do E := E/10; // незначащая величина

  K := ABS(ROUND(R));
  N := 0;
  while K > 0 do begin
    inc(N);
    K := K div 10;
  end;

  if R<0 then if ABS(R) < E/2 then R := 0; // чтобы не получался -0.00

  if D >= 0
  then Str(R:N:D,S)
  else begin
    if R = 0 then S := '0' else begin
      for I := 1 to -D do R := R/10;
      S := ISt(R);
      for I := 1 to -D do S := S+'0';
    end;
  end;

//if N = 0 then S := rightfrom(S,2)

  if (S[1] = '0') and (length(S) > 1) then S := rightfrom(S,2);
//if R < 0 then S := '-'+S;

  result := S;
end;


(* вариант FSt0 для случая, когда мы имеем более 4-х *)
(* нулей после или перед крайней значащей цифрой     *)
(* RR обязан быть кратным 10                         *)
function FESt0(R,RR:real;D:integer):string;
var S,SP : string; N,I : integer;
begin
  RR := RR/10; D := D-1;
  R := R/RR;
  S := FSt(R,D);
  SP := ESt(RR,1);
  N := length(SP);
  I := 1;
  while (Not (SP[I] in ['+','-'])) and (I < N) do inc(I);
  result := S+'e'+RightFrom(SP,I);
end;


function FESt0(R:real;D:integer):string;
var Q0 : boolean;
begin
  Q0 := false;
  result := FESt0(R,D,Q0);
end;


function FESt0(R:real;D:integer;Q0:boolean):string;
var RR : real; I,N,K : integer; S : string;
begin
  RR := 1;
  if D < -4 then begin
    for I := 0 downto D do RR := RR * 10;
    result := FESt0(R,RR,1);
  end
  else
  if D > 4 then begin
    S := FSt(R,D);
    (* подсчитаем число нулей в S *)
    N := length(S);
    I := 1;
    if S[I] = '-' then inc(I);
    if S[I] = '0' then inc(I);
    while (S[I] in ['.','-']) and (I < N) do inc(I);
    K := 0;
    while (S[I] = '0') and (I < N) do begin inc(I); inc(K); RR := RR / 10 end;
    result := FESt0(R,RR,D-K);
  end
  else
  if Q0 then result := FSt0(R,D) else result := FSt(R,D);
end;


(* с заданным числом цифр после запятой *)
(*  ведущий 0 НЕ удаляем !              *)
function FSt0(R:real;D:integer):string;
var N,I : integer; K : int64; E: real; S : string;
begin
  if ABS(R) > High(int64) then begin
    result := ESt(R,D);
    Exit;
  end;

  E := 1;  for I := 1 to D do E := E/10; // незначащая величина

  K := ABS(ROUND(R));
  N := 0;
  while K > 0 do begin
    inc(N);
    K := K div 10;
  end;

  if R<0 then if ABS(R) < E/2 then R := 0; // чтобы не получался -0.00

  if D >= 0
  then Str(R:N:D,S)
  else begin
    if R = 0 then S := '0' else begin
      for I := 1 to -D do R := R/10;
      S := ISt(R);
      for I := 1 to -D do S := S+'0';
    end;
  end;

  result := S;
end;



function FStN(R:real;N:integer):string;     // N значащих цифр
var Q0 : boolean;
begin
  Q0 := false;
  result := FStN(R,N,Q0);
end;


(* с заданным числом значащих цифр *)
(* длина строки зависит от знака и незначащих нулей в начале или конце *)
(* Q0 задает ведущий ноль *)
function FStN(R:real;N:integer;Q0:boolean):string;
var NN,N1,N0,D : integer; K0,K : int64; S : string; RR : real;
begin
  RR := ABS(R);
  if RR > High(int64) then begin
    result := ESt(R,N);
    Exit;
  end;

  K  := ROUND(RR); K0 := K;

  (* N1 - число значащих цифр в целой части *)
  N1 := 0;
  while K > 0 do begin
    inc(N1);
    K := K div 10;
  end;

  if N1 >= N then begin    (* степень числа > числа запрошенных цифр *)
    (* выводим как целое с макс.точностью *)
    S := ISt(K0); if R < 0 then result := '-'+S else result := S;
  end else
  if N1 > 0 then begin
    D := N - N1;           (* теперь D - число цифр после точки *)
    NN := N1 + 1 + D;      (* цифр до точки + точка + цифр после точки *)
    if R < 0 then inc(NN); (* + 1 позиция на знак                      *)
    result := FSt(R,NN,D);
  end
  else begin                (* в целой части 0 значащих цифр *)
    if R = 0 then begin
      NN := N; if NN < 2 then NN := 2;
      result := FSt(R,NN,NN-2); (* NN=2 => '0.' *)
    end
    else begin             (* абс.величина числа > 0, но < 1 *)
      N0 := -1;
      while RR < 1 do begin
        RR := RR * 10;
        inc(N0);            (* N0 число нулей ПОСЛЕ точки *)
      end;
      D  := N0 + N;         (* + значащие цифры *)
      NN := D  + 1;         (* + точка          *)
      if R < 0 then inc(NN);(* + знак           *)
      if Q0 then inc(NN);   (* + ведущий 0      *)
      result := FSt(R,NN,D);
    end;
  end;
end;



function FSt(R:real;N,D:integer):string;
var I0,I,K,L,L0,NN : integer; RD : real; S,S0 : string;
begin

  Str(R:N:D,S);  (* N позиций в строке, D цифр после запятой *)
  result := S;
  exit;

  RD := 1;
  for I := 1 to D do RD := RD * 10;

  I0 := Round(R*RD);
  S0 := NumStr(I0,N+D);
  if D > 0 then begin
    result := copy(S0,1,N) + '.' + copy(S0,N+1,D);
  end
  else result := S0;

  Exit;

(*===================================*)

  NN := N - D - 1;
  I := Trunc(R);
  S0 := IntToStr(I);
  L := length(S0);
  SetLength(S,NN);
  if L < NN then begin
    L0 := NN - L + 1;
    move(S0[1],S[L0],L);
    FillChar(S[1],L0-1,' ');
  end
  else begin
    L0 := L - NN + 1;
    move(S0[L0],S[1],NN);
    if NN > L then S[1] := '*';
  end;
  S := S + '.';
  if D = 0 then begin
    result := S;
    Exit;
  end;

  R := R - I;
  for K := 1 to D do begin
    R := R * 10;
  end;

  I := Trunc(R);

  result := S + NumStr(I,D);
end;


function NumStr(I:longint;D:integer):string;(*ЦЕЛОЕ В СТРОКУ С ВЕДУЩИМИ НУЛЯМИ*)
var S : string;
begin
  if I < 0 then I := -I; Str(I,S);
  if length(S) > D  then S := copy(S,length(S)-D+1,D);
  while length(S) < D do S := '0'+S;
  NumStr := S;
end;


{
function NSt(I:longint;D:integer):string;(*ЦЕЛОЕ В СТРОКУ С ВЕДУЩИМИ ПРОБЕЛАМИ*)
var S : string;
begin
  if I < 0 then I := -I; Str(I,S);
  if length(S) > D  then S := copy(S,length(S)-D+1,D);
  while length(S) < D do S := ' '+S;
  NSt := S;
end;
}
function NSt(I:Int64;D:integer):string;(*ЦЕЛОЕ В СТРОКУ С ВЕДУЩИМИ пробелами*)
var S : string; QMinus : boolean;
begin
  if I < 0 then begin I := -I; QMinus := true end else QMinus := false;
  Str(I,S);
  if length(S) > D  then S := copy(S,length(S)-D+1,D);
  if (length(S) < D) and QMinus then S := '-' + S;
  while length(S) < D do S := ' '+S;
  NSt := S;
end;

function RSt(R:real):string; overload;
var S : string;
begin
  Str(R,S);
  result := S;
end;

function RSt(R:real;N:integer):string;  overload;
var S : string;
begin
  Str(R:N,S);
  result := S;
end;


{
(* расширение процедуры VAL на случай обработки формата ESt *)
procedure ValE(S:string;var R:real;var IErr:integer);
var QE : boolean; L,I,PP,PPM : integer;
begin
  L := length(S);
  for I := 1 to L do if Not (S[I] in ['0'..'9','-','+','.','E','e'])
  then begin R := 0; IErr := I; Exit; end;

  QE := false;
  PP := pos('.',S);
  if PP > 0 then begin
    PPM := posp('-',S,PP);
    if PPM = 0 then PPM := posp('+',S,PP);
    if PPM > 0 then begin
      QE := true;
      if pos('e',S) > 0 then QE := false else
      if pos('E',S) > 0 then QE := false;
    end;
  end;

  if QE then re

end;
}


function EFSt(R:real;N:integer):string;  (* наиболее короткое из ESt/FSt *)
var SF,SE : string;
begin
  if N < 2 then begin
    WarnAbs('Подозрительный вызов EFSt - требуется '+ISt(N)+
    ' значащих цифр!'+#13#10+
    'R='+RSt(R));
  end;
  SF := FStN(R,N);
  SE := ESt (R,N);
  if length(SE) < length(SF) then result := SE else result := SF
end;


function EFSt0(R:real;N:integer):string;  (* наиболее короткое из ESt/FSt *)
var Q0 : boolean;
begin
  Q0 := false;
  result := EFSt0(R,N,Q0);
end;

function EFSt0(R:real;N:integer;Q0:boolean):string;
(* наиболее короткое из ESt/FSt *)
(* при условия удаления незначащих нулей *)
var SF,SE : string;
  PP,PM,P,NP : integer;
begin
  SF := FStN(R,N,Q0);
  (* если SF содержит точку, удаляем все крайние правые нули *)
  NP := pos('.',SF);
  if NP > 0 then begin
    while SF[length(SF)] = '0' do SF := copy(SF,1,Length(SF)-1);
    if NP = length(SF) then SF := copy(SF,1,Length(SF)-1); (* если . крайняя *)
  end;

  SE := ESt (R,N);
  PP := PosR('+',SE);
  PM := PosR('-',SE);
  if PP > PM then P := PP     (* PP > 0 *)
             else P := PM;    (* PM > 0 *)

  if P > 0 then begin         (* нашелся "+" или "-" *)
    dec(P);                   (* вернёмся на символ назад *)

    (* удалим нули, которые есть в конце (учитывая, что они ПОСЛЕ точки) *)
    while (SE[P] = '0') and (P>0) do begin
      SE := Left(SE,P-1) + RightFrom(SE,P+1);
      dec(P);
    end;



  end;

  if length(SE) < length(SF) then result := Trim(SE) else result := SF
end;


(* вывод в формате -d.ddd+dd (N=4) scintefic - усеченный *)
(* длина строки фиксирована = N + 5 *)
function ESt(R:real;N:integer):string;
var S,SE : string; I,NE,NNE{,P} : integer; Ch1,Ch2 : char; E,RA : real;
(*
  ESt выгоднее ISt для чисел кратных 1E5    1.+05  10000
  ESt выгоднее FSt для чисел меньших 1E-4   1.-04  .0001
 *)

begin
  if R=0 then begin
    S := ' 0.';
    for I := 2 to N do S := S + '0';
    result := S + '+00';
    Exit;
  end;

  if N < 1 then begin
    WarnAbs('Подозрительный вызов ESt - требуется '+ISt(N)+
    ' значащих цифр!'+#13#10+
    'R='+RSt(R));
  end;

  NNE := 2;
  RA := abs(R);
  if (RA >= 1E100) or (RA <= 1E-100) then begin
    NNE := 3;
    if (RA >= 1E1000) or (RA <= 1E-1000) then begin
      WarnAbs('переполнение порядка при использовании формата ESt R='+RSt(R));
      result := S;
      Exit;
    end;
  end;


  E := 1.0; for I := 1 to N do E := E/10; (* N=1,E=0.1; N=4,E=0.0001 ... *)
  NE := 0;
  while RA >= (10-E) do begin inc(NE); RA := RA / 10 end;
//while RA >= (10)   do begin inc(NE); RA := RA / 10 end;
  while RA <   1-E/2 do begin dec(NE); RA := RA * 10 end;

  S := FSt(RA,N+1,N-1);

if pos('*',S)> 0 then begin
  WarnAbs('ESt.ERR: FSt('+RSt(RA)+', '+ISt(N+1)+', '+ISt(N-1)+' = <'+S+'>!!!');
end;


if length(S) > N+1 then begin
  (* может быть ошибка в функции Str(R:N+1:N-1) -      *)
  (* длина полученной строки N+2   Пытаемся исправить: *)
  S := FSt(RA,N+1-1,N-1-1);
end;


if length(S) > N+1 then begin
  WarnAbs('ESt.ERR: FSt('+RSt(RA)+', '+ISt(N+1)+', '+ISt(N-1)+') = <'+S+'>!!!'+
  #13#10+'Превышена длина строки!');
end;



  SE := NumStr(Abs(NE),NNE);   (* NNE = 2 или 3 *)

  if R  < 0 then Ch1 := '-' else Ch1 := ' ';
  if NE < 0 then Ch2 := '-' else Ch2 := '+';

  result := Ch1+S+Ch2+SE;
{
  SysUtils.FmtStr(S, '%e', [R]);



  P := pos('E',S);
(*-------------------- временно: *)
  if P = 0 then begin
    WarnAbs('странный E-формат:'+S+'!!!');
    result := left(S,D+5); Exit;
  end;
(*-------------------- временно << *)

  Ch2 := S[P+1];            (* знак экспоненты *)
  SE := right(S,2);         (* две цифры экспоненты *)

  if S[1] in ['0'..'9'] then S := ' ' + S;

  result := left(S,D+2)+Ch2+SE;
}

end; (* ESt *)


function RectSt(R:TRealRect;D:integer):String;
begin
  result := '[('+ESt(R.Left,D)+','+ESt(R.Bottom,D)+'):('+
                 ESt(R.Right,D)+','+ESt(R.Top,D)+')]';
end;

function RSt(R:real;N1,N2:integer):string;  overload;
var S : string;
begin
  Str(R:N1:N2,S);
  result := S;
end;

function PerCentToStr(R: real): string;
begin SysUtils.FmtStr(Result, '%8.1f', [R*100]) end;

function CharSetSt(chs:CharSet):string;
var S : string; I : integer;
begin
  S := '';
  for I := 0 to 255 do begin
    if char(I) in chs then S := S + char(I);
  end;
  result := S;
end;
















{
function HexS(I:longint):string;         (* число в 16-тирич.строку мин.длины *)
begin Result := format('%x',[I]) end;
}

function HexL(L:longint):string;
var B4 : array [1..4] of byte absolute L;
begin
  HexL:=HexB(B4[4])+HexB(B4[3])+HexB(B4[2])+HexB(B4[1]);
end;

//function HexS(I:longint):string;         (* число в 16-тирич.строку мин.длины *)
function HexI(I:longint):string;         (* число в 16-тирич.строку мин.длины *)
var S : string; K : integer; BA : array[1..4] of byte absolute I;
begin
  S := ''; for K := 1 to 4 do S := HexB(BA[K]) + S;
  K := 1; while (K < length(S)) and (S[K]='0') do inc(K);
  if K = 1 then Result := S else Result := copy(S,K,length(S)-K+1);
end;

function HexI8(I:longint):string;   (* число в 16-тирич.строку 8симв.*)
var S : string; K : integer; BA : array[1..4] of byte absolute I;
begin
  S := ''; for K := 1 to 4 do S := HexB(BA[K]) + S;
  Result := S;
end;

function HexI4(I:longint):string;        (* число в 16-тирич.строку 4-8 симв. *)
var S : string; K : integer; BA : array[1..4] of byte absolute I;
begin
  S := ''; for K := 1 to 4 do S := HexB(BA[K]) + S;
  if copy(S,1,4) = '0000' then result := copy(S,5,4)
                          else result := S;
end;



{
function IntStr(I:longint;D:integer):string; (* целое - в сторку (D цифр) *)
var S : string;
begin Str(I:D,S); IntStr:=S end;
}

function QuotedStr(S:string):string;
begin result := #$27 + S + #$27 end;

function BoolStr(Q:boolean):string;
begin if Q then result := 'true' else result := 'false'; end;

function BSt(Q:boolean;sY,sN:string):string;
begin if Q then result := sY else result := sN end;

function BSt(I:integer;s0,s1:string):string;
begin case I of 0 : result := s0; 1 : result := s1; end end;

function BSt(I:integer;s0,s1,s2:string):string;
begin case I of 0 : result := s0; 1 : result := s1; 2 : result := s2; end end;

function BSt(I:integer;s0,s1,s2,s3:string):string;
begin case I of
  0 : result := s0;
  1 : result := s1;
  2 : result := s2;
  3 : result := s3;
end end;

function BSt(I:integer;s0,s1,s2,s3,s4:string):string;
begin case I of
  0 : result := s0;
  1 : result := s1;
  2 : result := s2;
  3 : result := s3;
  4 : result := s4;
end end;


function BoolChr10(Q:boolean):char;
begin if Q then result := '1' else result := '0'; end;

function ChrToBool(ch:char):boolean;
begin if ch in SetYES then result := true else result := false end;

function CaseSt(I:integer;SL:TStrings):string;
var S : string;
begin
  if Not Assigned(SL) then result := 'CaseSt('+ISt(I)+') СТРОКИ НЕОПРЕДЕЛЕНЫ!'
  else
  if (I < 1) or (I > SL.Count) then result :=
    'CaseSt запрошена строка '+ISt(I)+'), а всего их '+ISt(SL.Count)
  else result := SL.Strings[I-1];
end;

function CaseStr(S:string;SL:TStrings):integer;
var I : integer;
begin
  result := -1;
  for I := 0 to SL.Count-1 do begin
    if (S = SL.Strings[I]) then begin
      result := I;
      Exit;
    end;
  end;
end;


(* PosP('1','123456123',3) => 7 *)
function PosP(T:string;S:string;P1:integer):integer;(* pos после позиции P1 *)
var P,L : integer;
begin
  PosP := 0;
  if P1 < 1 then P1 := 1; (* строка нач-ся с первого, а не с 0-ого символа *)
  L := length(S);
  if P1 > L then Exit;
  P:=System.pos(T,Copy(S,P1,L-P1+1));
  if P>0 then PosP:=P+P1-1;
end; (* PosP *)


function posR(T,S:string):integer; (* pos первого вхождения образца справа *)
var P1,P2 : integer;
begin
  P1 := System.pos(T,S);
  P2 := 0;
  while P1 > 0 do begin
    P2 := P2 + P1;
    P1 := System.pos(T,copy(S,P2+1,length(S)-P2));
  end;
  Result := P2;
end;

function PosSet(SC:CharSet;S:string):integer;     (* позиция CharSet    *)
  var i : integer;
  begin
    PosSet := 0;
    for i := 1 to length(S) do
      if S[i] in SC then begin PosSet := i; Exit end;
  end;

(* первая позиция отдельно стоящего слова T в строке S *)
function posword(T,S:string):integer;
var J,L,LL,P1 : integer;
begin
  result := 0;
  P1 := System.pos(T,S); if P1 = 0 then exit;
  L  := length(T); LL := length(S);
  J  := P1+L;
  if (P1 = 1) or (S[P1-1] in SetBlanks) then begin
    if (J > LL) or (S[J] in SetBlanks) then begin
      result := P1; exit;
    end;
  end;

  swStr.SercBlank(S,J); (* дойти до пробелов *)
  swStr.PassBlank(S,J); (* найти первый символ следующего слова *)
  P1 := PosP(T,S,J-1);
  J  := P1+L;

  while (P1 > 0) and (J <= LL) and (Not (S[J] in SetBlanks)) do begin
    swStr.SercBlank(S,J); (* дойти до пробелов *)
    swStr.PassBlank(S,J); (* найти первый символ следующего слова *)
    P1 := PosP(T,S,J-1);
    J  := L+P1;
  end;

  result := P1;
end;


(* поиск подстроки T длиной NT в буфере текста S длиной NS *)
function posa(var T;NT:integer;var S;NS:integer):integer;
  var
    AT : array [1..255]   of char absolute T; (* буфер строки - шаблона  *)
    SS : array [1..64000] of char absolute S; (* буфер текста для поиска *)
    C  : char;
    I,J,P : integer;
  begin
    posa := 0;
    P := 0;
    repeat
      I := P + 1;
      J := 1;
      C := AT[J];
      while (I<=NS) and (SS[I]<>C) do inc(I);
      if SS[I] <> C then Exit;             (* не найдена 1-ая буква шаблона *)
      P := I;                              (*    найдена 1-ая буква шаблона *)
      if (NS - P) < (NT - 1) then exit;    (* шаблон длинее остатка строки  *)
      while (J < NT) and (AT[J] = SS[I]) do begin
        inc(J);   (* индекс в шаблоне *)
        inc(I);   (* индекс в строке  *)
      end;
    until (AT[J] = SS[I]);                 (* для последн.буквы шаблона     *)
    posa := P;
  end;


(*
 *    шаблон T может быть разбит на куски 3-х типов:
 *    а) обычная подстрока
 *    б) "*" - заменяет любую (в т.ч. и пустую) послед-сть символов
 *    в) "?" или несколько "???..." заменяют опред. число любых символов
 *
 *    возвращает достроенный шаблон и его позицию в P
 *)

function posts(T,S:string;var P:integer):string;
  var
    I : integer; (* индекс в строке  *)
    J : integer; (* индекс в шаблоне *)
    K : integer; (* индекс в подстроке (в кусочке шаблона) *)
    PPP     : integer; (* начало первого шаблона *)
    PP      : integer; (* начало очередного шаблона *)

//  TplKind   : integer;      (* 1, 2, 3 *)
    LQ        : integer;      (* длина отрывка с воскл.знаками  *)
    QAsterisk : boolean;      (* были звездочки                 *)
    T1        : string;       (* подшаблон с обычными символами *)
    TT        : string;       (* "расшифрованный" шаблон        *)

  begin

(* $DEFINE posdebug*)
(*$IFDEF posdebug*)                     writeln;             (*$ENDIF*)

    P   := 0;    (* результат поиска  *)
    TT := '';    (* результат поиска  *)
    PPP := 0;    (* начало найденного *)
    J := 1;      (* индекс в шаблоне  *)
    I := 1;      (* индекс в строке   *)
    LQ := 0;     (* кол-во ?-знаков   *)
    QAsterisk := false;  (* были **   *)

    (* цикл по однородным "отрывкам" шаблона *)
    repeat

      (* определяем очередной кусочек шаблона *)
      if T[J] = '*' then begin
        inc(J);
        QAsterisk := true;

(*$IFDEF posdebug*)                       write('posts *');  (*$ENDIF*)

        (* неск.звездочек можно заменить на одну *)
        while (J<length(T)) and (T[J]='*') do begin   inc(J);
(*$IFDEF posdebug*)                             write('*');  (*$ENDIF*)
                                              end;
(*$IFDEF posdebug*)                     writeln;             (*$ENDIF*)

      end
      else if T[J] = '?' then begin
        inc(J);
        inc(LQ);
(*$IFDEF posdebug*)                     write('posts ?');  (*$ENDIF*)
        (* считаем кол-во вопр.знаков *)
        while (J<length(T)) and (T[J]='?') do begin inc(J); inc(LQ);
(*$IFDEF posdebug*)                           write('?');  (*$ENDIF*)
                                                                    end;
(*$IFDEF posdebug*)                     writeln;           (*$ENDIF*)
      end
      else begin (* T[J] <> '?', <> '*' *)
        (* сформируем отрывок шаблона *)
        SetLength(T1,length(T));
        K := 1;
        while (J<=length(T)) and (Not (T[J] in ['?','*'])) do
          begin T1[K]:=T[J]; inc(J); inc(K) end;
        dec(K);
        SetLength(T1,K);

(*$IFDEF posdebug*)                     write('posts "',T1,'"');  (*$ENDIF*)
(*$IFDEF posdebug*)                     writeln;                  (*$ENDIF*)


        (* произведем поиск шаблона (с учетом предшест."*" и "?")  *)
        I := I + LQ;   (* если были "??" смещаемся на их кол-во LQ *)
        PP := posa(T1[1],length(T1),S[I],length(S)-I+1);

        if (PP = 0) or                     (* шаблон не найден или *)
                                           (* пропуск > заданного: *)
           ((Not QAsterisk) and (LQ > 0) and (PP <> 1))
          then begin P := 0; posts := ''{TT}; exit end;

        PP := PP+(I-1);
        if PPP = 0 then PPP := PP-LQ;

        (* достраиваем расшифрованный шаблон *)
        if QAsterisk then TT := TT + copy(S,I-LQ,PP-I+LQ)
                     else
             if LQ>0 then TT := TT + copy(S,PP-LQ,LQ);
        TT := TT + T1;

        QAsterisk := false;
        LQ        := 0;
        I := PP + length(T1);
      end;

    until (J > length(T));
    P     := PPP;
    posts := TT;
  end;


(*========================================================*)


(* первые N символов строки или L-|N|, если N<0 *)
function left(S:string;N:integer):string;
var L : integer;
begin
  L := length(S);
  if abs(N) >= L then begin result := S; Exit end;
  if N > 0 then result := copy(S,1,N) else
  if N < 0 then result := copy(S,1,L+N) else
                result := '';
end;

function left(S,subStr:string):string;
var P : integer;
begin
  P := pos(subStr,S);
  if P = 0 then result := S
           else
  if P = 1 then result := ''
           else result := copy(S,1,P-1);
end;

(* последние N символов строки или L-(-N), если N<0 *)
function right(S:string;N:integer):string;
var L : integer;
begin
  L := length(S);
  if abs(N) >= L then begin result := S; Exit end;
  if N > 0 then result := copy(S,L-N+1,N) else
  if N < 0 then result := copy(S,-N+1,L+N) else
                result := '';
end;

(* остаток строки после шаблона *)
function right(S:string;subStr:string):string;
begin
  result := rightfrom(S,subStr);
end;

(* остаток строки после шаблона *)
(* порядок subStr,S не годится, т.к. есть вариант вызова S,P *)
function rightfrom(S:string;subStr:string):string; overload;
var P,L : integer;
begin
  P := pos(subStr,S);
  if P > 0 then begin
    P := P + length(subStr); (* позиция ЗА шаблоном *)
    L := length(S) - P + 1;
    if L > 0 then result := copy(S,P,L);
  end
  else result := '';
end;


(* начало строки до последнего вхождения шаблона          *)
function leftbefore(S:string;subStr:string):string;
var P : integer;
begin
  P := posR(subStr,S);
  result := left(S,P-1);
end;




(* конец строки от символа N и далее *)
function rightfrom(S:string;N:integer):string;
var L : integer;
begin
  L := length(S);
  if N > L then result := '' else result := copy(S,N,L-N+1);
end;

(* фрагмент строки от N1 до N2 включительно *)
function copyfromto(S:string;N1,N2:integer):string;
var L : integer;
begin
  L := length(S); if N2 > L then N2 := L; if N1 > L then N1 := L;
  if N1 >= N2 then result := '' else result := copy(S,N1,N2-N1+1);
end;

(* то же, что и Copy, но допускает пустые строки *)
function copyZ(S:string;I1,N:integer):string;
var L : integer;
begin
  L := length(S);
  if I1 > L then result := ''
  else begin
    if L+1-I1 < N then N := L+1-I1;
    if N <= 0 then result := ''
              else result := copy(S,I1,N);
  end;
end;

(* I-ый символ слова S                       *)
(* если I < 0, счет ведем от конца слова     *)
(* если I не попадает в слово, возвращаем #0 *)
function Ch(const S:string;I:integer):char;
var L : integer;
begin
  L := length(S);
  if I <  0 then I := L+1 + I;
  if I <= 0 then I := L+1;
  if I > L then result := #0
           else result := S[I];
end;


(*========================================================*)

(* если есть кавычки - удалить их и убрать сдвоенные изнутри строки *)
(* #39 = одиночная 'кавычка'                                        *)
function TrimAnyQuot(S:string;QuotChar:char):string;
var L,P,I : integer; S1,STpl : string;
begin
  S1 := S; L := length(S);
  if L>=2 then
    if (S[1] = QuotChar) and (S[L] = QuotChar) then
      if L > 2 then S1 := copy(S,2,L-2) else S1 := '';
  (* теперь ищем и убираем сдвоенные кавычки внутри строки *)
  STpl := QuotChar + QuotChar;
  I := 1; P := PosP(STpl,S1,I);
  while P > 0 do begin
    L := length(S1);
    if P < L-1
    then S1 := copy(S1,1,P) + copy(S1,P+2,L-P-1)
    else S1 := copy(S1,1,P);
    I := P+1;
    P := PosP(STpl,S1,I)
  end;
  Result := S1;
end;

procedure TruncAtChar(var S:string;Ch:char);
var P : integer;
begin
  P := pos(Ch,S);
  if P > 0 then SetLength(S,P-1);
end;



procedure ReplaceChar(var S:string;ChIn,ChOut:char);
var I : integer;
begin
  for I := 1 to length(S) do if S[I] = ChIn then S[I] := ChOut;
end;

function SubstChar(S:string;ChIn,ChOut:char):string;
begin ReplaceChar(S,ChIn,ChOut); result := S end;

(* извлечь [первое вхождение] конструкции в заданных скобках *)
(* sOut - строка, из которой выражение в скобках вырезано    *)
(* sValue - содержимое скобок вместе со скобками             *)
procedure ExtractBrackets(S,sBrackets:string;var sOut,sValue:string);
var P1,P2 : integer;
begin
  sOut := S; sValue := '';
  if length(sBrackets) <> 2 then begin
    WarnAbs('Неверный вызов swStr.ExtractBrackets, строка скобок /'
             +sBrackets+'/ должна содержать два символа!');
    Exit;
  end;
  P1 := pos(sBrackets[1],S);
  if P1=0 then Exit;
  P2 := posR(sBrackets[2],S);
  if P2 = 0 then begin
    WarnAbs('swStr.ExtractBrackets '+sBrackets+
    'в строке '+#13#10+S+#13#10+
    'не найдена вторая скобка!');
    Exit;
  end;
  if P2 < P1 then begin
    WarnAbs('swStr.ExtractBrackets '+sBrackets+
    'в строке '+#13#10+S+#13#10+
    'вторая скобка найдена раньше первой!');
    Exit;
  end;

  sValue := copy(S,P1,P2-P1+1);
  sOut   := copy(S,1,P1-1)+copy(S,P2+1,length(S)-P2);

end;

(* поиск подстроки T исключая внутренности скобок *)
function PosNoBracke(T,sBrackets,S:string):integer;
var i,P1,P2 : integer; kb : integer; S0 : string;
begin
  S0 := S;
  result := pos(T,S);
  if length(sBrackets) <> 2 then begin
    WarnAbs('Неверный вызов swStr.PosNoBracke, строка скобок /'
             +sBrackets+'/ должна содержать два символа!');
    Exit;
  end;

  kb := 0;
  P1 := 0; P2 := 0;

  for i := 1 to length(S) do begin
    if (S[i] = sBrackets[1]) then begin
      inc(kb);
      if kb = 1 then P1 := i;
    end;

    if (S[i] = sBrackets[2]) then begin
      dec(kb);
      if kb < 0 then begin
        kb := 0; // лишнюю закрывающую скобку игнорируем
        WarnAbs('В выражении <'+S0+'> лишняя закрывающая скобка '+sBrackets[2]);
      end;
      if kb = 0 then begin
        P2 := i;
        FillChar(S[P1],P2-P1+1,#0);
        P1 := 0; P2 := 0;
      end;
    end;
  end;

  if kb > 0 then begin
    WarnAbs('В выражении <'+S0+'> лишняя открывающая скобка '+sBrackets[1]);
  end;

  result := pos(T,S);
end;


(* вернуть содержимое между скобками *)
function UnBrackets(S,sBrackets:string):string;
var P1,P2 : integer;
begin
  result := S;
  if length(sBrackets) <> 2 then begin
    WarnAbs('Неверный вызов swStr.UnBrackets, строка скобок /'
             +sBrackets+'/ должна содержать два символа!');
    Exit;
  end;
  P1 := pos(sBrackets[1],S);
  if P1=0 then begin
    P2 := posR(sBrackets[2],S);
    if P2 > 0 then result := left(S,P2-1);
    Exit;
  end;
  P2 := posR(sBrackets[2],S);
  if P2 = 0 then begin
    WarnAbs('swStr.UnBrackets '+sBrackets+
    'в строке '+#13#10+S+#13#10+
    'не найдена вторая скобка!');
    if P1 > 0 then result := rightfrom(S,P1+1);
    Exit;
  end;
  if P2 < P1 then begin
    WarnAbs('swStr.UnBrackets '+sBrackets+
    'в строке '+#13#10+S+#13#10+
    'вторая скобка найдена раньше первой!');
    Exit;
  end;
  result := copy(S,P1+1,P2-P1-1);
end;



(* вернуть строковую переменную S непустой строкой (пустую заменить на sTpl *)
function AnySt(S,sTpl:string):string;
begin
  if Trim(S) = '' then result := sTpl else result := S;
end;


(* в длинной строке, разделённой на поля символом SDiv *)
(* к каждому полю применить операцию Trim              *)
function TrimFields(S,SDiv:string):string;
var LD,LL,P,P2,PP : integer; SW,SB,SS,S1 : string;
begin

  P := pos(SDiv,S);
  if P = 0 then begin
    Result := S;
    Exit;
  end;
  LD := length(SDiv);
  S1 := '';              // обработанная часть (вставлены SIns между SDiv)
  SS := S;               // необработанная часть
  P2 := 0;

  while P > 0 do begin
    P2 := PosP(SDiv,SS,P+1);
    if P2 > P+1 then begin
      SW := copy(SS,P+1,P2-P-1);
      SB := trim(SW);
      if SB = '' then begin
        S1 := S1 + copy(SS,1,P); // + SIns;
        SS := copy(SS,P2,length(SS)-P2+1);
      end
      else begin
//      S1 := S1 + copy(SS,1,P2-1);
        S1 := S1 + copy(SS,1,P);
        S1 := S1 + SB ; // + SDiv;
        SS := copy(SS,P2,length(SS)-P2+1);
      end;
    end
    else begin
      if P2 > 0 then begin
        S1 := S1 + copy(SS,1,P); // + SIns;
        SS := copy(SS,P2,length(SS)-P2+1);
      end
      else begin
        S1 := S1 + SS; //trim(SS);
        SS := '';
      end;
    end;
    P := pos(SDiv,SS);
  end;

  result := S1 + SS;
end;


(* используем, чтобы вставить непустую строку между табуляциями *)
function SubstInstWord(S,SDiv,SIns:string):string;
var LD,LL,P,P2,PP : integer; SW,SB,SS,S1 : string;
begin
  P := pos(SDiv,S);
  if P = 0 then begin
    Result := S;
    Exit;
  end;
  LD := length(SDiv);
  S1 := '';              // обработанная часть (вставлены SIns между SDiv)
  SS := S;               // необработанная часть
  P2 := 0;

  while P > 0 do begin
    P2 := PosP(SDiv,SS,P+1);
    if P2 > P+1 then begin
      SW := copy(SS,P+1,P2-P-1);
      SB := trim(SW);
      if SB = '' then begin
        S1 := S1 + copy(SS,1,P) + SIns;
        SS := copy(SS,P2,length(SS)-P2+1);
      end
      else begin
        S1 := S1 + copy(SS,1,P2-1);
        SS := copy(SS,P2,length(SS)-P2+1);
      end;
    end
    else begin
      if P2 > 0 then begin
        S1 := S1 + copy(SS,1,P) + SIns;
        SS := copy(SS,P2,length(SS)-P2+1);
      end
      else begin
        S1 := S1 + SS;
        SS := '';
      end;
    end;
    P := pos(SDiv,SS);
  end;

  result := S1 + SS;
end;


function TrimDublChar(S:string;ch:char):string;
var s1,s2,ss : string; L,L1 : integer;
begin
  L := length(S);
  s1 := ch;
  s2 := ch+ch;
  repeat
    L1 := L;
    S := SubstStr(S,S2,S1);
    L := length(S);
  until (L1 = L);
  result := S;
end;


(* заменяем в строке S все вхождения SIn на вхождения SOut *)
function SubstStr(S,SIn,SOut:string):string;
var LI,LL,P,PP : integer; SS,S1 : string;
begin
//  Time_routine('swStr.SubstStr',true);
  P := pos(SIn,S);
  if P = 0 then begin
    Result := S;
    Exit;
  end;
  LI := length(SIn);
//LO := length(SOut);
//P1 := P - 1 + LO;
  S1 := '';              // часть, в которой заменена подстрока SIn на SOut
  SS := S;               // необработанная часть
  while P > 0 do begin
    if P > 1 then S1 := S1 + copy(SS,1,P-1) + SOut else S1 := S1 + SOut;
    PP := P + LI;
    LL := length(SS)-PP+1;                             // длина остатка
    if LL > 0 then SS := copy(SS,PP,LL) else SS := ''; // копировать остаток
    P := pos(SIn,SS);
  end;
  result := S1 + SS;
//  Time_routine('swStr.SubstStr',false);
end;


(* заменяем в строке S все вхождения SC на вхождения SOut *)
function SubstCharSet(S:string;SC:CharSet;SOut:string):string;
var LI,LL,P,PP : integer; SS,S1 : string;
begin
  P := PosSet(SC,S);
  if P = 0 then begin
    Result := S;
    Exit;
  end;
  LI := 1; //  length(SIn);
  S1 := '';
  SS := S;
  while P > 0 do begin
    if P > 1 then S1 := S1 + copy(SS,1,P-1) + SOut else S1 := S1 + SOut;
    PP := P + LI;
    LL := length(SS)-PP+1;
    if LL > 0 then SS := copy(SS,PP,LL) else SS := '';
    P := PosSet(SC,SS);
  end;
  result := S1 + SS;
end;


function StripChars(S,sChars:string):string;
var I,p : integer; S2 : string; Ch : char;
begin
  S2 := '';
  for I := 1 to length(S) do begin
    Ch := S[I];
    if pos(Ch,sChars) = 0 then S2 := S2 + Ch;
  end;
  result := S2;
end;


(* выкинуть из строки все вхождения пробелов $20 и $A0 *)
function UnBlanks(S:string):string;
begin
  result := StripChars(S,#32#160);
end;




function SubstCharFromSet(S,sSet:string;Ch:char):string;
var I,J,P : integer; S0 : string;
begin
  S0 := Ch;
  P := pos(S0,sSet);
  if P = 0 then begin
    WarnAbs('SubstCharFromSet ERROR char <'+Ch+'> Not in Set ['+sSet+']!');
    result := S;
    Exit;
  end;

  for I := 1 to length(S) do begin
    S0 := S[I];
    if pos(S0,sSet) > 0 then S[I] := Ch;
  end;
  result := S;
end;




function SubstLast(S,SIn,SOut:string):string;
var L1,N,P : integer; S1,S2 : string;
begin
  P := posR(SIn,S);
  if P = 0 then begin
    Result := S;
    Exit;
  end;
  if P > 1 then S1 := copy(S,1,P-1) else S1 := '';
  L1 := P+length(SIn);
  N := length(S)-L1-1;
  if N > 0 then S2 := copy(S,L1,N) else S2 := '';
  result := S1 + SOut + S2;
end;





function SubstJ(S,SOut:string;J,N:integer):string;
begin
  result := copy(S,1,J-1)+SOut+copy(S,J+N,length(S)-(J+N-1));
end;

function SubstJ(S,SOut:string;J:integer):string;
begin
  result := copy(S,1,J-1)+SOut+copy(S,J+1,length(S)-J);
end;




(*========================================================*)

function StrUpCase(S:string):string;
var I:Integer;
begin
  StrUpCase := '';
  If S = '' Then Exit;
  For I := 1 To Length(S) Do S[I] := UpCase(S[I]);
  StrUpCase := S;
end;

function StrDownCase(S:string):string;
var I:Integer;
begin
  StrDownCase := '';
  If S = '' Then Exit;
  For I := 1 To Length(S) Do S[I] := DownCase(S[I]);
  StrDownCase := S;
end;



(*========================================================*)
(*========================================================*)
(*========================================================*)
(*========================================================*)

function UnTab(S:string):string;            (* развернуть табуляции в пробелы *)
var I,J : integer; S1 : string; Ch : char;
const ChTab = #9;
begin
  if pos(ChTab,S)=0 then begin result := S; Exit end;

  J := 1;
  for I := 1 to length(S) do begin
    Ch := S[I];
    if Ch = ChTab then begin
      while (J mod ITabLength) > 0 do begin
        S1 := S1 + ' '; inc(J);
      end;
      S1 := S1 + ' '; inc(J);  (* ещё один пробел *)
    end
    else begin
      S1 := S1 + Ch; inc(J);
    end;
  end;
  result := S1;
end;

function ToTab(S:string):string;
var I : integer; S1 : string; Ch : char; Qb : boolean;
const ChTab = #9;
begin
  S := StripBlanks(S);
  Qb := false;
  S1 := '';
  for I := 1 to length(S) do begin
    Ch := S[I];
    if Qb then begin
      if Ch <> ' ' then begin
        Qb := false;
        S1 := S1 + Ch;
      end
      else ;
    end
    else (* не было пробела *)
    if (Ch = ' ') then begin
      Qb := true;
      S1 := S1 + ChTab;
    end
    else begin
      S1 := S1 + Ch;
    end;
  end;
  result := S1;
end;



function StripBlanks(const S:string):string; (* удалить ведущ.и хвост.пробелы *)
begin Result := Trim0(S) end;

procedure PassBlank(const S:string; var J:integer);
  begin
    while (J<=length(S)) and (S[J]=' ') do inc(J);
  end;
procedure SercBlank(const S:string; var J:integer);
  begin
    while (J<=length(S)) and (S[J]<>' ') do inc(J);
  end;

procedure SercQuote(const S:string; var J:integer; chQuote:char);
  begin
    while (J<=length(S)) and (S[J]<>chQuote) do inc(J);
  end;


(* ищем первый пробел, если S[J] = ChQuote,    *)
(* то ищем первый символ после второго ChQuote *)
procedure SercBlankQuoted(const S:string; var J:integer;ChQuote:char);
var QQuote : boolean;

 J0 : integer;

begin

 J0 := J;

  QQuote := false;
  if J <= length(S) then QQuote := (S[J]=ChQuote);
  if QQuote
  then begin
     inc(J); while (J<length(S)) and (S[J]<>ChQuote) do inc(J); inc(J)
  end
  else       while (J<=length(S)) and (S[J]<>' ') do inc(J);


{
 WarnAbs(S+#13#10+
 'J0='+ISt(J0)+'<'+S[J0]+'>'+#13#10+
 'J1='+ISt(J) +'<'+S[J-1]+'>');
}

end;



procedure PassBlankBack(const S:string; var J:integer);
  begin
    while (J>=1) and (S[J]=' ') do dec(J);
  end;
procedure SercBlankBack(const S:string; var J:integer);
  begin
    while (J>=1) and (S[J]<>' ') do dec(J);
  end;
procedure PassBlankEx(const S:string; var J:integer;BlankChSet:CharSet);
begin
  if J < 0 then WarnAbs('В процедуре PassBlanc J не может быть менее 1');
  while (J<=length(S)) and (S[J] in BlankChSet) do inc(J);
end;
procedure SercBlankEx(const S:string; var J:integer;BlankChSet:CharSet);
begin
  while (J<=length(S)) and (Not (S[J] in BlankChSet)) do inc(J);
end;




procedure PassChar(const S:string;C:char;var J:integer);
  begin
    while (J<=length(S)) and (S[J]=C) do inc(J);
  end;

(* взять слово из строки *)
function GetQuotedWord(const S:string;var J:integer;ChQuote:char):string;
var J0, L : integer;
begin
  L := Length(S);
  PassBlankEx(S,J,[#9,' ']); J0:=J; (* пропускаем все пробелы *)
//SercBlankQuoted(S,J,ChQuote);
  (* если слово ограничено кавычками, ищем закрывающую кавычку *)
  (* иначе ищем пробел                                         *)

  if J <= L then
  if S[J] = ChQuote then SercQuote(S,J,ChQuote)          (* ищем кавычку *)
                    else SercBlank(S,J);
  GetQuotedWord:=Trim(Copy(S,J0,J-J0));
  inc(J);
end;(* GetQuotedWord *)


function GetWord(const S:string;var J:integer):string;
(* выделить слово из строки, начиная с позиции J *)
var J0 : integer;
begin
  PassBlank(S,J); J0:=J;
  SercBlank(S,J);
  if J = J0 then GetWord:=''
            else GetWord:=Copy(S,J0,J-J0);
end;(* GetWord *)

function GetStrEnd(const S:string;var J:integer):string;(* конец строки *)
begin
  result := rightfrom(S,J); J := length(S)+1;
end;

function GetOneChar(const S:string;var J:integer):char;(* взять слово и из него первый символ *)
var W : string;
begin
  W := GetWord(S,J);
  if length(W) = 0 then result := #0 else result := W[1];
end;


function GetWordEx(const S:string;var J:integer;BlankChSet:CharSet):string;
(* выделить слово из строки, начиная с позиции J, *)
(* пробелом считается любой из BlankChSet         *)
var J0 : integer;
begin
  PassBlankEx(S,J,BlankChSet); J0:=J;
  SercBlankEx(S,J,BlankChSet);
  GetWordEx:=Copy(S,J0,J-J0);
end;(* GetWordEx *)


function GetWordN(const S:string;N:integer):string;
(* выделить слово номер N из строки S *)
(* счёт слов начинаем с 1!!! *)
  var
    I,J : integer;
    S1  : string;
  begin
    J := 1;   (* счётчик текущей позиции в строке S *)
    S1 := ''; (* на случай, если N < 1              *)
    for I := 1 to N do S1 := GetWord(S,J); (* цикл по словам *)
    GetWordN := S1;
  end;(* GetWordN *)


(* получить позицию слова № N в строке, либо 0, если слов < IC *)
function GetWordNPos(const S:string;N:integer):integer;
(* счёт слов начинаем с 1!!! *)
var I,J,J0 : integer;
begin
  J := 1;   (* счётчик текущей позиции в строке S *)
  for I := 1 to N-1 do begin
    PassBlank(S,J); J0:=J;
    SercBlank(S,J);
  end;
  PassBlank(S,J); J0 := J;
  SercBlank(S,J);
  if J0 = J then result := 0    (* слова N в строке нет *)
            else result := J0;
end;(* GetWordNPos *)



function GetQuotedWordN(const S:string;N:integer;ChQuote:char):string;
(* выделить слово номер N из строки S *)
(* счёт слов начинаем с 1!!! *)
  var
    I,J : integer;
    S1  : string;
  begin
    J := 1;   (* счётчик текущей позиции в строке S *)
    S1 := ''; (* на случай, если N < 1              *)
    for I := 1 to N do S1 := GetQuotedWord(S,J,ChQuote); (* цикл по словам *)
    result := S1;
  end;(* GetQuotedWordN *)


{
function GetNWord(const S:string):integer; (* кол-во слов в строке *)
  var I,P,L,P1 : integer;
  begin
    I := 1;
    P1 := 0;
    L := length(S);
    P := pos(' ',copy(S,P1+1,L-P1));
    while P > 0 do begin
      inc(I);
      P1 := P1 + P;
      P  := pos(' ',copy(S,P1+1,L-P1));
    end;
    GetNWord := I;
  end;
}


(* VAR=VALUE  =>   VAR = VALUE *)
function SplitWords(S,sSplitWord:string):string;
var P : integer; W,S2 : string;
begin
  W := S; S2 := '';
  P := pos(sSplitWord,W);
  while P > 0 do begin
    S2 := S2 + left(W,P-1);
    if P > 1 then if W[P-1] <> ' ' then S2 := S2 + ' ';
    S2 := S2 + sSplitWord;
    W := rightfrom(W,P+length(sSplitWord));
    if length(W) > 0 then if W[1] <> ' ' then W := ' ' + W;
    P := pos(sSplitWord,W);
  end;
  result := S2 + W;
end;




(* кол-во слов в строке *)
function GetNWord(const S:string;ChQuote,ChDiv:char):integer;
begin
  if ChDiv = ' '
  then begin
    if ChQuote <> #0
      then result := GetNQuotedWord(S,ChQuote)
      else result := GetNWordEx(S,[#9,' ']);
  end
  else result := GetNFld(S,ChDiv);
end;



function GetNWord(const S:string):integer; (* кол-во слов в строке *)
var
  QDone : boolean;
  J0, J, I  : integer;
begin
  QDone := false;
  J := 1;
  I := 0;
  repeat
    PassBlank(S,J); J0:=J;
    SercBlank(S,J);
    if J > J0 then inc(I) else QDone := true;
  until QDone;
  result := I;
end;


(* кол-во слов в строке, заключённых в скобки *)
(* вложенные парные скобки игнорируются       *)
(* при несоответствии скобок результат = -1   *)
function GetNBraketWord(const S:string;ChB1,ChB2:char):integer;
var i,ib,iw : integer;
begin
  ib := 0; iw := 0;
  for i := 1 to length(S) do begin
    if (S[i] = ChB1) then inc(ib) else
    if (S[i] = ChB2) then begin
      dec(ib);
      if ib = 0 then inc(iw) else
      if ib < 0 then begin result := -1; Exit end; // закрыв.скобка до окрыв.
    end;
  end;
  if ib <> 0 then begin result := -1; Exit end; // не хватает закрыв. скобок
  result := iw;
end;

function GetBraketWordN(const S:string;N:integer;ChB1,ChB2:char):string;
var W : string;
    i,ib,iw,i1 : integer;
begin
  result := '';
  ib := 0; iw := 0;
  for i := 1 to length(S) do begin
    if (S[i] = ChB1) then begin
      inc(ib);
      i1 := i;
    end
    else
    if (S[i] = ChB2) then begin
      dec(ib);
      if ib = 0 then begin
        inc(iw);
        if (iw = N) then begin
          inc(i1);
          result := copy(S,i1,i-i1);
          Exit;
        end;
      end
      else
      if ib < 0 then Exit; // закрыв.скобка до окрыв.
    end;
  end;  (* for i *)

end;





(* кол-во слов в строке. Содержимое внутри кавычек считается одним словом *)
(* ситуация трёх кавычек не обрабатывается!                               *)
function GetNQuotedWord(const S:string;ChQuote:char):integer;
var
  QDone : boolean; QQuote : boolean;
  J0, J, I, L : integer;
begin
  QQuote:= false;
  QDone := false;
  J := 1;
  I := 0;
  L := length(S);
  repeat
    PassBlank(S,J); J0:=J;
    (* здесь проверяем, если первый символ кавычка, *)
    (* то берём выражение в кавычках                *)
    (* иначе берём выражение в пробелах             *)
    if J <= L then
    if S[J] = ChQuote then begin
      SercBlankQuoted(S,J,ChQuote);
    end
    else begin
      SercBlank(S,J);
    end;

    if J > J0 then inc(I) else QDone := true;
  until QDone;
  result := I;
end;




function GetNWordEx(const S:string;BlankChSet:CharSet):integer;
var
  QDone : boolean;
  J0, J, I  : integer;
begin
  if Trim(S) = '' then begin
    result := 0;
    Exit;
  end;
  QDone := false;
  J := 1;
  I := 0;
  repeat
    PassBlankEx(S,J,BlankChSet); J0:=J;
    SercBlankEx(S,J,BlankChSet);
    if J > J0 then inc(I) else QDone := true;
  until QDone;
  result := I;
end;



function CutWord(const S:string):string;  (* отрезать последнее слово *)
var J : integer;
begin
  J := length(S);
  PassBlankBack(S,J);     (* "111   22  " => "111   22" *)
  SercBlankBack(S,J);     (* "111   22"   => "111   "   *)
  PassBlankBack(S,J);     (* "111   "     => "111"      *)
  CutWord := Copy(S,1,J)
end;

procedure CutLastWord(var S,SL:string);  (* отрезать последнее слово от других*)
var J,J1,J2 : integer;
begin
  J := length(S);
  PassBlankBack(S,J); J2 := J;     (* "111   22  " => "111   22" *)
  SercBlankBack(S,J); J1 := J + 1; (* "111   22"   => "111   "   *)
  PassBlankBack(S,J);              (* "111   "     => "111"      *)
  SL := copy(S,J1,J2-J1+1);
  S  := copy(S,1,J);
end;


function GetIWord(const S:string;jpos:integer):integer;
(* получить номер слова, к которой относится позиция jpos *)
var J,N,NN : integer;
begin
  NN := length(S);
  if jpos > NN then begin
    result := GetNWord(S) + 1;
    exit;
  end;
  J := 1; N := 0;
  repeat
    PassBlank(S,J);
    SercBlank(S,J);
    inc(N);
  until (jpos < J) or (J >= NN);

  result := N;
end;

function GetIFld(const S:string;jpos:integer;D:char):integer;
(* получить номер поля, к которой относится позиция jpos *)
(* разделитель поля относим к предстоящему полю          *)
var J,L : integer;
    P,K : integer;
    QLast : boolean;
begin
  L := length(S);
  if jpos > L then begin
    result := GetNFld(S,D) + 1;
    exit;
  end;

  L := L + 1;
  K := 0;
  J := 0;
  QLast := false;
  while Not QLast do begin
    P := pos(D,Copy(S,J+1,L-J));
    if P > 0 then J := J + P
             else QLast := true;  (* последнее заполненное поле *)
    if (J >= jpos) or QLast then begin result := K; Exit; end;
    K := K + 1;
  end;
end;





function GetIQuotedWord(const S:string;jpos:integer;ChQuote:char):integer;
(* получить номер слова, к которой относится позиция jpos *)
var J,N,NN : integer;
begin
  NN := length(S);
  if jpos > NN then begin
    result := GetNQuotedWord(S,ChQuote) + 1;
    exit;
  end;
  J := 1; N := 0;
  repeat
    PassBlank(S,J);
    SercBlankQuoted(S,J,ChQuote);
    inc(N);
  until (jpos < J) or (J >= NN);

  result := N;
end;









function GetCurWord(const S:string;jpos:integer):string;
(* получить слово "под курсором" - в позиции jpos или справа от неё *)
var L,J,J2 : integer;
begin
  L := length(S);
  if L = 0 then begin result := ''; Exit end;
  J := jpos;
  if J > L then J := L;
  PassBlank(S,J);  (* уйти от пробелов вправо    *)
  SercBlank(S,J);  (* найти первый пробел справа *)
  dec(J); J2 := J;     (* конец слова *)
  SercBlankBack(S,J);  (* найти первый пробел слева *)
  result := copy(S,J+1,J2-J);
end;



(*========================================================*)
(*========================================================*)
(*========================================================*)
(*========================================================*)


function GetNFld(const S:string;D:char):integer; (* число полей *)
  var
    I,J,L,P : integer;
  begin
    J := 0;
    L := length(S)+1;
    I := 1;
    P := pos(D,Copy(S,J+1,L-J));
    while P > 0 do begin
      Inc(I);
      J := J + P;
      P := pos(D,Copy(S,J+1,L-J));
    end;
    result := I;
  end;


function SLExtractFld(SL : TStrings;D:char;N:integer):TStringList;
var I : integer; S : string; SL2 : TStringList;
begin
  if Not Assigned(SL) or (SL.Count <= 0) then begin
    result := NIL;
    Exit;
  end;

  SL2 := TStringList.Create;
  for I := 0 to SL.Count - 1 do begin
    S := swStr.GetFldN(SL.Strings[I],D,N);
    SL2.Add(S);
  end;
  result := SL2;
end;

function GetFldN(const S:string;D:char;N:integer):string;
(* выделить поле номер N из строки S *)
(* поля разделяются символом D       *)
(* счёт слов начинаем с 0            *)
  var
    I,J,L,P,K : integer;
    QLast : boolean;
  begin
//  Time_routine('swStr.GetFldN',true);

    J := 0;
    L := length(S)+1;
    QLast := false;
    for I := 1 to N do begin
      if QLast then begin  (* заполненные поля уже кончились *)
        result := '';
        Exit;
      end;
      K := I;
      P := pos(D,Copy(S,J+1,L-J));
      if P > 0 then J := J + P
               else QLast := true;  (* последнее заполненное поле *)
    end;
    if QLast then begin
      result := '';
      Exit;
    end;
    P := pos(D,Copy(S,J+1,L-J));
    if P = 0 then P := L-J;
    GetFldN := Trim0(copy(S,J+1,P-1));
//  Tras('поле '+IntToStr(N)+' >'+copy(S,J+1,P-1))

//  Time_routine('swStr.GetFldN',false);
  end;

(* заменить значение в поле N на значение подстроки W *)
function SetFldN(S,W:string;D:char;N:integer):string;
(* выделить поле номер N из строки S *)
(* поля разделяются символом D       *)
(* счёт слов начинаем с 0            *)
(* Заменить значение этого поля на W *)
  var
    I,J,L,P,K,P2,L2 : integer;
    QLast : boolean;
  begin
    J := 0;
    L := length(S)+1;
    QLast := false;
    for I := 1 to N do begin
      if QLast then begin  (* заполненные поля уже кончились *)
        result := S;
        Exit;
      end;
      K := I;
      P := pos(D,Copy(S,J+1,L-J));
      if P > 0 then J := J + P
               else QLast := true;  (* последнее заполненное поле *)
    end;
    if QLast then begin
      result := S;  (* S+W ??? - проверить кода последнее поле пустое *)
      Exit;
    end;
    P := pos(D,Copy(S,J+1,L-J));
    if P = 0 then P := L-J;

    P2 := J+P;
    L2 := length(S)-P2+1;
    SetFldN := copy(S,1,J)+W+copy(S,P2,L2);
//    GetFldN := Trim0(copy(S,J+1,P-1));

end;



(* сформировать CSV строку из массива чисел типа T (целых) *)
function SetCSVStr(var V;T,D:char;N:integer):string;
var VI : array[1..32760] of integer absolute V;  sDiv,S : string; I : integer;
begin
  S := '';  sDiv := '';
  for I := 1 to N do begin
    case T of
  'I' : begin
          S := S + sDiv + ISt(VI[I]); sDiv := D;
        end;
else (* case *) ;
    end; (* case *)
  end; (* for I *)
  result := S;
end;

(* выгрузить массив целых (T='I') чисел из CSV строки S с разделителями D *)
(*  в переменную VA, которая является целым массивом непред.длины        *)
procedure UpLoadCSVStr(var VA;const S:string;T,D:char;MaxN:integer);
var N,I,IErr,IW : integer; W : string;
  VI : array[1..32760] of integer absolute VA;
begin
  if (Not (T in ['I'])) then Exit;
  N := GetNFld(S,D);
  if N > MaxN then N := MaxN;
  for I := 0 to N-1 do begin
    W := GetFldN(S,D,I);
    Val(W,IW,IErr);
    if IErr > 0 then IW := 0;
    VI[I+1] := IW;
  end;  (* for I *)
end;

function Val0(S:string):real;
var R : real; IErr : integer;
begin
  val(S,R,IErr);
  if IErr > 0 then result := 0.0 else result := R;
end;

{
function StrToInt0(S:string):integer;
begin
  S := Trim(S);
  if S = '' then Result := 0 else
  Result := SysUtils.StrToInt(S);   (* с сообщ.об ошибке *)
end;
}

function ValInt(S:string):integer;
var I,IErr : integer;
begin
  Val(S,I,IErr);
  if IErr > 0 then
  ErrPSW('Ошибка ValInt при вводе целого <'+S+'>',IErr);
  Result := I;
end;

function ValInt(S,sErrComment:string):integer;
var I,IErr : integer;
begin
  Val(S,I,IErr);
  if IErr > 0 then
  ErrPSW('Ошибка '+sErrComment+' при вводе целого <'+S+'>',IErr);
  Result := I;
end;

function ValInt(S:string;var IErr:integer):integer;
var I : integer;
begin
  Val(S,I,IErr);
  if IErr > 0 then result := 0 else result := I;
end;


function ValInt0(S:string):integer;
begin
  if Trim(S) = '' then Result := 0 else
  Result := ValInt(S);   (* с сообщ.об ошибке *)
end;

function ValInt0(S,sErrComment:string):integer;
begin
  if Trim(S) = '' then Result := 0 else
  Result := ValInt(S,sErrComment);   (* с сообщ.об ошибке *)
end;

{
function GetInt(NFld:word;SComment:string):integer;
  var III : integer;
  begin
      wd := GetFldN(S,D,NFld);
      if trim(wd) = '' then begin Result := 0; Exit end;
      val(wd,III,IErr);
if IErr > 0 then
Tras(qbInput,'Err StrToInt('+SComment+') <'+wd+'> IErr='+ISt(IErr));
      Result := III;
  end;
}



function GetTimeFile_17(S:string):DWORD; (* '11.11.10 12:12:42' => DateOfFile *)
var T : System.TDateTime;
  YY,MM,DD,HH,MN,SS : integer;
begin

  while (length(S) < 17) do S := S + ' ';

  YY := ValInt0(copy(S,1,2));
  if YY < 80 then YY := YY + 2000 else YY := YY + 1900;
  MM := ValInt0(copy(S,4,2));
  DD := ValInt0(copy(S,7,2));
  HH := ValInt0(copy(S,10,2));
  MN := ValInt0(copy(S,13,2));
  SS := ValInt0(copy(S,16,2));
  T  := EncodeDate(YY,MM,DD);
  T  := T + (SS + MN*60 + HH*3600) / SecsPerDay;
  Result := DateTimeToFileDate(T);
end;






function GetQuotedFldN(const S:string;D,DQ:char;N:integer):string;
(* выделить поле номер N из строки S                    *)
(* поля разделяются символом D и заключены в кавычки DQ *)
(* причем внутри кавычек допускается символ D           *)
(* счёт слов начинаем с 0                               *)
  var
    I,J,J1,L,P : integer;
    QPass2 : boolean;
  begin
    J := 0;
    L := length(S)+1;

    (* пропустим поля до искомого *)
    for I := 1 to N do begin
      (* идем на первую кавычку *)
      P := pos(DQ,Copy(S,J+1,L-J));
      J := J + P;

      QPass2 := false;
      (* идем на вторую кавычку *)
      while Not QPass2 do begin
        P := pos(DQ,Copy(S,J+1,L-J));
        J := J + P;
        (* если следующий символ опять кавычка, то
         пропускаем его и повторяем операцию "идти на вторую кавычку" *)
        P := pos(DQ,Copy(S,J+1,L-J));
        if P = 1 then J := J + P
                 else QPass2 := true;
      end; (* while *)

      P := pos(D,Copy(S,J+1,L-J)); (* здесь P должно быть = 1 *)
      J := J + P;
    end;

    (* искомое поле *)
    (* идем на первую кавычку *)
    P := pos(DQ,Copy(S,J+1,L-J));
    J := J + P;
    J1 := J;

    QPass2 := false;
    (* идем на вторую кавычку *)
    while Not QPass2 do begin
      P := pos(DQ,Copy(S,J+1,L-J));
      J := J + P;
      (* если следующий символ опять кавычка, то
       пропускаем его и повторяем операцию "идти на вторую кавычку" *)
      P := pos(DQ,Copy(S,J+1,L-J));
      if P = 1 then J := J + P
               else QPass2 := true;
    end; (* while *)
    J := J + P;

    GetQuotedFldN := Trim0(copy(S,J1+1,J-J1-3));
//  Tras('поле '+IntToStr(N)+' >'+copy(S,J+1,P-1))

  end;



function GetFldNWide(const S:string;D:char;N:integer):string;
(* то же, что GetFldN, но без удаления пробелов *)
  var
    I,J,L,P : integer;
  begin
    J := 0;
    L := length(S)+1;
    for I := 1 to N do begin
      P := pos(D,Copy(S,J+1,L-J));
//    if P > 0 then
      J := J + P;
    end;
    P := pos(D,Copy(S,J+1,L-J));
    if P = 0 then P := L-J;
    GetFldNWide := copy(S,J+1,P-1);
//  Tras('поле '+IntToStr(N)+' >'+copy(S,J+1,P-1))

  end;


{

unit swGLib; 

function StrToColor(const S:string):TColor;
(*  *)
Type
TAColStr = array[1..20] of string[9];
TAColDef = array[1..20] of TColor;

const
  ColStr : TAColStr =
  (
  'clBlack',
  'clMaroon',
  'clGreen',
  'clOlive',
  'clNavy',
  'clPurple',
  'clTeal',
  'clGray',
  'clSilver',
  'clRed',
  'clLime',
  'clYellow',
  'clBlue',
  'clFuchsia',
  'clAqua',
  'clLtGray',
  'clDkGray',
  'clWhite',
  'clNone',
  'clDefault'
  );
  ColDef : TAColDef =
  (
  clBlack,
  clMaroon,
  clGreen,
  clOlive,
  clNavy,
  clPurple,
  clTeal,
  clGray,
  clSilver,
  clRed,
  clLime,
  clYellow,
  clBlue,
  clFuchsia,
  clAqua,
  clLtGray,
  clDkGray,
  clWhite,
  clNone,
  clDefault
  );

  var
    I : integer;
  begin
    for I := 1 To 20 do begin
      if S = ColStr[I] then begin
        StrToColor := ColDef[I];
        Exit;
      end;
    end;
    StrToColor := clNone;
  end;(* StrToColor *)
}

function JustStr(S:string;L1:integer;Justify:shortint):string;
  var
    L  : integer;
    SS : string;
    LL : integer;
    L2 : integer;
    I  : integer;
  begin
    L := Length(S);
    if L > L1 then S := copy(S,1,L1);

    LL := L1 - L;
    SS := '';
    if LL > 0 then begin
      for I := 1 to LL do SS := SS + ' ';
      //FillChar(SS[1],LL,' ');

      Case Justify of
       JLeft1  : begin dec(LL); JustStr := ' '+S+copy(SS,1,LL) end;
       JLeft   : JustStr := S+SS;
       JCenter : begin
                   L2 := LL div 2;
                   LL := LL - L2;
                   JustStr := Copy(SS,1,L2)+S+Copy(SS,1,LL);
                 end;
       JRight  : JustStr := SS+S;
       JRight1 : begin dec(LL); JustStr := copy(SS,1,LL)+S+' ' end;
      end;
    end
    else JustStr := S;
  end;

(* дополнить строку справа пробелами до длины N *)
function SSt(S:string;N:integer):string;
var L : integer;
begin
  L := length(S);
  if L < N then begin
    SetLength(S,N);
    FillChar(S[L+1],N-L,' ');
  end;
  result := S;
end;


function ChSt(Ch:char;N:integer):string;  (* строка из одинаковых символов *)
var S : string;
begin
  SetLength(S,N);
  FillChar(S[1],N,Ch);
  result := S;
end;


function HWNDSt(h:HWND):string;
var S  : string;
    st : array[0..1023] of char;
begin
  S := HexP(h);
  GetWindowText(h, st, 1024); S := S + ' ' +  String(st);
  GetClassName (h, st, 1024); S := S + ' ' +  String(st);
  result := S;
end;



function JustL(S:string;L1:integer):string;
var L,I : integer;
begin
  L := Length(S); SetLength(S,L1);
  if L < L1 then FillChar(S[L+1],L1-L,' ') else
  if L > L1 then S[L1] := '*';
  JustL := S;
end;

function JustR(S:string;L1:integer):string;
  var L,I : integer;
  begin
    L := Length(S);
    if L > L1 then begin S := copy(S,2,L1); S := '*' + S; end;
    for I := 1 to L1-L do S := ' ' + S;
    JustR := S;
  end;

function JustRNoTrunc(S:string;L1:integer):string;
  var L,I : integer;
  begin
    L := Length(S);
    if L > L1 then begin {S := copy(S,2,L1); S := '*' + S;} end;
    for I := 1 to L1-L do S := ' ' + S;
    JustRNoTrunc := S;
  end;



(* не менее LMin символов из набора Chars *)
function StrInChars(S:string;Chars:CharSet;LMin:integer):boolean;
var I,L : integer;
begin
  result := false;
  L := length(S);
  if LMin > 0 then if L < LMin then Exit;
  for I := 1 to L do
    if Not (S[I] IN Chars) then Exit;
  result := true;
end;

(* все символы строки принадлежат набору Chars *)
function StrInChars(S:string;Chars:CharSet):boolean;
begin result := StrInChars(S,Chars,0) end;


function NotInChars(S:string;Chars:CharSet):integer;
var I,L : integer;
begin
  result := 0;
  L := length(S);
  for I := 1 to L do
  if Not (S[I] IN Chars) then begin result := I; Exit; end;
end;



function InDig(S:string):boolean;   (* в строке только цифры? *)
var I : integer;
begin
  Result := false;
  for I := 1 to length(S) do if Not (S[I] in SetDig) then Exit;
  Result := true;
end;

function InHex(S:string):boolean;
var I : integer;
begin
  Result := false;
  for I := 1 to length(S) do if Not (S[I] in SetHex) then Exit;
  Result := true;
end;


function InNumber(S:string):boolean;
var I : integer;
begin
  Result := false;
  for I := 1 to length(S) do if Not (S[I] in SetNumbers) then Exit;
  Result := true;
end;

function InFrameChar(C:char):boolean;
begin
  INFrameChar := (C IN SetFrameChars); // по умолчанию = ['|']
// SetFrameChars - переменная, к-рая может настраиваться до вызова ф-ии
end;


function HasCharSet(S:string;CS:CharSet):boolean;
var I : integer;
begin
  result := true;
  for I := 1 to length(S) do if (S[I] in CS) then Exit;
  result := false;
end;

(* подряд N символов в строке принадлежат CharSet *)
function HasCharSetN(S:string;CS:CharSet;N:integer):boolean;
var I,k : integer;
begin
  result := true;
  k := 0;
  for I := 1 to length(S) do begin
    if (S[I] in CS) then inc(k) else k := 0;
    if k = N then Exit;
  end;
  result := false;
end;

(* является ли символ номер J последним значащим в строке *)
function QLastSign(S:string;J:integer):boolean;
var I : integer;
begin
  result := false;
  for I := J+1 to length(S) do
    if Not (S[I] in [#10,#13,' ']) then exit;
  result := true;
end;


(* является ли символн Ch последним значащим символом в строке *)
function QLastSign(S:string;Ch:char):boolean;
var I : integer;
begin
  result := false;
  for I := length(S) downto 1 do begin
    if Not (S[I] in [#10,#13,' ']) then begin
      if S[I] = Ch then result := true;
      exit;
    end;
  end;
end;





function PurifyLet(S:string):string;
var W : string; I,J,N : integer; Ch : char;
begin
  N := length(S);
  setlength(W,N);
  J := 1;
  for I := 1 to N do begin
    if (Ch in SetLat) or
       (Ch in WinCyrSet) then begin
      W[J] := Ch; inc(J);
    end;
  end;
  setlength(W,J-1);
  result := W;
end;



(* удалить вхождения STpl из S *)
function SweepOut(S,STpl:string;QAnyCase:boolean):string;
var QDone : boolean; S2 : string; I,J,N : integer;
begin
  QDone := false;
  if QAnyCase then STpl := StrUpCase(STpl);

  while Not QDone do begin
    if QAnyCase then S2 := StrUpCase(S)
                else S2 := S;
    I := Pos(STpl,S2);
    if I = 0 then QDone := true
    else begin
      if I > 1 then S2 := copy(S,1,I-1) else S2 := '';
      J := (I+length(STpl));
      N := length(S) - J + 1;
      if N > 0 then S2 := S2 + copy(S,J,N);
      S := S2;
    end;
  end;
end;

(* предполагается что вся строка состоит из набора записей *)
(* которые начинаются с ключевого символа                  *)
(* (в конкретном случае это '#')                           *)
(* Из строки нужно изьять всё, что начинается с            *)
(* KeyChar + sKey вплоть до следующего появления KeyChar   *)
function SweepOutKey(KeyChar:char;sKey,S:string):string;
var P,PP : integer; SK : string;
begin
  P := pos(KeyChar+sKey,S);
  if P = 0 then begin result := S; Exit; end;
  SK := KeyChar;
  PP := swStr.PosP(SK,S,P+1);
  if PP = 0 then PP := length(S)+1;
  result := left(S,P-1)+rightfrom(S,PP);
end;

(* сделать запись числа в E-формате корректной *)
function sInsE(S:string):string;
var p : integer;
begin
  if (Not swStr.InNumber(S)) then begin result := S; Exit end;
  p := PosSet(['+','-'],RightFrom(S,2));
  if p > 0 then result := Left(S,p)+'E'+RightFrom(S,p+1)
           else result := S;
end;



(* отбросить комментарий из строки *)
procedure StripComment(var S,SCom:string);
var I : integer;
begin
  I := pos(SCom,S);
  if I = 0 then Exit;
  if I = 1 then begin S := ''; Exit end;
  S := copy(S,1,I-1);
end;


(*---------------------------------------------*)
(*--- в текстовой таблице выравнять колонки ---*)
(*---------------------------------------------*)
(*-------------------------------------------------*)
(*    Таблица понимается как набор строк, каждая   *)
(*    из которых имеет одинаковое количество слов  *)
(*    разделенных пробелами                        *)
(*                                                 *)
(* Версия процедуры Async позволяет иметь разное число слов в строке *)
(* строковые поля выравниваем влево *)
(* числовые поля выравниваем вправо *)
(* если есть десятичная точка, выравниваем по точке и прижимаем вправо *)
procedure LineTabStringsAsync(SL:TStrings);
var I,J,JP,JP0,L,IW,NW{,J1,J2} : integer;
  ALW,ALF,ALN,ALD,AIHd : array of integer; (* динамический массив *)
  AQN : array of boolean;
  S0,S,D,W0,W : string;
  JJ : integer;

  QNumb : boolean;
  IHead : integer;
  LF : integer;
  PP,LN,LD : integer;

  SL2 : TStringList;

begin
  NW := 0;
  for J := 0 to SL.Count-1 do begin
    IW := GetNWord(SL.Strings[J]);
    if IW > NW then NW := IW;
  end;

  SetLength(ALW,NW+1);
  SetLength(ALF,NW+1);
  SetLength(ALN,NW+1);
  SetLength(ALD,NW+1);
  SetLength(AIHd,NW+1);
  SetLength(AQN,NW+1);

  for I := 0 to NW do begin
    ALW[I] := 0;              (* макс. ширина слова в колонке   *)
    ALF[I] := 0;              (* макс.ширина колонки (поля)     *)
    ALN[I] := 0;              (* макс.число цифр ДО точки       *)
    ALD[I] := 0;              (* макс.кол-во знаков после точки *)
    AIHd[I] := 0;             (* кол-во нечисловых строк сверху *)
    AQN[I] := true;           (* это числовая колонка?          *)
  end;

  (* первый проход, определяем длины полей *)
  (*       и длины полей с учетом пробелов *)
{
  QNumb := true;
  IHead := 0;
  LD := 0;
  LN := 0;
}
  for J := SL.Count-1 downto 0 do begin (* нач.с нижней строки *)
    S  := SL.Strings[J];
    IW := GetNWord(SL.Strings[J]);
    JP := 1;                    (* тек.поз.для анализа строки *)
    for I := 1 to IW do begin   (* цикл по колонкам (полям)   *)
      JP0 := JP;                (* запоминаем текущ.позицию   *)
      W := StripBlanks(GetWord(S,JP)); (* тек.слово           *)
      LF := JP - JP0;           (* "размах" колонки           *)
      L := length(W);           (* длина слова в колонке      *)
      if L  > ALW[I] then ALW[I] := L;
      if LF > ALF[I] then ALF[I] := LF;

      if AQN[I] then begin      (* если колонка считается числовой *)
        if Not InNumber(W) then begin (* перестала быть числовой *)
          AQN[I]  := false;
          AIHd[I] := J+1; (* уст.высоту заголовка *)
        end
        else begin     (* текущ.поле - очередное число *)
          PP := pos('.',W);
          if PP > 0 then begin   (* есть десятичная точка в числе *)
            if (ALN[I] < PP-1)   then ALN[I] := PP-1;   (* цифры до точки *)
            if (ALD[I] < L - PP) then ALD[I] := L - PP; (* знаки после    *)
          end
          else if (ALN[I] < L) then ALN[I] := L; (* число без точки = целое *)
        end;
      end;
    end; (* for I - перебор полей *)
  end; (* for J - перебор строк *)




  (* уточняем размеры полей с учетом десятичных чисел *)
  for I := 1 to NW do begin
    if AIHd[I] <= 3 then     (* титульных строк не более трех *)
      if ALW[I] < ALN[I]+1+ALD[I] then
        if (ALD[I] > 0) then ALW[I] := ALN[I]+1+ALD[I];
  end;

  for I := 1 to NW do begin
    if ALD[I] = 0 then begin
      if ALW[I] < ALN[I] then ALW[I] := ALN[I] else
      if ALN[I] < ALW[I] then ALN[I] := ALW[I];
    end
    else begin
      if ALW[I] < ALN[I]+1+ALD[I] then ALW[I] := ALN[I]+1+ALD[I] else
      if ALN[I] < ALW[I]-1-ALD[I] then ALN[I] := ALW[I]-1-ALD[I];
    end;
  end;

  (* служебная строка из пробелов *)
  setlength(W0,255);
  FillChar(W0[1],255,' ');



  (* второй проход - выравниваем поля *)

  SL2 := TStringList.Create;

  for J := 0 to SL.Count-1 do begin  (* индекс строки в SL *)
    S0 := SL.Strings[J];
    JP := 1;
    S := '';
    D := ' ';
    JJ := J + 1;         (* номер строки в таблице *)
    IW := GetNWord(SL.Strings[J]);
    for I := 1 to IW do begin
      S := S + D; //copy(W0,1,AL[I]-AW[I]);
      W := StripBlanks(GetWord(S0,JP));
      if JJ <= AIHd[I] then S := S + JustL(W,ALW[I])
      else begin
        if ALD[I] = 0 then S := S + JustR(W,ALW[I]) else begin
          PP := pos('.',W);
          if PP = 0
          then S := S + JustR(W,ALN[I])+copy(W0,1,1+ALD[I])
          else S := S + JustR(copy(W,1,PP-1),ALN[I])+
                        JustL(copy(W,PP,length(W)-PP+1),ALD[I]+1);
        end;
      end;
      D := '  ';
    end;
    SL2.Add(S);
  end;
  SL.Clear;
  for J := 0 to SL2.Count-1 do SL.Add(SL2.Strings[J]);
  SL2.Clear;

end; (* LineTabStringsAsync *)


begin
  SetFrameChars := SetFrameChars_;
  ErrorNotification  := LocalWarn;
  ErrorNotificationP := LocalWarnP;

end.