О применении библиотеки FastScript в своих проектах.
Часть-4 «Парсинг раздела «Uses» FS-скрипта».
Приложение-2. Дополнительные функции к разделу «Корректная выгрузка библиотечных FS-скриптов, хранящихся в БД, и «подключение» их к «вызывающему» FS-скрипту»

Исходные тексты дополнительных (существенных) функций, используемых в fsiBase_Main_Script_Mnemo_Prepare(…).

function DirName_from_List_EnvVars(List_EnvVars:TStrings):string;
//Получить полное имя папки для библиотечных файлов
begin
  Result:='';
  if Assigned(List_EnvVars) then begin
     if List_EnvVars.Count>0 then begin
        Result:=trim(List_EnvVars.Values['App_Dir']);
        Result:=Result+trim(List_EnvVars.Values['Scr_Dir']);
        Result:=Result+trim(List_EnvVars.Values['Lib_Dir']);
     end;
  end;
end;


function FS_LoadFromDB(Q:TFDQuery;
                       ScrMnemo:string;
                       ItsLibOnly:boolean=true
                      ):string;
//Загрузить FS-скрипт по МнемоКоду
Var
  sFilter:string;
begin
  Result:='';
  ScrMnemo:=trim(ScrMnemo);
  if ScrMnemo<>'' then begin
     sFilter:='(mnemocode_lc='+#39+AnsiLowerCase(ScrMnemo)+#39+')';
     if ItsLibOnly then begin
        sFilter:=sFilter+' and (its_lib=1)';
     end;
     Result:=DB_Table_Field_AsString(Q,
                                     'fs_scripts',
                                     'fs_script',
                                     sFilter
                                     );
  end;
end;


function Delete_start_String(Sx : string; Index:integer) : string;
//Удалить начало строки, начиная с 1-й позиции и до заданной (включая заданную)
begin
  Result:=Sx;
  if length(Sx)>0 then begin
     if Index>0 then begin
        System.Delete(Result, 1, Index);
     end;
  end;
end;


function Delete_end_String(Sx : string; Index:integer) : string;
//Удалить окончание строки, начиная с заданой позиции
begin
  Result:=Sx;
  if length(Sx)>0 then begin
     if Index>0 then begin
        System.Delete(Result, Index, length(Result)+1);
     end;
  end;
end;


function DB_Table_Field_AsString(Q:TFDQuery;
                                 tndb:string;
                                 fntn:string;
                                 sFilter:string;
                                 sValDef:string='';
                                 sOrderBy:string='';
                                 YesTrim:boolean=true):string;
//Получить значение заданного поля (как строка) заданной таблицы Б.Д. по заданному фильтру
Var
  Yes:boolean;
begin
  Result:=sValDef;
  tndb:=trim(tndb);
  fntn:=trim(fntn);
  if (length(tndb)>0) and (length(fntn)>0) then begin
      if Assigned(Q) then begin
         sFilter:=trim(sFilter);
         sOrderBy:=trim(sOrderBy);
         Yes:=false;
         Q.Close;
         Q.SQL.Clear;
         TRY
           Q.SQL.Add('select');
           Q.SQL.Add(fntn);
           Q.SQL.Add('from');
           Q.SQL.Add(tndb);
           if length(sFilter)>0 then begin
              Q.SQL.Add('where');
              Q.SQL.Add(sFilter);
           end;
           if length(sOrderBy)>0 then begin
              Q.SQL.Add('order by');
              Q.SQL.Add(sOrderBy);
           end;
           //Q.SQL.Add('limit 1');
           Q.Open;
           if Q.RecordCount>0 then begin
              if not Q.Fields[0].IsNull then begin
                 Result:=Q.Fields[0].AsString;
              end;
           end;
           Yes:=true;
         FINALLY
           Q.Close;
           if not Yes then begin
              ShowMessage(Q.SQL.Text);
           end;
           Q.SQL.Clear;
         END;
      end;
  end;
  if YesTrim then Result:=trim(Result);
end;


function Replace_In_String(const S, Srch, Replace: string; CaseIgnore:boolean=true): string;
//замена подстроки в строке
var
  N:Integer;
  Source:string;
begin
  Source:= S;
  Result:= '';
  repeat
    if CaseIgnore then begin
       N:=Pos(AnsiUpperCase(Srch), AnsiUpperCase(Source));
    end
    else begin
       N:=Pos(Srch, Source);
    end;
    if N>0 then begin
       Result:=Result+Copy(Source,1,N-1)+Replace;
       Source:=Copy(Source,N+Length(Srch),MaxInt);
    end
    else begin
      Result:=Result+Source;
    end;
  until N<=0;
end;


function Files_Delete(NameMask: String): integer;
//Удалить файлы по маске
Var
  DirInfo: TSearchRec;
  Err: integer;
begin
  Result := 0;
  Err := 0;
  Err := FindFirst(NameMask, faArchive, DirInfo);
  while Err = 0 do
   begin
    if DeleteFile(ExtractFilePath(NameMask) + DirInfo.Name) then begin
       Result := Result + 1;
    end;
    Err := FindNext(DirInfo);
  end;
  FindClose(DirInfo);
end;

07.04.2024  roamer55.ru