unit fs04_up_01_main;

interface

uses
  fs04_up_00_lib,

  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.ComCtrls,
  Vcl.Buttons, fs_synmemo, FireDAC.Stan.Intf, FireDAC.Stan.Option,
  FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
  FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.SQLite,
  FireDAC.Phys.SQLiteDef, FireDAC.Stan.ExprFuncs, FireDAC.VCLUI.Wait,
  FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, Data.DB,
  FireDAC.Comp.DataSet, FireDAC.Comp.Client, Vcl.Menus, Vcl.Grids, Vcl.DBGrids,
  FireDAC.Phys.SQLiteWrapper.Stat;

type
  TfMain = class(TForm)
    Panel1: TPanel;
    Labelr55: TLabel;
    pcMain: TPageControl;
    tsFiles: TTabSheet;
    GroupBox1: TGroupBox;
    Panel2: TPanel;
    Splitter1: TSplitter;
    Memo_EV: TMemo;
    GroupBox2: TGroupBox;
    fsSyntaxMemo1: TfsSyntaxMemo;
    Splitter2: TSplitter;
    Panel3: TPanel;
    SpeedButton1: TSpeedButton;
    Panel4: TPanel;
    GroupBox3: TGroupBox;
    fsSyntaxMemo2: TfsSyntaxMemo;
    tsDB: TTabSheet;
    FDConn: TFDConnection;
    qTMP: TFDQuery;
    qScr: TFDQuery;
    qScrnpp: TIntegerField;
    qScrmnemocode: TStringField;
    qScrid: TFDAutoIncField;
    qScrfs_script: TWideMemoField;
    dsScr: TDataSource;
    qScrits_lib: TBooleanField;
    qScrmnemocode_lc: TStringField;
    GroupBox4: TGroupBox;
    DBGrid_Scr: TDBGrid;
    Splitter3: TSplitter;
    Panel5: TPanel;
    Splitter4: TSplitter;
    GroupBox5: TGroupBox;
    fsSyntaxMemo3: TfsSyntaxMemo;
    Panel6: TPanel;
    sbFS_Parsing_from_DB: TSpeedButton;
    Panel7: TPanel;
    GroupBox6: TGroupBox;
    fsSyntaxMemo4: TfsSyntaxMemo;
    Panel8: TPanel;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FDConnBeforeConnect(Sender: TObject);
    procedure pcMainChange(Sender: TObject);
    procedure qScrAfterOpen(DataSet: TDataSet);
    procedure qScrBeforeClose(DataSet: TDataSet);
    procedure qScrAfterScroll(DataSet: TDataSet);
    procedure sbFS_Parsing_from_DBClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fMain: TfMain;


//Выгрузка скриптов из БД. Парсинг скрипта
function fsiBase_Main_Script_Mnemo_Prepare(Q:TFDQuery;
                                           scrText:TStrings;
                                           List_EnvVars:TStrings
                                           ):boolean;
//Переменные окружения. Парсинг скрипта
function fsiBase_Main_Script_EnvVars_Prepare(
                                             scrText:TStrings;
                                             List_EnvVars:TStrings
                                            ):boolean; overload;
//Переменные окружения. Парсинг скрипта
function fsiBase_Main_Script_EnvVars_Prepare(
                                             sScript:string;
                                             List_EnvVars:TStrings
                                            ):string;overload;
//Выделить мнемокод из строки
function Mnemo_Extract(Sx:string):string;
//замена подстроки в строке
function Replace_In_String(const S, Srch, Replace: string; CaseIgnore:boolean=true): string;
//Удалить окончание строки, начиная с заданой позиции
function Delete_end_String(Sx : string; Index:integer) : string;
//Удалить начало строки, начиная с 1-й позиции и до заданной (включая заданную)
function Delete_start_String(Sx : string; Index:integer) : string;
//Получить значение заданного поля (как строка) заданной таблицы Б.Д. по заданному фильтру
function DB_Table_Field_AsString(Q:TFDQuery;
                                 tndb:string;
                                 fntn:string;
                                 sFilter:string;
                                 sValDef:string='';
                                 sOrderBy:string='';
                                 YesTrim:boolean=true):string;
//Загрузить FS-скрипт по МнемоКоду
function FS_LoadFromDB(Q:TFDQuery;
                       ScrMnemo:string;
                       ItsLibOnly:boolean=true
                      ):string;
//Создать папку (каталог)
function Dir_Create(DirName: String): boolean;
//Удалить файлы по маске
function Files_Delete(NameMask: String): integer;
//Получить полное имя папки для библиотечных файлов
function DirName_from_List_EnvVars(List_EnvVars:TStrings):string;

