unit ShlepsUtils;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Process, Pipes;

Function GetNextToken(S:String;Var ParsedS:String;Delimiter:String):String;
Function GetNextTokenEx(S:String;Var ParsedS:String;Delimiter:String):String;
Function GetLastTokenEx(S:String;Var ParsedS:String;Delimiter:String):String;
Function GetValByName(S, Name:String):String;
Function GetWordByNumber(Line:String;WordNumber:Longint;Delimiters:String;Var Mask:Longint):String;
Function WordCount(Line:String;Delimiters:String):Longint;
Function OSPath(Path:String):String;
Function EnumFilesInDir(Dir,wildcard:String):TStringlist;
Function EnumDirsInDir(Dir,wildcard:String):TStringList;
Function FindInSubDir(Dir,Name:String):String;//return nothing or full path to the template
Function FilterEnter(S:String):String;
Function FilterSymbol(S:String;Sym:String):String;

Function TimeCode2DateTime(TCode,Format:String):TDateTime;
Function DateTime2TimeCode(DT:TDateTime;Format:String):String;

Procedure LogMessage(Level:Longint;Msg:String);
Function GetResponce(CLI:String;Var ErrCode:Longint):String;
Function GetLines(CLI:String):TStringList;


Var
  LogLevel:Longint;
  LogFile:Text;

implementation
//uses unit1;

Function GetNextToken(S:String;Var ParsedS:String;Delimiter:String):String; //error fixed on 20100215
// multisymbol delimiter
// more than one consequential delimiter in the string considered as different delimiters
Var P:Longint;
Begin P:=Pos(Delimiter,S);
      If P=0 Then Begin ParsedS:='';Result:=S;Exit;End;
      ParsedS:=Copy(S,P+Length(Delimiter),Length(S)-P-Length(Delimiter)+1);
      Result:=Copy(S,0,P-1);
End;

Function GetNextTokenEx(S:String;Var ParsedS:String;Delimiter:String):String;
// cut Delimiters from the beginning of line
// multisymbol delimiter
// more than one consequential delimiters in the string considered as a single delimiter
Var P,DelimCount:Longint;
    InternalS:String;
Begin
      InternalS:=S;DelimCount:=0;
      While Pos(Delimiter,InternalS)=1 Do Begin
        InternalS:=Copy(InternalS,Length(Delimiter)+1,Length(InternalS)-(Length(Delimiter))); //cut Delimiters from beginning of line
        Inc(DelimCount);
      end;
      P:=Pos(Delimiter,InternalS);
      If P=0 Then Begin ParsedS:='';Result:=InternalS;Exit;End;
      ParsedS:=Copy(InternalS,P+Length(Delimiter),Length(InternalS)-P-Length(Delimiter)+1);
      While Pos(Delimiter,ParsedS)=1 Do
        ParsedS:=Copy(ParsedS,Length(Delimiter)+1,Length(ParsedS)-(Length(Delimiter))); //cut Delimiters from beginning of ParsedS
      Result:=Copy(InternalS,0,P-1);
End;

Function GetLastTokenEx(S:String;Var ParsedS:String;Delimiter:String):String;
// cut Delimiters from the end of line
// multisymbol delimiter
// more than one consequential delimiters in the string considered as a single delimiter
Var P,I:Longint;
Begin While Copy(S,Length(S)-Length(Delimiter)+1,Length(S))=Delimiter Do
        S:=Copy(S,1,Length(S)-Length(Delimiter)); //cut Delimiters from end of line
      P:=0;
      For I:=Length(S) DownTo 1 Do
        If Copy(S,I,Length(Delimiter))=Delimiter Then Begin P:=I;Break;End;
//      P:=Pos(Delimiter,S); с конца

      If P=0 Then Begin ParsedS:='';Result:=S;Exit;End;
      Result:=Copy(S,P+Length(Delimiter),Length(S)-P-Length(Delimiter)+1);
      ParsedS:=Copy(S,0,P-1);

      While Copy(ParsedS,Length(ParsedS)-Length(Delimiter)+1,Length(ParsedS))=Delimiter Do
        ParsedS:=Copy(ParsedS,1,Length(ParsedS)-Length(Delimiter)); //cut Delimiters from end of line

End;

Function GetValByName(S, Name:String):String;
// parse strings of following forms
// Name1=Val1  Name2=val2 name3=val3
// Name1="Val1 with spaces" Name2=val2 name3=val3
Var P,PP,I,L,WordPos,Mask:Longint;
    SS,Buf,B,PB:String;
    Found:Boolean;
