program CrackUUE;

{  ================= H E L P ============================

      Программа обрабатывает UUE-кодированные письма
      сваленные в один файл, например, 1.UUE

      запуск: CrackUUE.EXE 1.UUE

  В итоге работы программы получаем кучу батников, вроде этого:
 ======== file xg@pma20.BAT =========
pkzip xg@pma20.zip xg@pma20.TXT
move xg@pma20.zip d:\communic\sbbs\files\cracker
cd d:\communic\sbbs\list
bbslist /BBS
me d:\communic\sbbs\files\cracker\files.bbs d:\communic\xg@pma20.TXT d:\communic\*.Diz
erase d:\communic\sbbs\files\cracker\files.bak
cd
d:\communic\AllFix\HATCH.EXE Area CRACKER File d:\communic\sbbs\files\cracker\xg@pma20.zip
cd ..
  ===================================

  А также xg@pma20.Zip (собственно, кодированный файл),
  xg@pma20.TXT (текст письма) и xg@pma20.UUE (для контроля)

  ================= H E L P ============================ }

(* Автор: Slawa Alexeew, 2:5020/614 (Slawa.Alexeew@avangard.ru) *)

uses Crt, Dos, uudecod;

var
    StrIn,
    StrOut : String;
    Tmp,
    FilIn,
    Filuue,
    FilOut : Text;
    NameEXT,
    Param,
    Name   : PathStr;
    w, v   : Word;
    Start,   { начало секции }
    Apostrof,  { есть ли значок ` перед end-ом }
    Cr     : Boolean;

    { переменные, загружаемые из файла CrackUUE.CTL }
    Strl   : Array [1..10] of String;                { постоянные строки батника }
    PATHOUT,  { d:\communic\sbbs\files\cracker\      ; путь к каталогу, куда складываются файлы}
    PATHIN,   { d:\communic\                         ; путь к каталогу, где обрабатывается 1.UUE}
    PATHME,   { me                                   ; [путь и] программа редактора текстов }
    PATHBBS,  { d:\communic\sbbs\files\cracker\files.bbs ; путь к FILES.BBS }
    HATCH,    { d:\communic\AllFix\HATCH.EXE         ; путь к хатчилке  }
    AREA      { CRACKER                              ; фэха для постинга }
        :   String;

  function FileExists (FileName:string): Boolean;
  { возвращает True - файл существует и False, усли нет }
  var f : file;
  begin
    {$I-}
    Assign (f, FileName);
    Reset (f);
    Close (f);
    {$I+}
    FileExists := (IOResult = 0) and (FileName <> '');
  end; { FileExists }


Procedure Read_Ctl;
var ii, zz : Integer;
begin
     FillChar (Strl, SizeOf(Strl), 0);
     if Not FileExists ('CRACKUUE.CTL') then begin
      GotoXY (15,17);
      TextColor (12);
       Writeln (' Hет настроечного файла "CRACKUUE.CTL"');
      TextColor (7);
       Halt;
       end;
     assign (Tmp, 'CRACKUUE.CTL');
     Reset (Tmp);
     While Not Eof (Tmp) do begin
           readln (TMP, StrIn);
           if Pos(';', StrIn) <> 0 then
              Delete (StrIn, Pos(';', StrIn), length(StrIn)-Pos(';', StrIn)+1);
           if Pos ('PATHOUT ', StrIn) <> 0 then begin
            Delete (StrIn, 1, Pos(' = ', StrIn) + 2);
            While Pos (' ', StrIn) > 0 do Delete (StrIn, Pos(' ',StrIn), 1);
            if StrIn[Length(StrIn)] = '\' then
               Delete (StrIn, Length(StrIn), 1);
            PATHOUT := StrIn;
            end;
           if Pos ('PATHIN ', StrIn) <> 0 then begin
            Delete (StrIn, 1, Pos(' = ', StrIn) + 2);
            While Pos (' ', StrIn) > 0 do Delete (StrIn, Pos(' ',StrIn), 1);
            if StrIn[Length(StrIn)] <> '\' then StrIn := StrIn + '\';
            PATHIN := StrIn;
            end;
           if Pos ('PATHME ', StrIn) <> 0 then begin
            Delete (StrIn, 1, Pos(' = ', StrIn) + 2);
            While Pos (' ', StrIn) > 0 do Delete (StrIn, Pos(' ',StrIn), 1);
            PATHME := StrIn;
            end;
           if Pos ('PATHBBS ', StrIn) <> 0 then begin
            Delete (StrIn, 1, Pos(' = ', StrIn) + 2);
            While Pos (' ', StrIn) > 0 do Delete (StrIn, Pos(' ',StrIn), 1);
            PATHBBS := StrIn;
            end;
(*  Strl   : Array [1..10] of String;                { постоянные строки батника }
    AREA      { CRACKER                              ; фэха для постинга } *)
           if Pos ('HATCH ', StrIn) <> 0 then begin
            Delete (StrIn, 1, Pos(' = ', StrIn) + 2);
            While Pos (' ', StrIn) > 0 do Delete (StrIn, Pos(' ',StrIn), 1);
            HATCH := StrIn;
            end;
           if Pos ('AREA ', StrIn) <> 0 then begin
            Delete (StrIn, 1, Pos(' = ', StrIn) + 2);
            While Pos (' ', StrIn) > 0 do Delete (StrIn, Pos(' ',StrIn), 1);
            AREA := StrIn;
            end;
           if Pos ('STR0', StrIn) <> 0 then begin
            StrOut := copy (StrIn, POS('STR', StrIn) + 3, 2);
            Val (StrOut, ii, zz);  { StrOUT = 'STR01 = cd d:\AllFix' }
            Delete (StrIn, 1, Pos(' = ', StrIn) + 2);
            While Pos ('  ', StrIn) > 0 do Delete (StrIn, Pos('  ',StrIn), 1);
            if StrIn = ' ' then StrIn := '';
            if zz = 0 then Strl [ii] := StrIn;
            end;
     end;
     Close (TMP);
end;       { Read_Ctl }


begin
  ClrScr;
  GotoXY (14,05);
  Writeln ('Программа обрабатывает UUE-кодированные письма');
  GotoXY (17,07);
  Writeln ('сваленные в один файл, например, 1.UUE');
  GotoXY (19,12);
  Writeln ('запуск: CrackUUE.EXE имя_файла.UUE');
  if ParamCount > 0 then Param := ParamStr(1);
  if (Not FileExists (Param)) or (Pos('.DOC', Param) > 0) then
      begin
      GotoXY (15,17);
      TextColor (12);
      Writeln (' Нет названия файла, подлежащего конвертации');
      TextColor (7);
      Halt;
      end;
  Read_Ctl;
  assign (FilIn, Param);
  Reset (FilIn);
  StrIn := '';

  While (Not Eof (FilIn)) do begin

  assign (FilOut, 'TMP.TXT');
  Rewrite (FilOut);
  assign (FilUUE, 'TMP.UUE');
  Rewrite (FilUUE);
  w := 0; Cr := False; Start := False;

  if (Length (StrIn) > 1) and (StrIn[1] = #12) then begin
        Delete (StrIn, 1, 1);
        if Pos ('(2:5020/614.1)', StrIn) > 0 then
          Delete (StrIn, Pos('(2:5020/614.1)', StrIn), 14);
        Writeln (FilOut, StrIn);
        End;

  Repeat
     Readln (FilIn, StrIn);
     { начало секции }
     if copy (StrIn, 1, 5) = 'begin' then begin
        Start := true;  Apostrof := False;
        Writeln (FilUUE, StrIn);
        end;


     w := ((ord(StrIn[1]) div 3) - 11);
     v := ((Length(StrIn)-2) div 4);
     if w = 8 then
       writeln (w);

     if StrIn = '`' then Apostrof := true;
     if Start then begin
     if ((StrIn <> '') and ((w = v) or (w = v - 1))) or (StrIn = '`') then
       Writeln (FilUUE, StrIn);
     end else
     if (StrIn[1] <> #12) and
     ('sum -r/size' <> copy (StrIn, 1, 11)) and
     ('section' <> copy (StrIn, 1, 7)) and
     (' Msg  :' <> copy (StrIn, 1, 7))
        then
              Writeln (FilOut, StrIn);

     { конец секции }
     if (StrIn[1] = 'e') and (StrIn[2] = 'n') and (StrIn[3] = 'd')
        then begin
        Cr := True;
        Start := False;
        if Not Apostrof then Writeln (FilUUE, '`');
        Apostrof := True;
        Writeln (FilUUE, StrIn);
        end;


  Until (Eof (FilIn)) or ((StrIn[1] = #12) and Cr);

  Close (FilOut);
  Close (FilUUE);

  Name := UUE_Decod ('TMP');
  if Pos ('.', Name) > 0 then Begin
    NameEXT := Copy (Name, Pos ('.', Name), Length (Name));
    Delete (Name, Pos ('.', Name), Length (Name));
    end;

  if FileExists (Name + '.TXT') then begin
    assign (Tmp, Name + '.TXT');
    Erase (Tmp)
    end;
  Rename (FilOut, Name + '.TXT');

  if FileExists (Name + '.UUE') then begin
    assign (Tmp, Name + '.UUE');
    Erase (Tmp)
    end;
  Rename (FilUUE, Name + '.UUE');

  assign (Tmp, Name + '.BAT');
  Rewrite (Tmp);

  if (NameEXT = '.ZIP') or (NameEXT = '.zip') or
     (NameEXT = '.Zip') or (NameEXT = '.ZIp') then
     writeln (Tmp, 'pkzip ', Name, NameEXT, ' ', Name, '.TXT')
  else
  if (NameEXT = '.RAR') or (NameEXT = '.rar') or
     (NameEXT = '.Rar') or (NameEXT = '.RAr') then
     writeln (Tmp, 'Rar a ', Name, NameEXT, ' ', Name, '.TXT')
  else
  if (NameEXT = '.ARJ') or (NameEXT = '.arj') or
     (NameEXT = '.Arj') or (NameEXT = '.ARj') then
     writeln (Tmp, 'Arj a ', Name, NameEXT, ' ', Name, '.TXT')
  else begin
     writeln (Tmp, 'Arj a ', Name, ' ', Name, NameEXT, ' ', Name, '.TXT');
     NameEXT := '.ARJ';
     end;

  writeln (Tmp, 'move ',  Name, NameEXT, ' ', PATHOUT);

  If Length (Strl[1]) > 0 then writeln (Tmp, Strl[1]);
  If Length (Strl[2]) > 0 then writeln (Tmp, Strl[2]);
  If Length (Strl[3]) > 0 then writeln (Tmp, Strl[3]);
  { четвертая строка батника }
  writeln (Tmp, PATHME, ' ', PATHBBS, ' ', PATHIN, Name, '.TXT ', PATHIN, '*.Diz');
  If Length (Strl[5]) > 0 then writeln (Tmp, Strl[5]);
  If Length (Strl[6]) > 0 then writeln (Tmp, Strl[6]);
  If Length (Strl[7]) > 0 then writeln (Tmp, Strl[7]);
  writeln (Tmp, HATCH, ' Area ', AREA, ' File ', PATHOUT, '\', Name, NameEXT);
  If Length (Strl[8]) > 0 then writeln (Tmp, Strl[8]);
  If Length (Strl[9]) > 0 then writeln (Tmp, Strl[9]);
  Close (Tmp);

  end; { Not Eof Infile }
  Close (FilIn);
end.