implementation

{$R *.dfm}

procedure TfMain.FormCreate(Sender: TObject);
begin
  MainDir:=ExtractFilePath(ParamStr(0));
  //Папка программы
  Memo_EV.Lines.Values['App_Dir']:=MainDir;
  //Создать папку для сохранения библиотечных файлов из БД
  Dir_Create(DirName_from_List_EnvVars(Memo_EV.Lines));
end;

procedure TfMain.FormShow(Sender: TObject);
begin
  pcMain.ActivePage:=tsFiles;
  if DirectoryExists(DirName_from_List_EnvVars(Memo_EV.Lines)) then begin
     //Удалить все PAS-файлы из папки (если требуется)
     //Files_Delete(DirName_from_List_EnvVars(Memo_EV.Lines)+'*.pas');
  end;
end;


procedure TfMain.FDConnBeforeConnect(Sender: TObject);
begin
  FDConn.Params.Values['Database'] := MainDir+'FS_04_uses_parsing.db';
end;


procedure TfMain.pcMainChange(Sender: TObject);
begin
  Application.ProcessMessages;
  qScr.Close;
  fsSyntaxMemo3.Lines.Clear;
  fsSyntaxMemo4.Lines.Clear;
  if pcMain.ActivePage=tsDB then begin
     qScr.Open;
  end;
end;

procedure TfMain.qScrAfterOpen(DataSet: TDataSet);
begin
  fsSyntaxMemo3.Lines.Clear;
  fsSyntaxMemo4.Lines.Clear;
  if qScrid.AsInteger>0 then begin
     fsSyntaxMemo3.Lines.Text:=qScrfs_script.AsString;
  end;
end;


procedure TfMain.qScrAfterScroll(DataSet: TDataSet);
begin
  fsSyntaxMemo3.Lines.Clear;
  fsSyntaxMemo4.Lines.Clear;
  if qScrid.AsInteger>0 then begin
     fsSyntaxMemo3.Lines.Text:=qScrfs_script.AsString;
  end;
end;

procedure TfMain.qScrBeforeClose(DataSet: TDataSet);
begin
  fsSyntaxMemo3.Lines.Clear;
  fsSyntaxMemo4.Lines.Clear;
end;

procedure TfMain.SpeedButton1Click(Sender: TObject);
begin
  Application.ProcessMessages;
  fsSyntaxMemo2.Lines.Text:=fsSyntaxMemo1.Lines.Text;
  fsiBase_Main_Script_EnvVars_Prepare(
                                      fsSyntaxMemo2.Lines,
                                      Memo_EV.Lines
                                     );
end;

procedure TfMain.sbFS_Parsing_from_DBClick(Sender: TObject);
begin
  Application.ProcessMessages;
  fsSyntaxMemo4.Lines.Clear;
  if DirectoryExists(DirName_from_List_EnvVars(Memo_EV.Lines)) then begin
     //удалить все PAS-файлы из папки (если требуется)
     //Files_Delete(DirName_from_List_EnvVars(Memo_EV.Lines)+'*.pas');
     if qScrid.AsInteger>0 then begin
        fsSyntaxMemo4.Lines.Text:=fsSyntaxMemo3.Lines.Text;
        //...........................................
        //Парсинг раздела Uses скрипта и выгрузка
        //соответствующих библиотечных скриптов из БД
        //в файлы
        fsiBase_Main_Script_Mnemo_Prepare(qTMP,
                                          fsSyntaxMemo4.Lines,
                                          Memo_EV.Lines
                                         );
        //...........................................
        //...........................................
        //Парсинг скрипта. Переменные окружения
        fsiBase_Main_Script_EnvVars_Prepare(
                                            fsSyntaxMemo4.Lines,
                                            Memo_EV.Lines
                                           );
        //...........................................
     end;
  end
  else begin
     ShowMessage('Ошибка! Не найдена папка для выгрузки библиотечных скриптов из БД');
  end;
end;

function fsiBase_Main_Script_Mnemo_Prepare(Q:TFDQuery;
                                           scrText:TStrings;
                                           List_EnvVars:TStrings
                                           ):boolean;
//Выгрузка библиотечных скриптов из БД. Парсинг скрипта
Var
  ListScr:TStrings;
  sDir, sMnemo:string;
  Sx:string;
  InUses:boolean;
  N,i:integer;
