home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: InfoMgt / InfoMgt.zip / pmmeal10.zip / qwkmeal.cmd < prev    next >
OS/2 REXX Batch file  |  1994-08-01  |  2KB  |  53 lines
  1. /* QWKMEAL (C)opyright J.Wellhausen 1994        */
  2. /* Das Programm zieht die Meal-Master-Dateien   */
  3. /* aus dem QWK-Puffer Und speichert sie in der  */
  4. /* Datei MMR-QWK.TXT.                           */
  5. /*                                              */
  6. /* Falls noch jemand 'n Tool braucht, soll er   */
  7. /* sich melden                                  */
  8.  
  9. indexlg=stream("messages.dat","C","query size")/128
  10. anz=0
  11. do n=1 to indexlg
  12.   xx=charin("messages.dat",n*128-127,128)
  13.   zl=substr(xx,117,6)
  14.   if zl<>"" then do
  15.     xx="e3"x
  16.     do n=n+1 to n+zl-1
  17.       xx=xx||charin("messages.dat",n*128-127,128)
  18.     end
  19.     n=n-1
  20.     mm=0; k2=0;
  21.     do until mm=0
  22.       mm=pos("Meal-Master",xx,mm+1)
  23.       if mm>0 then do
  24.         k1=lastpos("e3"x,xx,mm)
  25.         mtyp="-----"
  26.         kk=lastpos("e3"x||mtyp,xx,mm)
  27.         if kk<>k1 then do
  28.           mtyp="MMMMM"
  29.           kk=lastpos("e3"x||mtyp,xx,mm)
  30.         end
  31.         if k1=kk then do
  32.           k2=pos("e3"x||mtyp||"e3"x,xx,mm)+7
  33.           if k2>mm then do
  34.             anz=anz+1
  35. /*            say "!"xx"!"mm"!"k2"!"k1"!"kk"!"  */
  36.             xxx=substr(xx,k1,k2-k1-1)
  37.             mmm=length(xxx)
  38.             do until mmm=0
  39.               mmm=lastpos("e3"x,xxx,mmm)
  40.               if mmm>0 then
  41.                 xxx=left(xxx,mmm-1)||"0d0a"x||substr(xxx,mmm+1)
  42.             end
  43.             call charout "mmr-qwk.txt",xxx
  44.           end; else do
  45.             say "!"fehlerhaftes Rezept"!"
  46.           end
  47.         end
  48.       end
  49.     end
  50.   end
  51. end
  52. say anz" Rezepte gefunden"
  53.