home *** CD-ROM | disk | FTP | other *** search
/ ftp.wwiv.com / ftp.wwiv.com.zip / ftp.wwiv.com / pub / OFFLINE / QWKBLT13.ZIP / QWK-BLT.PPS < prev   
Text File  |  1993-12-16  |  7KB  |  276 lines
  1. ;────── QWK-BLT.PPS ─────────────────────────────────────────────────────────
  2. ;
  3. ;       Version 1.20
  4. ;       Dec 16, 1993
  5. ;       Copyright 1993, James Dean Jones
  6. ;
  7. ;       Attach new main board bulletins to internally generated .QWK packets
  8. ;
  9. ; Sure would be nice if the PPLC supported random access files (hint)
  10. ;   ... or ... if they do, someone PLEASE tell me
  11. ;
  12. ;       2/3 Board
  13. ;       (217) 877-1138
  14. ;       21.6k Dual Standard
  15. ;
  16. ;────────────────────────────────────────────────────────────────────────────
  17.  
  18. ;────── Variables ───────────────────────────────────────────────────────────
  19.  
  20. string  cnames      ; path of CNAMES file
  21. string  bltlst      ; path of main board bulletin list
  22. string  cmdline     ; command line to return to PCBoard
  23. string  token       ; individual command
  24. string  bltpth      ; path to bulletin
  25. string  nbltpth     ; path of temporary copy of bulletin
  26. string  bltscan     ; list of bulletins to scan
  27. string  line        ; line of text from bulletin list file
  28. string  parseln     ; line of text to parse
  29. string  buffer      ; buffer for file copy
  30. integer handle      ; dos handle for bulletin list
  31. integer isblt       ; scan for bulletins?
  32. integer addblt      ; add bulletin to capture
  33. integer acount      ; count of attempted bulletins
  34. integer bcount      ; number of main board bulletins
  35. integer lcount      ; current position of seek
  36. integer handsrc     ; handle to source file
  37. integer handdst     ; handle to destination file
  38. boolean ferror      ; file error
  39. boolean cfgthere    ; found configuration file
  40. boolean cont        ; continue scanning?
  41. integer ax          ; registers for interrupts
  42. integer bx
  43. integer cx
  44. integer dx
  45. integer si
  46. integer di
  47. integer flags
  48. integer ds
  49. integer es
  50.  
  51. ;────── Main Program ────────────────────────────────────────────────────────
  52.  
  53.     let cmdline = ""
  54.     let isblt = 0
  55.     let acount = 1
  56.     let lcount = 1
  57.     let token = gettoken()
  58.     while (token != "") do
  59.        if (left(upper(token),1) = "B") then
  60.           let isblt = or(isblt,1)
  61.        else
  62.           if (cmdline > "") then
  63.              let cmdline = cmdline + ";" + token
  64.           else
  65.              let cmdline = token
  66.           endif
  67.        endif
  68.        if (left(upper(token),1) = "D") let isblt = or(isblt,2)
  69.        let token = gettoken()
  70.     endwhile
  71.  
  72.     if (isblt != 3) goto alldone
  73.  
  74. ;────── Bulletin Scan ───────────────────────────────────────────────────────
  75.  
  76.     getuser
  77.     let cnames = readline(pcbdat(),31)
  78.     let bltlst = trim(readline(cnames,25)," ")
  79.  
  80.     if (bltlst = "" | left(bltlst,1) = " ") goto alldone
  81.     if (!exist(bltlst)) goto alldone
  82.  
  83.     if (exist(ppepath()+ppename()+".cfg")) then
  84.        let cfgthere = true
  85.        let bltscan = ""
  86.        let bltscan = readline(ppepath()+ppename()+".cfg",1)
  87.     else
  88.        let cfgthere = false
  89.     endif
  90.  
  91.     let bcount = fileinf(bltlst,4) / 30
  92.  
  93.     gosub openfile
  94.     let handle = regax()
  95.     if (ferror) goto alldone
  96.  
  97.     dispstr "@X0FScanning Bulletins "
  98.  
  99.     if (cfgthere) then
  100.         while (acount <= len(bltscan) & acount <= bcount) do
  101.             if (mid(bltscan,acount,1)!="Y") goto nextcfgblt
  102.             if (lcount != acount - 1) gosub seek
  103.             dispstr "."
  104.             gosub readdata
  105.             gosub handleblt
  106.         
  107. :nextcfgblt
  108.  
  109.             inc acount
  110.         endwhile
  111.     else
  112.         while (acount <= bcount) do
  113.             if (and(acount,1)=1) dispstr "."
  114.             gosub readdata
  115.             gosub handleblt
  116.         
  117. :nextblt
  118.  
  119.             inc acount
  120.         endwhile
  121.     endif
  122.  
  123.     gosub closefile
  124.  
  125.     dispstr chr(13)
  126.  
  127.     goto alldone
  128.  
  129.  
  130. ;────── OpenFile ────────────────────────────────────────────────────────────
  131.  
  132. :OpenFile
  133.  
  134.     varseg bltlst,ds
  135.     varoff bltlst,dx
  136.     let ax = 3d20h
  137.     dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  138.     let handle = regax()
  139.     let ferror = regcf()
  140.  
  141.     return
  142.  
  143. ;────── ReadData ────────────────────────────────────────────────────────────
  144.  
  145. :ReadData
  146.  
  147.     let parseln = "                              " ; 30 spaces
  148.     let bx = handle
  149.     let ax = 3f00h
  150.     let cx = len(parseln)
  151.     varseg parseln,ds
  152.     varoff parseln,dx
  153.     dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  154.     ferror = regcf()
  155.     if (ferror | regax() = 0) let parseln = ""
  156.     let lcount = acount
  157.  
  158.     return
  159.  
  160. ;────── Seek ────────────────────────────────────────────────────────────────
  161.  
  162. :Seek
  163.  
  164.     let bx = handle
  165.     let ax = 4200h
  166.     let dx = (30 * (acount - 1)) % 1000h
  167.     let cx = (30 * (acount - 1)) / 1000h
  168.     dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  169.     ferror = regcf()
  170.  
  171.     return
  172.  
  173. ;────── CloseFile ───────────────────────────────────────────────────────────
  174.  
  175. :CloseFile
  176.  
  177.     let bx = handle
  178.     let ax = 3e00h
  179.     dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  180.     let ferror = regcf()
  181.  
  182.     return
  183.  
  184. ;────── UpdateDisp ──────────────────────────────────────────────────────────
  185.  
  186. :UpdateDisp
  187.  
  188.     inc acount
  189.     if (and(acount,1)=1) dispstr "."
  190.  
  191.     return
  192.  
  193. ;────── HandleBlt ───────────────────────────────────────────────────────────
  194.  
  195. :HandleBlt
  196.  
  197.     let bltpth = trim(parseln," ")
  198.     if (parseln = "") goto nextblt
  199.  
  200.     if (!(exist(bltpth))) goto nextblt
  201.     if (fileinf(bltpth,4)=0) goto nextblt
  202.  
  203.     let addblt = 0
  204.     if (fileinf(bltpth,2) >= u_ldate()) let addblt = or(addblt,1)
  205.     if (fileinf(bltpth,3) > u_ltime()) let addblt = or(addblt,2)
  206.     if (addblt = 3) then
  207.         let nbltpth = temppath()+fileinf(bltpth,8)+fileinf(bltpth,9)
  208.         gosub copyfile
  209.     endif
  210.  
  211.     return
  212.  
  213. ;────── CopyFile ────────────────────────────────────────────────────────────
  214.  
  215. :CopyFile
  216.  
  217.         varseg bltpth,ds
  218.         varoff bltpth,dx
  219.         let ax = 3d20h
  220.         dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  221.         if (regcf()) goto donecopy
  222.         let handsrc = regax()
  223.         varseg nbltpth,ds
  224.         varoff nbltpth,dx
  225.         let ax = 3c00h
  226.         let cx = 0000h
  227.         dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  228.         if (regcf()) then
  229.             let bx = handsrc
  230.             dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  231.             goto donecopy
  232.         endif
  233.         let handdst = regax()
  234.         let buffer = "                                "         ; 32 spaces
  235.         let buffer = buffer + buffer
  236.         let buffer = buffer + buffer
  237.         let bx = handsrc
  238.         let cx = len(buffer)
  239.         varseg buffer,ds
  240.         varoff buffer,dx
  241.         let ax = 3f00h
  242.         dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  243.         if (regcf() | regax() = 0) then
  244.             let cont = false
  245.         else
  246.             let cont = true
  247.         endif
  248.         while (cont) do
  249.             let bx = handdst
  250.             let cx = regax()
  251.             let ax = 4000h
  252.             dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  253.             let bx = handsrc
  254.             let cx = len(buffer)
  255.             let ax = 3f00h
  256.             dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  257.             if (regcf() | regax() = 0) let cont = false
  258.         endwhile
  259.         let bx = handdst
  260.         let ax = 3e00h
  261.         dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  262.         let bx = handsrc
  263.         let ax = 3e00h
  264.         dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  265.  
  266. :DoneCopy
  267.  
  268.         return
  269.  
  270. ;────── Finished ────────────────────────────────────────────────────────────
  271.  
  272. :alldone
  273.     kbdstuff "qwk;" + cmdline + chr(13)
  274.  
  275.     end
  276.