begin
  Result:=false;
  if Assigned(Q) then begin
     if Assigned(List_EnvVars) then begin
        if List_EnvVars.Count>0 then begin
           //Получить имя папки для сохранения библиотечных файлов из БД
           sDir:=DirName_from_List_EnvVars(List_EnvVars);
           if DirectoryExists(sDir) then begin
              //удалить все PAS-файлы из папки (если требуется)
              //Files_Delete(sDir+'*.pas');
              if Assigned(scrText) then begin
                 if scrText.Count>0 then begin
                    Result:=true;
                 end;
              end;
           end;
        end;
     end;
  end;
  if Result then begin
     //---------------------------------------------------
     //Поиск раздела USES и его парсинг
     ListScr:=TStringList.Create;
     TRY
       InUses:=false;
       i:=-1;
       while i<(scrText.Count-1) do
        begin
         i:=i+1;
         Sx:=trim(scrText[i]);
         sMnemo:='';
         if InUses then begin
            if Sx<>'' then begin
               //................................
               //Выделить мнемокод из строки FS-скрипта
               //если он там присутствует
               sMnemo:=Mnemo_Extract(Sx);
               //................................
               if sMnemo<>'' then begin
                  //................................
                  //Загрузить скрипт из БД
                  ListScr.Text:=FS_LoadFromDB(Q,
                                              sMnemo,
                                              true);
                  //................................
                  if ListScr.Count>0 then begin
                     //Сохранить срипт в папку
                     ListScr.SaveToFile(sDir+sMnemo+'.pas');
                  end;
                  ListScr.Text:='';
                  //................................
                  //Заменить строку в скрипте
                  Sx:=Replace_In_String(scrText[i], '${'+sMnemo+'}', sMnemo+'.pas', true);
                  scrText[i]:=Sx;
                  //................................
               end;
            end;
         end;
         //................................
         //................................
         //Определение начала раздела Uses FS-Скрипта
         if AnsiUpperCase(Sx) = 'USES' then InUses:=true;
         //................................
         if InUses then begin
            //................................
            //Оценка: это конец раздела USES?
            if Sx<>'' then begin
               if Sx[length(Sx)]=';' then begin
                  InUses:=false;
                  i:=(scrText.Count+1); //Выход из парсинга
               end;
            end;
            //................................
         end;
       end;
     FINALLY
       FreeAndNil(ListScr);
     END;
     //---------------------------------------------------
  end;
end;


function fsiBase_Main_Script_EnvVars_Prepare(
                                             scrText:TStrings;
                                             List_EnvVars:TStrings
                                            ):boolean;
//Переменные окружения. Парсинг скрипта
//  scrText - текст скрипта (TStrings)
//  List_EnvVars - список значений преременных окружения
begin
  Result:=false;
  if Assigned(scrText) then begin
     if scrText.Count>0 then begin
        Result:=true;
        if Assigned(List_EnvVars) then begin
           if List_EnvVars.Count>0 then begin
              scrText.Text := fsiBase_Main_Script_EnvVars_Prepare(
                                                                  scrText.Text,
                                                                  List_EnvVars
                                                                 );
           end;
        end;
     end;
  end;
end;

function fsiBase_Main_Script_EnvVars_Prepare(
                                             sScript:string;
                                             List_EnvVars:TStrings
                                            ):string;
//Переменные окружения. Парсинг скрипта
//  sScript - текст скрипта
//  List_EnvVars - список значений преременных окружения
Var
  vn,vv:string;
  i:integer;
begin
  Result:='';
  if Assigned(List_EnvVars) then begin
     if List_EnvVars.Count>0 then begin
        Result:=sScript;
        i:=-1;
        while i<(List_EnvVars.Count-1) do
         begin
           i:=i+1;
           vn:=trim(List_EnvVars.Names[i]);
           if length(vn)>0 then begin
              vv:=trim(List_EnvVars.Values[vn]);
              if length(vv)>0 then begin
                 Result:=Replace_In_String(Result, '$('+vn+')', vv, true);
              end;
           end;
        end;
     end;
  end;
end;

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 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 Mnemo_Extract(Sx:string):string;
//Выделить мнемокод из строки
Var
  N:integer;
begin
  Result:='';
  Sx:=trim(Sx);
  N:=POS('${',Sx);
  if N>0 then begin
     Sx:=trim(Delete_start_String(Sx, N+1));
     N:=POS('}',Sx);
     if N>0 then begin
        Result:=trim(Delete_end_String(Sx, N));
     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 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 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 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 Dir_Create(DirName: String): boolean;
//Создать папку (каталог)
begin
  Result := false;
  DirName := trim(DirName);
  if length(DirName) > 0 then begin
     if DirName[length(DirName)] <> '\' then DirName := DirName + '\';
     Result := ForceDirectories(DirName);
     if Result then begin
        Result := DirectoryExists(DirName);
     end;
  end;
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;


end.