Begin
  If Pos('"',S)=0 Then Begin
    If Pos(Name+'=',S)=1 Then P:=1 Else Begin
      P:=Pos(' '+Name+'=',S)+1;
      If P=1 Then Begin Result:=''; Exit; End;
    End; //Тривиальный вариант - без кавычек
  End Else Begin
     //ищем "имя="  только вне кавычек
    B:=S;WordPos:=0;
    Repeat
      Buf:=GetNextToken(B,PB,'"');
      B:=PB;
//      Form1.Label5.Caption:=INtToStr(Pos(Name+'=',Buf));
      If Pos(Name+'=',Buf)>0 Then Begin //нашли в первом куске
        WordPos:=WordPos+Pos(Name+'=',Buf);Break;
      End Else Begin
        // 1111"22 22"33333
        // пропускаем 1111"
        WordPos:=WordPos+Length(Buf)+1;
        // не нашли в первом куске - надо пропустить и внутри кавычек, чтобы дальше искать в 33333
        Buf:=GetNextToken(B,PB,'"');
        B:=PB;
        WordPos:=WordPos+Length(Buf)+1;
      End;
    Until (Buf='');
    P:=WordPos;
  End;
  L:=Length(Name);
  I:=P+Length(Name)+1;
  If I>Length(S) Then Begin Result:='';Exit;End; //последний параметр - пустой
  If S[I]='"' Then Begin
    //берем кусок до следующих кавычек, включая пробелы
    Found:=False;
    For I:=P+Length(Name)+2 To Length(S) Do Begin
      If S[I]='"' Then Begin Found:=True;Break;End;
    End;
    If Found Then Result:=Copy(S,P+Length(Name)+2,I-(P+Length(Name)+2)) Else {ошибка - нет закрывающих кавычек};
  End Else Begin
    //берем кусок до следующего пробела
    Found:=False;
    For I:=P+Length(Name)+1 To Length(S) Do Begin
      If S[I]=' ' Then Begin Found:=True;Break;End;
    End;
    If Found Then Result:=Copy(S,P+Length(Name)+1,I-(P+Length(Name)+2)+1)
    Else Result:=Copy(S,P+Length(Name)+1,I-(P+Length(Name)))
  End;
End;

