unit MarshSearch;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Buttons, ComCtrls;

type
  TMarshSearchForm = class(TForm)
    Tree: TTreeView;
    Memo: TMemo;
    Panel1: TPanel;
    btOk: TBitBtn;
    btCancel: TBitBtn;
    Splitter1: TSplitter;
    btEdit: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btOkClick(Sender: TObject);
    procedure TreeClick(Sender: TObject);
    procedure btEditClick(Sender: TObject);
  private
    MachSeqDir: string;
    function AddMsqItemToTree(T: TTreeNode; sname: string): TTreeNode;
    procedure CreateList;
  public
    FileName: string;
    PrmStr: string;
//    SrcStr, DstStr: string;

  end;

  function FindAndCreateMarsh(PrmStr,edPrmText: string;
        var SCREEN_NUM: integer; var msq_filename: string): boolean;

implementation
uses HyperStr, numbers, MachSeqMon, MachTmpl;

{$R *.DFM}


function TMarshSearchForm.AddMsqItemToTree(T: TTreeNode; sname: string): TTreeNode;
var
  N,G: TTreeNode;
  s: string;
  i,k: integer;
begin
  k := pos('\', sname);
  if k=0 then begin
    N := Tree.Items.AddChild(T, sname);
  end else begin
    s := trim(copy(sname, 1, k-1));
    delete(sname, 1, k);
    sname := trim(sname);
    G := nil;

    for i:=0 to T.Count-1 do
      if T.Item[i].Data = nil then
        if T.Item[i].Text = s then begin
          G := T.Item[i];
          break;
        end;

    if G = nil then begin
      G := Tree.Items.AddChild(T, s);
      G.Data := nil;
    end;

    N := AddMsqItemToTree(G, sname);
  end;

  result := N;
end;

//============================================================================
// CREATE LIST
//============================================================================
procedure TMarshSearchForm.CreateList;
var
  sr: TSearchRec;
  F: TextFile;
  s,ss: string;
  i,v,k,flags: integer;
  p: pstring;

  spSCRIPT_ID,
  spSELEXPR,
  spNOFRIEND_ID,
  spNAME: string;

begin
  Tree.Items.Clear;
  Tree.Items.Add(nil, 'Маршруты');
  if FindFirst(MachSeqDir + '*.sm', faAnyFile, sr) = 0 then repeat

    // подготовка к чтению
    spSCRIPT_ID := '';
    spSELEXPR := '';
    spNOFRIEND_ID :='';
    spNAME := '';
    flags:=0;

    // чтение базовой инфы из скрипта
    AssignFile(F, MachSeqDir + sr.Name);
    Reset(F);
    while not(eof(F)) do begin
      Readln(F, s);
      s := trim(s);
      if copy(s,1,1)='#' then begin
        k := pos('=',s);
        ss := UpperCase(trim(copy(s, 2, k-2)));
        delete(s,1,k);

        if ss='SCRIPT_ID' then begin
          spSCRIPT_ID := s;
          flags := flags or $01;
        end;

        if ss='SELEXPR' then begin
          spSELEXPR := s;
          flags := flags or $02;
        end;

        if ss='NOFRIEND_ID' then begin
          spNOFRIEND_ID :=s;
          flags := flags or $04;
        end;

        if ss='NAME' then begin
          spNAME := s;
          flags := flags or $08;
        end;

        if flags = $0F then break;
      end;
    end;
    CloseFile(F);

    // проверка пригодности маршрута
    flags := 0;
    if not CheckFilterLogic(spSELEXPR, PrmStr, true) then flags := flags or $03;

    // добавление в дерево
    if flags=0 then begin
      with AddMsqItemToTree(Tree.TopItem, spName) do begin
        new(p);
        p^ := MachSeqDir + sr.Name;
        Data := p;
      end;
    end;

  until FindNext(sr)<>0;
  FindClose(sr);
  Tree.FullExpand;
//  Tree.TopItem.Expand(false);

  if Tree.Items.Count = 1 then begin
    ShowMessage('Маршрутов, подходящих под заданные параметры, не найдено!');
    PostMessage(handle, WM_CLOSE, 0, 0);
  end;
end;


procedure TMarshSearchForm.FormCreate(Sender: TObject);
begin
  MachSeqDir := CurDir + 'MachSeq\';
end;

procedure TMarshSearchForm.FormActivate(Sender: TObject);
begin
  CreateList;
end;

procedure TMarshSearchForm.FormDestroy(Sender: TObject);
var
  i: integer;
begin
  for i:=0 to Tree.Items.Count-1 do
    if Tree.Items[i].Data <> nil then
      dispose(pstring(Tree.Items[i].Data));
end;

procedure TMarshSearchForm.btOkClick(Sender: TObject);
begin
  if Tree.Selected = nil then exit;
  if Tree.Selected.Data = nil then exit;
  FileName := pstring(Tree.Selected.Data)^;
  ModalResult := mrOk;
end;


//============================================================================
// ЗАГРУЗКА ОПИСАНИЯ
//============================================================================
procedure TMarshSearchForm.TreeClick(Sender: TObject);
var
  F: TextFile;
  s: string;
  flag: boolean;
begin
  Memo.Lines.Clear;
  if Tree.Selected = nil then exit;
  if Tree.Selected.Data = nil then exit;

  // чтение базовой инфы из скрипта
  AssignFile(F, pstring(Tree.Selected.Data)^);
  Reset(F);
  flag := false;
  while not(eof(F)) do begin
    Readln(F, s);
    s := trim(s);
    if UpperCase(s)='#DESCR_BEGIN' then flag := true else
    if UpperCase(s)='#DESCR_END' then break else
    if flag then Memo.Lines.Add(s);
  end;
  CloseFile(F);
end;




//============================================================================
// ПОИСК И СОЗДАНИЕ МАРШРУТА ПО ЗАДАННЫМ ПАРАМЕТРАМ
//============================================================================
function FindAndCreateMarsh(PrmStr,edPrmText: string;
      var SCREEN_NUM: integer; var msq_filename: string): boolean;

var
  m: TMarshSearchForm;
  mr: integer;
  mstr: string;

  F: TextFile;
  spSCRIPT_ID,
  spNAME: string;
  spSCREEN_NUM: string;

  s,ss: string;
  i,k,flags: integer;
  flag: boolean;

  RcpList, MsqList, DscList: TStringList;
  DefStr: string;

    ///////////////////////////////////////////////////////////
    function PassSmLine(var sline: string): boolean;
    var
      s,ss: string;
      i,k1,k2: integer;
    begin
      sline := trim(sline);
      s := sline;

      if s='' then begin result := false; exit; end;
      if not(s[1]='{') then begin result := true; exit; end;

      delete(sline, 1, pos('}',sline));
      sline := trim(sline);
      s := trim(copy(s, 2, pos('}',s)-2));

      while true do begin
        k1 := pos('<',s);
        k2 := pos('>',s);
        if (k1>0) and (k2>0) and (k1<k2) then begin
          ss := copy(s, k1, k2-k1+1);
          k2 := pos(ss,DefStr);
          delete(s,k1,length(ss));
          insert(iif(k2>0,'TRUE','FALSE'),s,k1);
        end else
          break;
      end;

      result := CheckFilterLogic(s, PrmStr, false);
    end;
    ///////////////////////////////////////////////////////////

begin try
  result := false;

  RcpList := TStringList.Create;
  MsqList := TStringList.Create;
  DscList := TStringList.Create;

  // предпроверка
//  if (SrcStr='') or (DstStr='') then begin
//    ShowMessage('Перед выбором маршрута, укажите источник и назначение!');
//    exit;
//  end;

  // вызов поиска и выбора из списка
  if msq_filename = '' then begin
    m := TMarshSearchForm.Create(nil);
    m.PrmStr := PrmStr;
    mr := m.ShowModal;
    mstr := m.FileName;
    m.Free;
    if (mr<>mrOk) or (trim(mstr)='') then exit;
  end else
    mstr := msq_filename;

  // обработка:
  // - загрузка базовой инфы из скрипта
  spSCRIPT_ID := '';
  spSCREEN_NUM := '';
  spNAME := '';
  flags:=0;

  PrepIncludes( CurDir+'MachSeq', mstr, mstr+'.tmp');

  AssignFile(F, mstr+'.tmp');
  Reset(F);
  while not(eof(F)) do begin
    Readln(F, s);
    s := trim(s);
    if copy(s,1,1)='#' then begin
      k := pos('=',s);
      ss := UpperCase(trim(copy(s, 2, k-2)));
      delete(s,1,k);

      if ss='SCRIPT_ID' then begin
        spSCRIPT_ID := s;
//        flags := flags or $01;
      end;

      if ss='SCREEN_NUM' then begin
        spSCREEN_NUM := s;
        val(spSCREEN_NUM, SCREEN_NUM, i);
//        flags := flags or $02;
      end;

      if ss='NAME' then begin
        spNAME := s;
//        flags := flags or $04;
      end;

//      if flags = $07 then break;
    end;

    if UpperCase(copy(s,1,7))='#DEFINE' then begin
      ss := trim(copy(s,8,length(s)-7));
      if PassSmLine(ss) then DefStr := DefStr + ss;
    end;
  end;

  // - загрузка инфы для rcp-файла
  reset(F);
  s := '';
  while (not(eof(F))) and (not(UpperCase(trim(s))='#RCP_BEGIN')) do Readln(F, s);
  s := '';
  while (not(eof(F))) and (not(UpperCase(trim(s))='#RCP_END')) do begin
    if not((trim(s)='') or (copy(trim(s),1,2)='//')) then
      if PassSmLine(s) then RcpList.Add(s);
    Readln(F, s);
  end;

  // - загрузка инфы для msq-файла
  reset(F);
  s := '';
  while (not(eof(F))) and (not(UpperCase(trim(s))='#MSQ_BEGIN')) do Readln(F, s);
  s := '';
  while (not(eof(F))) and (not(UpperCase(trim(s))='#MSQ_END')) do begin
    if PassSmLine(s) then MsqList.Add(s);
    Readln(F, s);
  end;

  // - загрузка инфы описания
  reset(F);
  s := '';
  while (not(eof(F))) and (not(UpperCase(trim(s))='#DESCR_BEGIN')) do Readln(F, s);
  s := '';
  while (not(eof(F))) and (not(UpperCase(trim(s))='#DESCR_END')) do begin
    DscList.Add(s);
    Readln(F, s);
  end;
  CloseFile(F);
  Erase(F);

  // - формирование rcp-файла
  AssignFile(F, CurDir + 'Receipt\' + IntToStr(SCREEN_NUM) + '.rcp');
  rewrite(F);
  writeln(F,'//Автоматически сгенерированный файл контроля положения задвижек');
  writeln(F,'//Дата формирования: ' + DateTimeToStr(now));
//  writeln(F,'[Main]');
//  writeln(F,'RcpNum=1');
  writeln(F,'Rcp0=' + spNAME);
//  writeln(F,'ZdvNum=' + IntToStr(RcpList.Count));
  for i:=0 to RcpList.Count-1 do
//    writeln(F,'Zdv' + IntToStr(i) + '=' + RcpList.Strings[i]);
    writeln(F,RcpList.Strings[i]);
  CloseFile(F);

  // - формирование msq-файла
//  msq_filename := CurDir + 'MachSeq\ms_' + IntToStr(SCREEN_NUM) + '.msq';
  i:=80;
  while true do begin
    msq_filename := format('%sMachSeq\ms%.2d%.2d.msq', [CurDir, i, SCREEN_NUM]);
    if not FileExists(msq_filename) then break;
    flag := true;
    for k:=0 to MachSeqMonForm.List.Items.Count-1 do
      if uppercase(MachSeqMonForm.List.Items[k].Subitems[2]) =
            uppercase(msq_filename) then flag := false;
    if flag then break;        
    inc(i);
  end;

  AssignFile(F, msq_filename);
  rewrite(F);
  writeln(F,spNAME);
  writeln(F,'//'+StringOfChar('-', 128));
//  writeln(F,'//Автоматически сгенерированный файл описания маршрута');
  writeln(F,'//Дата формирования: ' + DateTimeToStr(now));
  write(F,edPrmText);
  for i:=0 to DscList.Count-1 do writeln(F, '// '+DscList.Strings[i]);
  writeln(F,'//'#13#10'//Строка вх.параметров: ' + PrmStr);
  writeln(F,'//  Идентификатор: ' + spSCRIPT_ID + '. Файл шаблона: ' + ExtractFileName(mstr));
  writeln(F,'//'+StringOfChar('-', 128));
  for i:=0 to MsqList.Count-1 do writeln(F, MsqList.Strings[i]);
  CloseFile(F);

  result := true;

  finally

  RcpList.Free;
  MsqList.Free;

  end;
end;


procedure TMarshSearchForm.btEditClick(Sender: TObject);
var
  MachTmplForm: TMachTmplForm;
  s: string;
begin
  if Tree.Selected = nil then exit;
  if Tree.Selected.Data = nil then exit;
  MachTmplForm := TMachTmplForm.Create(self);

  s := pstring(Tree.Selected.Data)^;
  MachTmplForm.fname := s;
  MachTmplForm.edFileName.Text := ExtractFileName(s);
  MachTmplForm.edPrms.Text := PrmStr;
  MachTmplForm.Memo.Lines.LoadFromFile(s);


  MachTmplForm.ShowModal;
  MachTmplForm.Free;
  TreeClick(nil);
end;

end.
