unit __SQLiteUpper;
interface
Uses
Classes,
SysUtils;
{
2024.02.22; roamer55.ru.
По следам статьи
«Полноценный upper (или lower) в SQLite при работе с unicode» (автор, к сожалению, не известен)
Ссылка на статью: https://habr.com/ru/sandbox/98493/
}
//----------------
//формирование SQL-запроса (UPPER) для списка заданных поисковых слов по значениям заданного поля таблицы БД (LIKE)
function ListWords_Filter_Create(fn:string; ListWords:TStrings; ListRes:TStrings; nrAndOr:boolean=true; tnAlias: string = 't9z'):integer;
//Сформировать фильтр для одного слова
function WordFilter_Create(fn:string; sWord:string; NrVar:integer=0; tnAlias: string = 't9z'):string;
//----------------
//----------------
//Формирование части SQL-запроса для одного поля таблицы БД.
//Идея взята отсюда: https://habr.com/ru/sandbox/98493/
function SQLite_Upper(fn:string; ListRes:TStrings; tnAlias:string='t9z'):integer; overload;
//Формирование части SQL-запроса для одного поля таблицы БД.
function SQLite_Upper(fn:string; tnAlias: string = 't9z'):string; overload;
//----------------
//----------------
//Вспомогательная
function SQLite_Upper_Char(sChar:string; sUnion:string='union'):string;
//нормализовать строку для SQL-запроса
function PrepareForSQL(Str: String): String;
//----------------
implementation
function SQLite_Upper(fn:string; tnAlias: string = 't9z'):string;
//Формирование части SQL-запроса для одного поля таблицы БД.
Var
ListRes:TStrings;
begin
Result:='';
ListRes := TStringList.Create;
TRY
if SQLite_Upper(fn, ListRes, tnAlias)>0 then begin
Result:=trim(ListRes.Text);
end;
FINALLY
FreeAndNil(ListRes);
END;
end;
function SQLite_Upper(fn:string; ListRes:TStrings; tnAlias:string='t9z'):integer;
//Формирование части SQL-запроса для одного поля таблицы БД.
//Идея взята отсюда: https://habr.com/ru/sandbox/98493/
begin
Result:=-1;
if Assigned(ListRes) then begin
ListRes.Clear;
fn:=trim(fn);
tnAlias:=trim(tnAlias);
if tnAlias='' then tnAlias := 't9z';
ListRes.Add('(');
ListRes.Add('WITH RECURSIVE');
ListRes.Add('under_name('+fn+', char, level) as');
ListRes.Add('(');
ListRes.Add('select '+tnAlias+'.'+fn+', '+#39+#39+', 0');
ListRes.Add('union');
ListRes.Add('select '+fn+', coalesce(lu.u,substr('+fn+',level,1)), under_name.level+1');
ListRes.Add('from under_name');
ListRes.Add('left join ');
ListRes.Add('(');
ListRes.Add(SQLite_Upper_Char('А', ''));
ListRes.Add(SQLite_Upper_Char('Б','union'));
ListRes.Add(SQLite_Upper_Char('В','union'));
ListRes.Add(SQLite_Upper_Char('Г','union'));
ListRes.Add(SQLite_Upper_Char('Д','union'));
ListRes.Add(SQLite_Upper_Char('Е','union'));
ListRes.Add(SQLite_Upper_Char('Ё','union'));
ListRes.Add(SQLite_Upper_Char('Ж','union'));
ListRes.Add(SQLite_Upper_Char('З','union'));
ListRes.Add(SQLite_Upper_Char('И','union'));
ListRes.Add(SQLite_Upper_Char('Й','union'));
ListRes.Add(SQLite_Upper_Char('К','union'));
ListRes.Add(SQLite_Upper_Char('Л','union'));
ListRes.Add(SQLite_Upper_Char('М','union'));
ListRes.Add(SQLite_Upper_Char('Н','union'));
ListRes.Add(SQLite_Upper_Char('О','union'));
ListRes.Add(SQLite_Upper_Char('П','union'));
ListRes.Add(SQLite_Upper_Char('Р','union'));
ListRes.Add(SQLite_Upper_Char('С','union'));
ListRes.Add(SQLite_Upper_Char('Т','union'));
ListRes.Add(SQLite_Upper_Char('У','union'));
ListRes.Add(SQLite_Upper_Char('Ф','union'));
ListRes.Add(SQLite_Upper_Char('Х','union'));
ListRes.Add(SQLite_Upper_Char('Ц','union'));
ListRes.Add(SQLite_Upper_Char('Ч','union'));
ListRes.Add(SQLite_Upper_Char('Ш','union'));
ListRes.Add(SQLite_Upper_Char('Щ','union'));
ListRes.Add(SQLite_Upper_Char('Ъ','union'));
ListRes.Add(SQLite_Upper_Char('Ы','union'));
ListRes.Add(SQLite_Upper_Char('Ь','union'));
ListRes.Add(SQLite_Upper_Char('Э','union'));
ListRes.Add(SQLite_Upper_Char('Ю','union'));
ListRes.Add(SQLite_Upper_Char('Я','union'));
ListRes.Add(')');
ListRes.Add('lu on substr('+fn+',level,1)=lu.l');
ListRes.Add('where level <= length('+fn+')');
ListRes.Add(')');
ListRes.Add('select group_concat(char,'+#39+''+#39+') from under_name');
ListRes.Add(')');
Result:=ListRes.Count;
end;
end;
function ListWords_Filter_Create(fn:string; ListWords:TStrings; ListRes:TStrings; nrAndOr:boolean=true; tnAlias: string = 't9z'):integer;
//формирование SQL-запроса (UPPER) для списка заданных поисковых слов по значениям заданного поля таблицы БД (LIKE)
Var
Sx, sWord:string;
iWord:integer;
begin
Result:=-1;
if Assigned(ListRes) then begin
ListRes.Clear;
fn:=trim(fn);
if fn<>'' then begin
iWord:=-1;
while iWord<(ListWords.Count-1) do
begin
iWord:=iWord+1;
sWord:=trim(ListWords[iWord]);
if sWord<>'' then begin
Sx:=trim(WordFilter_Create(fn, sWord, 0)); //Используем LIKE
if Sx<>'' then begin
if nrAndOr then begin
if ListRes.Count>0 then ListRes.Add(' and ');
end
else begin
if ListRes.Count>0 then ListRes.Add(' or ');
end;
ListRes.Add(' '+Sx+' ');
end;
end;
end;
end;
Result:=ListRes.Count
end;
end;
function WordFilter_Create(fn:string; sWord:string; NrVar:integer=0; tnAlias: string = 't9z'):string;
//Сформировать фильтр для одного слова
begin
Result:='';
sWord:=trim(sWord);
if sWord<>'' then begin
fn:=trim(fn);
if fn<>'' then begin
Result:='(';
sWord:=AnsiUpperCase(sWord);
fn:=SQLite_Upper(fn, tnAlias); //вызов функции SQLite_Upper !!!
sWord:=PrepareForSQL(sWord); //обработка одинарных кавычек
if (NrVar =0) then begin //LIKE
Result:=Result+' '+fn + ' like '+#39+sWord+#39;
end
else begin // =
Result:=Result+' '+fn + ' = '+#39+sWord+#39;
end;
Result:=Result+')';
end;
end;
end;
function SQLite_Upper_Char(sChar:string; sUnion:string='union'):string;
//Вспомогательная
begin
Result:='';
if length(sChar)=1 then begin
sUnion:=trim(sUnion);
Result:=sUnion+' select '+#39+AnsiUpperCase(sChar)+#39 + ' as u, ' + #39+AnsiLowerCase(sChar)+#39+' as l';
end;
end;
function ReplaceSymbol(str: string; oldsym, newsym: string): String;
//Замена символов в строке
var i, j: integer;
repstr, R: string;
s1, s2: String;
begin
s1 := oldsym;
s2 := Str;
i := pos(s1, s2);
if i > 0 then begin
R := '';
RepStr := Str;
while i > 0 do begin
R := R + copy(Repstr, 1, i - 1) + newsym;
repstr := copy(repstr, i + length(oldsym), length(Repstr));
i := pos(oldsym, Repstr);
end;
Result := R + RepStr;
end else
Result := Str;
end;
function PrepareForSQL(Str: String): String;
//нормализовать строку для SQL-запроса
begin
Result := ReplaceSymbol(Str, '''', '''''');
end;
end.