Function OSPath(Path:String):String;
Var I,P:Longint;Buf:String;
Begin
  Buf:=Path;
{$IFDEF LINUX}
        For I:=1 To Length(Buf) Do
          If (Buf[I]='|') Or (Buf[I]='\') Then Buf[I]:='/';
        Repeat
          P:=Pos('//',Buf);
          If P>0 Then Delete(Buf,P,1);
        Until P=0;
{$ELSE}
        For I:=1 To Length(Buf) Do
          If (Buf[I]='|') Or (Buf[I]='/') Then Buf[I]:='\';
        Repeat
          P:=Pos('\\',Buf);
          If P>0 Then Begin
            Delete(Buf,P,1);
          end;
        Until P=0;

{$ENDIF}
  Result:=Buf;
End;

Function EnumFilesInDir(Dir,wildcard:String):TStringlist;
Var SPath,Buf:String;
    SearchRec:TSearchRec;SResult,N,Count:Longint;
    Res:TStringList;
Begin
    Res:=TStringList.Create;
    SResult:=FindFirst(OSPath(Dir+'/'+WildCard),faAnyFile-faDirectory,SearchRec);
    While SResult=0 Do Begin
      Res.Add(SearchRec.Name);
      SResult:=FindNext(SearchRec);
    End;
    FindClose(SearchRec);
    Result:=Res;
end;

Function EnumDirsInDir(Dir,wildcard:String):TStringlist;
Var SPath,Buf:String;
    SearchRec:TSearchRec;SResult,N,Count:Longint;
    Res:TStringList;
Begin
    Res:=TStringList.Create;
    SResult:=FindFirst(OSPath(Dir+'/'+WildCard),faDirectory,SearchRec);
    While SResult=0 Do Begin
      If (SearchRec.Name<>'..') And (SearchRec.Name<>'.') And ((SearchRec.Attr and faDirectory)>0) Then Res.Add(SearchRec.Name);
      SResult:=FindNext(SearchRec);
    End;
    FindClose(SearchRec);
    Result:=Res;
end;

Function FindInSubDir(Dir,Name:String):String;//return nothing or full path to the template
Var SPath,Buf:String;
    SearchRec:TSearchRec;SResult,N,Count:Longint;
Begin
      Result:='';
      SResult:=FindFirst(OSPath(Dir+'/*'),faAnyFile-faDirectory,SearchRec);
      While SResult=0 Do Begin
        If (SearchRec.Name=Name+'.tpg') Or (SearchRec.Name=Name+'.scn') Then Begin
          Result:=OSPath(Dir+'/'+SearchRec.Name);FindClose(SearchRec);Exit;
        end;
        SResult:=FindNext(SearchRec);
      End;
      FindClose(SearchRec);
      SResult:=FindFirst(OSPath(Dir+'/*'),faDirectory,SearchRec);
      While SResult=0 Do Begin
        If (SearchRec.Attr And faDirectory)<>0 Then Begin
          If (SearchRec.Name<>'.') And (SearchRec.Name<>'..') Then Begin
            Buf:=FindInSubDir(OSPath(Dir+'/'+SearchRec.Name),Name);
            If Buf<>'' Then Begin Result:=Buf;FindClose(SearchRec);Exit; End;
          End;
        End;
        SResult:=FindNext(SearchRec);
      End;
    FindClose(SearchRec);
end;

Function FilterEnter(S:String):String;
Var p:Longint;S1:String;
Begin
  S1:=S;
  While Pos(#10,S1)<>0 Do
    Delete(S1,Pos(#10,S1),1);
  While Pos(#13,S1)<>0 Do
    Delete(S1,Pos(#13,S1),1);

  Result:=S1;
End;

Function FilterSymbol(S:String;Sym:String):String;
Var p:Longint;S1:String;
Begin
  S1:=S;
  While Pos(Sym,S1)<>0 Do
    Delete(S1,Pos(Sym,S1),1);
  Result:=S1;
End;

Function WordCount(Line:String;Delimiters:String):Longint;
// считает количество слов в строке, между которыми есть один или более односимвольных разделителей из списка
Var I,WC:Longint;
    State:Char;// S - start, D - delimiter, T - text
    Word:String;
Begin
    If Line='' Then Begin Result:=0;Exit;End;
    State:='S';WC:=0;Word:='';
    For I:=1 To Length(Line) Do Begin
      Case State of
      'S': Begin
             If Pos(Line[I],Delimiters)>0 Then Begin
               State:='D';
             End Else Begin
               State:='T';Inc(WC);
             End;
           End;
      'D': Begin
             If Pos(Line[I],Delimiters)>0 Then Begin
               State:='D';
             End Else Begin
               State:='T';Inc(WC);
             End;
           End;
      'T': Begin
             If Pos(Line[I],Delimiters)>0 Then Begin
               State:='D';
             End Else Begin
               State:='T';
             End;
           End;
      End;
    End;
    Result:=WC;
End;


Function GetWordByNumber(Line:String;WordNumber:Longint;Delimiters:String;Var Mask:Longint):String;
// берет строку и возвращает заданное по счёту (1-based) слово, используя в качестве разделителей отдельные символы из Delimiters
// в Mask возвращает 0, если слово найдено и -2 если слова с таким номером нет (предложение короче, чем ожидалось)
Var I,WC:Longint;
    State:Char;// S - start, D - delimiter, T - text
    Word:String;
Begin
    If Line='' Then Begin Result:='';Mask:=-2;Exit; End;
    State:='S';WC:=0;Word:='';
    For I:=1 To Length(Line) Do Begin
      Case State of
      'S': Begin
             If Pos(Line[I],Delimiters)>0 Then Begin
               State:='D';
             End Else Begin
               State:='T';Inc(WC);
               If WC=WordNumber Then Break; //если стоим на начале нужного слова то выходим
             End;
           End;
      'D': Begin
             If Pos(Line[I],Delimiters)>0 Then Begin
               State:='D';
             End Else Begin
               State:='T';Inc(WC);
               If WC=WordNumber Then Break;
             End;
           End;
      'T': Begin
             If Pos(Line[I],Delimiters)>0 Then Begin
               State:='D';
             End Else Begin
               State:='T';
             End;
           End;
      End;
    End;
    If (WC<>WordNumber) Then Begin
      Mask:=-2;
      Result:='';
      Exit;
    End;
    While (I<=Length(Line))And(Pos(Line[I],Delimiters)=0) Do Begin
      Word:=Word+Line[I];
      Inc(I);
    End;
    Result:=Word;Mask:=0;
End;

Function DateTime2TimeCode(DT:TDateTime;Format:String):String;
Var Y,M,D,h,mn,s,ms:Word;
    ParsedFormat,Res,Tmp:String;
Begin
  DecodeDate(DT,Y,M,D);
  DecodeTime(DT,h,mn,s,ms);
  ParsedFormat:=Format;
  Res:='';
  Repeat
    If Pos('YYYY',ParsedFormat)=1 Then Begin
      ParsedFormat:=Copy(ParsedFormat,5,Length(ParsedFormat)-4);
      Res:=Res+IntToStr(Y);
      Continue;
    End;
    If Pos('YY',ParsedFormat)=1 Then Begin
      ParsedFormat:=Copy(ParsedFormat,3,Length(ParsedFormat)-2);
      Res:=Res+Copy(IntToStr(Y),Length(IntToStr(Y))-2,2);
      Continue;
    End;
    If Pos('MM',ParsedFormat)=1 Then Begin
      ParsedFormat:=Copy(ParsedFormat,3,Length(ParsedFormat)-2);
      Tmp:=IntToStr(M);
      If Length(Tmp)=1 Then Tmp:='0'+Tmp;
      Res:=Res+Tmp;
      Continue;
    End;
    If Pos('DD',ParsedFormat)=1 Then Begin
      ParsedFormat:=Copy(ParsedFormat,3,Length(ParsedFormat)-2);
      Tmp:=IntToStr(D);
      If Length(Tmp)=1 Then Tmp:='0'+Tmp;
      Res:=Res+Tmp;
      Continue;
    End;
    If Pos('hh',ParsedFormat)=1 Then Begin
      ParsedFormat:=Copy(ParsedFormat,3,Length(ParsedFormat)-2);
      Tmp:=IntToStr(H);
      If Length(Tmp)=1 Then Tmp:='0'+Tmp;
      Res:=Res+Tmp;
      Continue;
    End;
    If Pos('mm',ParsedFormat)=1 Then Begin
      ParsedFormat:=Copy(ParsedFormat,3,Length(ParsedFormat)-2);
      Tmp:=IntToStr(mn);
      If Length(Tmp)=1 Then Tmp:='0'+Tmp;
      Res:=Res+Tmp;
      Continue;
    End;
    If Pos('ss',ParsedFormat)=1 Then Begin
      ParsedFormat:=Copy(ParsedFormat,3,Length(ParsedFormat)-2);
      Tmp:=IntToStr(s);
      If Length(Tmp)=1 Then Tmp:='0'+Tmp;
      Res:=Res+Tmp;
      Continue;
    End;
    If Pos('ms',ParsedFormat)=1 Then Begin
      ParsedFormat:=Copy(ParsedFormat,3,Length(ParsedFormat)-2);
      Tmp:=IntToStr(ms);
      If Length(Tmp)=1 Then Tmp:='0'+Tmp;
      If Length(Tmp)=2 Then Tmp:='0'+Tmp;
      Res:=Res+Tmp;
      Continue;
    End;
    Res:=Res+ParsedFormat[1];
    ParsedFormat:=Copy(ParsedFormat,2,Length(ParsedFormat)-1);
  Until ParsedFormat='';
  Result:=Res;
End;

Function TimeCode2DateTime(TCode,Format:String):TDateTime;
Var Y,M,D,h,mn,s,ms:Word;
    ParsedFormat,Tmp:String;
    Res:TDateTime;
Begin
  ParsedFormat:=Format;
  Y:=0;M:=0;D:=0;h:=0;mn:=0;s:=0;ms:=0;
  Repeat
    If Pos('YYYY',ParsedFormat)=1 Then Begin
      ParsedFormat:=Copy(ParsedFormat,5,Length(ParsedFormat)-4);
      Tmp:=Copy(TCode,1,4);TCode:=Copy(TCode,5,Length(TCode)-4);
      Y:=StrToInt(Tmp);
      Continue;
    End;
    If Pos('YY',ParsedFormat)=1 Then Begin
      ParsedFormat:=Copy(ParsedFormat,3,Length(ParsedFormat)-2);
      Tmp:=Copy(TCode,1,2);TCode:=Copy(TCode,3,Length(TCode)-2);
      Y:=StrToInt(Tmp);
      If Y>50 Then Y:=Y+1900 Else Y:=Y+2000;
      Continue;
    End;
    If Pos('MM',ParsedFormat)=1 Then Begin
      ParsedFormat:=Copy(ParsedFormat,3,Length(ParsedFormat)-2);
      Tmp:=Copy(TCode,1,2);TCode:=Copy(TCode,3,Length(TCode)-2);
      M:=StrToInt(Tmp);
      Continue;
    End;
    If Pos('DD',ParsedFormat)=1 Then Begin
      ParsedFormat:=Copy(ParsedFormat,3,Length(ParsedFormat)-2);
      Tmp:=Copy(TCode,1,2);TCode:=Copy(TCode,3,Length(TCode)-2);
      D:=StrToInt(Tmp);
      Continue;
    End;
    If Pos('hh',ParsedFormat)=1 Then Begin
      ParsedFormat:=Copy(ParsedFormat,3,Length(ParsedFormat)-2);
      Tmp:=Copy(TCode,1,2);TCode:=Copy(TCode,3,Length(TCode)-2);
      h:=StrToInt(Tmp);
      Continue;
    End;
    If Pos('mm',ParsedFormat)=1 Then Begin
      ParsedFormat:=Copy(ParsedFormat,3,Length(ParsedFormat)-2);
      Tmp:=Copy(TCode,1,2);TCode:=Copy(TCode,3,Length(TCode)-2);
      mn:=StrToInt(Tmp);
      Continue;
    End;
    If Pos('ss',ParsedFormat)=1 Then Begin
      ParsedFormat:=Copy(ParsedFormat,3,Length(ParsedFormat)-2);
      Tmp:=Copy(TCode,1,2);TCode:=Copy(TCode,3,Length(TCode)-2);
      s:=StrToInt(Tmp);
      Continue;
    End;
    If Pos('ms',ParsedFormat)=1 Then Begin
      ParsedFormat:=Copy(ParsedFormat,3,Length(ParsedFormat)-2);
      Tmp:=Copy(TCode,1,2);TCode:=Copy(TCode,3,Length(TCode)-2);
      ms:=StrToInt(Tmp);
      Continue;
    End;
    ParsedFormat:=Copy(ParsedFormat,2,Length(ParsedFormat)-1);
    TCode:=Copy(TCode,2,Length(TCode)-1);
  Until ParsedFormat='';
  Res:=ComposeDateTime(EncodeDate(Y,M,D),EncodeTime(h,mn,s,ms));
  Result:=Res;
End;

Procedure LogMessage(Level:Longint;Msg:String);
Begin
  If Level>LogLevel Then Exit;
  WriteLn(LogFile,DateTimeToStr(Now)+'>'+Msg);
  Flush(LogFile);
End;

Function GetResponce(CLI:String;Var ErrCode:Longint):String;
Var I,Avail:Longint;
  Process:TProcess; ProcessOut:TInputPipeStream;
  CB:String;b,pb,Buf,RequestedOP,AttributeName,AttributeType:String;
Begin
    //    StopWaitingResponce:=False;  // must be global variable
        Process:=TProcess.Create(Nil);
        Process.Options:=[poUsePipes,poNoConsole,poStderrToOutPut];
        Process.ShowWindow:=swoShow;
        Process.CommandLine:=CLI;
        Try
          Buf:='';
          Process.Execute;
          ProcessOut:=Process.Output;
          Repeat
            Avail:=ProcessOut.NumBytesAvailable;
            If Avail>0 Then Begin
              If Avail>254 Then Repeat
                SetLength(cb,254);
                ProcessOut.Read(CB[1],254);
                Buf:=Buf+CB;
                Avail:=Avail-254;
              Until Avail<=254;
              SetLength(CB,Avail);
              ProcessOut.Read(CB[1],Avail);
              Buf:=Buf+CB;
            End;
         //   Application.ProcessMessages;
          Until ((Not Process.Active) And (ProcessOut.NumBytesAvailable=0)) {Or (StopWaitingResponce)};
        Except LogMessage(0,'Error running '+CLI);End;
        Process.CloseOutput;
    {    If StopWaitingResponce Then Begin
          Result:='cancelled';
          ErrCode:=-1;
        End Else Begin}
          Result:=(Buf);
          ErrCode:=Process.ExitCode;
{        end;}
        Process.Free;
End;

Function GetLines(CLI:String):TStringList;
Var StrToLinesBuffer:TStringList;
    Err:Longint;
Begin
  StrToLinesBuffer:=TStringList.Create;
  StrToLinesBuffer.Text:=GetResponce(Cli,Err);
  Result:=StrToLinesBuffer;
end;


end.

