home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / ZCPR33 / A-R / RCPMC.LBR / RCPMC.LZB / RCPMC.LIB
Text File  |  2000-06-30  |  8KB  |  447 lines
  1. ;=============================================================================
  2. ;
  3. ;        M C     C O M M A N D
  4. ;
  5. ;============================================================================
  6.  
  7. ; +++++++    NOT AN OFFICIAL RCP SEGMENT
  8.  
  9. ; Command:    MC
  10. ; Function:    Multi Copy:  Wild Card File Copier
  11. ; Author:     Rob Friefeld, 4607 Colorado St., Long Beach, CA 213-434-7338
  12. ; Date:        23 Aug 1987 Version 1.0
  13.  
  14. ; Comment:    ERAON = YES assures all routines from rcpsubs.lib available.
  15.  
  16. ; Usage:    MC SOURCE [DESTINATION]
  17. ;        Source is the afn to be copied and destination is an optional
  18. ;        afn.  If omitted, source comes to current DU:
  19. ;        R/O files are copied to R/W.
  20.  
  21. ;
  22. ; MC EQUATES
  23. ;
  24.  
  25. ; # RECORDS TO READ ON EACH PASS (Byte value)
  26.  
  27. FILELOC    EQU    TPA    ; Location file read in
  28. RECBLKS    EQU    255    ; About 32k buffer.  Leaves transient at 8000h alone.
  29.  
  30.  
  31. ; SHOW REMAINING SPACE ON EXIT
  32.  
  33. MCSPA    EQU    YES    ; Show free space
  34. MCSP    EQU    MCSPA AND SPACEON
  35.  
  36. ; THIS CODE IS IN PEEP, SO IT NEED NOT BE REPEATED
  37.  
  38.      if    [not peepon]
  39. filcheck:
  40.     ld    hl,fcb1+1
  41.     ld    a,' '
  42.     cp    (hl)
  43. filcx:    ret    nz
  44.     call    prfnf        ; ROUTINE IS ELSEWHERE IN RCP
  45.     jp    exit
  46.  
  47. opensource:
  48.     ld    de,fcb1
  49.     ld    c,openf
  50.     call    bdos
  51.     inc    a
  52.     jr    filcx
  53.  
  54.      endif    ; not peepon
  55.  
  56. ;
  57. ; START OF MOVE FILE
  58. ;
  59.  
  60. MLTCPY:
  61.     CALL    RETSAVE        ; Set up CPR return
  62.  
  63.     call    filcheck
  64.  
  65.     call    savdest        ; Save destination filename
  66.     call    savdu        ; Save user numbers and drives
  67.  
  68.     call    logsu        ; Log source user for search function
  69.     LD    A,80H        ; Flag SYS and DIR
  70.     CALL    GETDIR        ; Get list of afn matches
  71.     jp    z,filcx        ; No matches
  72.  
  73. ;
  74. ;  MAIN PROGRAM LOOP
  75. ;
  76. ;  Enter with HL -> first file name in list.
  77.  
  78. loop:
  79.     push    hl        ; Save list position
  80.     ld    de,fcb1+1    ; Move name to source fcb
  81.     ld    bc,11
  82.     ldir
  83.     CALL    INITFCB1    ; Zero out rest of fcb
  84.     pop    hl        ; Restore list postion
  85.     ld    de,destfcb+1    ; Copy same name to dest fcb
  86.     ld    bc,11
  87.     ldir            ; When done, HL -> next name on list
  88.     push    hl        ; Save list position
  89.     ld    hl,destfcb
  90.     CALL    INITFCB2    ; Clean up the dest fcb
  91.     call    rename        ; If dest to be renamed, do it
  92.     call    pfil        ; Display file name
  93.     call    opfiles        ; Open source and dest files
  94.     jr    z,lp2        ; Z = dest file exists AND don't erase it
  95. lp1:
  96.     call    r$wfiles    ; Read and write files
  97.     jr    z,lp3        ; 0 length file
  98.     ld    a,(cflag)    ; Is entire file copied
  99.     or    a
  100.     jr    nz,lp1        ; No
  101. lp3:    call    close        ; Close the destination file
  102.  
  103. lp2:    pop    hl        ; Restore LIST pointer 
  104.     ld    a,(hl)        ; 0 terminator
  105.     or    a
  106.      IF    MCSP
  107.     jp    z,spaexit    ; DONE    
  108.      ELSE
  109.     jp    z,exit
  110.      ENDIF
  111.     call    crlf
  112.     jr    loop
  113.  
  114.  
  115. ;
  116. ;  Subroutines
  117. ;
  118.  
  119. ; Save destination filename.  Set renaming flag.
  120.  
  121. savdest:
  122.     ld    bc,11        ; Dest name -> savfcb
  123.     ld    hl,fcb2+1
  124.     ld    de,savfcb
  125.     ldir
  126.  
  127.     ld    a,(savfcb)    ; Is it blank?
  128.     cp    ' '
  129.     jr    nz,sav1        ; No, rename will be done
  130.     xor    a        ; Load up the flags
  131.     jr    sav2
  132. sav1:    or    a,-1
  133. sav2:    ld    (rflag),a    ; Rename flag, Z = do not rename
  134.     ld    (pflag),a    ; Print flag, Z = do not print dest filename
  135.     ret
  136.  
  137. savfcb:    ds    11        ; Destination name template
  138. rflag:    ds    1        ; Wild card rename flag
  139.  
  140.  
  141. ; Rename destination file
  142.  
  143. rename:
  144.     ld    a,(rflag)    ; Is there anything to do?
  145.     or    a
  146.     ret    z        ; Nope
  147.  
  148.     ld    b,11        ; Matched source name has been copied
  149.     ld    hl,savfcb
  150.     ld    de,destfcb+1
  151. ren1:    ld    a,(hl)
  152.     cp    '?'        ; Leave wild card parts alone
  153.     jr    z,ren2
  154.     ld    (de),a        ; Rename other parts
  155. ren2:    inc    hl
  156.     inc    de
  157.     djnz    ren1
  158.     ret
  159.  
  160.  
  161. ; Save the drives and users of source + destination
  162.  
  163. savdu:
  164.     ld    hl,fcb        ; If drive is default, make it explicit
  165.     ld    a,(hl)
  166.     or    a
  167.     call    z,getdefdrive    ; Default
  168.     ld    a,(fcb+13)    ; Get and store user #'s
  169.     ld    (susr),a
  170.     ld    a,(fcb2+13)
  171.     ld    (dusr),a
  172.     ld    a,(fcb2)    ; Save dest drive
  173.     ld    hl,destfcb
  174.     ld    (hl),a
  175.     or    a
  176.     ret    nz        ; Fall through if dest is default
  177.  
  178. getdefdrive:            ; Load default drive into @HL
  179.     push    hl
  180.     ld    c,inqdiskf
  181.     call    bdos
  182.     pop    hl
  183.     inc    a
  184.     ld    (hl),a
  185.     ret
  186.  
  187.  
  188. ; Log source or dest user
  189.  
  190. logsu:    ld    a,(susr)
  191.     jr    log
  192. logdu:    ld    a,(dusr)
  193. log:    JP    SETUSR
  194.  
  195. susr:    ds    1        ; Source user
  196. dusr:    ds    1        ; Dest user
  197.  
  198.  
  199. opfiles:
  200.  
  201. ; Open source file
  202. opsrc:
  203.     call    logsu
  204.     call    opensource    ; Routine in rpeep
  205.     
  206.  
  207. ; Open destination file
  208. opdest:
  209.     ld    de,tbuf        ; Restore DMA to 80h
  210.     ld    c,setdmaf
  211.     call    bdos
  212.     call    logdu        ; Dest user
  213.     ld    de,destfcb    ; Check existence of destination
  214.     ld    c,srchff    ; Look for a file
  215.     call    bdos
  216.     cp    0ffh
  217.     jr    z,od1        ; No file
  218.  
  219.     call    file$exists    ; Deal with existence of file
  220.     ret    z        ; Copy aborted
  221.  
  222. od1:    ld    c,erasef    ; Delete present destination file
  223.     ld    de,destfcb    ; (if file ~exist, this does nothing)
  224.     call    bdos
  225.  
  226.     ld    de,destfcb    ; Make new file, same name
  227.     ld    c,makef
  228.     call    bdos
  229.     inc    a
  230.     jp    z,DIRERR    ; Unable to make new file
  231.  
  232.     ld    de,destfcb    ; Make sure file is not R/O
  233.     ld    hl,9
  234.     add    hl,de
  235.     res    7,(hl)
  236.     ld    c,attrf
  237.     call    bdos
  238.  
  239.     or    a,-1        ; Normal exit returns NZ
  240.     ret
  241.  
  242.  
  243. ; Destination file exists:
  244. ;    Locate file name in temp buffer and save location
  245. ;    Make sure file is not being copied to itself
  246. ;    Find out if file is R/O 
  247. ;    Finally, do we want to erase it?
  248.  
  249. file$exists:
  250.     rrca            ; Find entry into TBUF
  251.     rrca
  252.     rrca
  253.     add    a,80h
  254.     ld    l,a
  255.     ld    h,0
  256.     ld    (nxtfile),hl
  257.  
  258.     ld    hl,fcb        ; Scan both drive/filenames
  259.     ld    de,destfcb
  260.     ld    b,12        ; # bytes to check
  261. fil$ex1:
  262.     ld    a,(de)
  263.     cp    (hl)
  264.     jr    nz,fil$ex2    ; They differ
  265.     inc    hl
  266.     inc    de
  267.     djnz    fil$ex1
  268.  
  269.     ld    a,(susr)    ; Names and drives same ... what about users?
  270.     ld    b,a
  271.     ld    a,(dusr)
  272.     cp    b
  273.     jr    nz,fil$ex2    ; They differ
  274.  
  275.     call    print        ; Don't do copy
  276.     db    ' ?','?'+80h
  277.     xor    a
  278.     ret
  279.  
  280. fil$ex2:
  281.     ld    hl,(nxtfile)    ; If file R/O
  282.     inc    hl        ; Point to start of name
  283.     CALL    ROTEST
  284.     call    ERAQ
  285.     jr    z,erase1
  286.     xor    a
  287.     ret
  288.  
  289. erase1:
  290.     ld    de,(nxtfile)    ; Take care of R/O status
  291.     ld    hl,destfcb
  292.     ld    a,(hl)        ; Get drive
  293.     ld    (de),a        ; Move it to file location
  294.     ld    hl,9
  295.     add    hl,de
  296.     res    7,(hl)        ; Reset the bit
  297.     ld    c,attrf        ; Tell BDOS about R/O reset
  298.     call    bdos
  299.  
  300.     or    a,-1        ; NZ return means we said "YES"
  301.     ret
  302.  
  303. ; Routine to display file names
  304. pfil:
  305.     call    print
  306.     db    '  Copying -->',' '+80h
  307.     ld    de,fcb1
  308.     call    pdsk
  309.     ld    a,(susr)
  310.     call    pusr
  311.     call    pfn
  312.     call    print
  313.     db    ' to',' '+80h
  314.     ld    de,destfcb
  315.     call    pdsk
  316.     ld    a,(dusr)
  317.     call    pusr
  318.     ld    a,(pflag)
  319.     or    a
  320.     ret    z
  321.     JR    pfn
  322.  
  323. pflag:    db    00        ; Flag to print dest filename
  324.  
  325. pdsk:    ld    a,(de)        ; Print file drive  DE -> fcb
  326.     add    'A'-1
  327. pdsk0:    jp    CONOUT
  328.  
  329. pusr:    cp    10        ; Print user number in A
  330.     jr    c,pusr1
  331.     sub    10
  332.     push    af
  333.     ld    a,'1'
  334.     call    CONOUT
  335.     pop    af
  336. pusr0:    add    '0'
  337.     call    CONOUT
  338.     ld    a,':'
  339.     jr    pdsk0
  340. pusr1:    call    pusr0
  341.     ld    a,' '
  342.     jr    pdsk0
  343.  
  344. pfn:    EX    DE,HL
  345.     INC    HL
  346.     JP    PRFN
  347.  
  348. ;
  349. ; Read and write files
  350. ;
  351. r$wfiles:
  352.  
  353. ; Read source file into memory
  354.  
  355. get$fil:
  356.     call    logsu        ; Log source user #
  357.     xor    a
  358.     ld    (cflag),a    ; Reset copy flag
  359.     ld    b,recblks    ; Zero count of records read
  360.     ld    hl,fileloc    ; Location of file buffer
  361.  
  362. getlp:    push    bc        ; Save count
  363.     call    setloc        ; Save pointer and set DMA
  364.     ld    de,fcb1
  365.     ld    c,readf        ; Note that readf returns A <> 0
  366.     call    bdos        ;  when reading record after EOF.
  367.     or    a        ;  Hence RCOUNT = 1 on one rec file
  368.     pop    bc
  369.     jr    nz,wrtfil    ; EOF encountered, exit loop
  370.     ld    hl,(filptr)
  371.     ld    de,128
  372.     add    hl,de
  373.  
  374.     djnz    getlp        ; Still room
  375.     or    a,-1        ; Out of room
  376.     ld    (cflag),a    ; Set flag copy
  377.  
  378. ; Write file to destination
  379.  
  380. wrtfil:    ld    a,recblks    ; B = recblks - (records read)
  381.     sub    b        ; A = records read
  382.     or    a
  383.     ret    z        ; 0 records copied
  384.     ld    b,a        ; Count in B    
  385.  
  386.     push    bc        ; Has record count
  387.     call    logdu        ; Log dest user
  388.     pop    bc
  389.  
  390.     ld    hl,fileloc    ; Write buffer to file
  391. wrtlp:
  392.     push    bc
  393.     call    setloc
  394.     ld    de,destfcb
  395.     ld    c,writef
  396.     call    bdos
  397.     or    a
  398.     pop    bc
  399.     jp    nz,full        ; Disk full error
  400.     ld    hl,(filptr)    ; Move pointer along 128 bytes
  401.     ld    de,128
  402.     add    hl,de
  403.     djnz    wrtlp        ; And get next record
  404.  
  405.     or    a,-1        ; Force NZ on normal return
  406.     ret
  407.  
  408. ; Save file pointer and set up DMA
  409. setloc:
  410.     ld    (filptr),hl
  411.     ex    de,hl
  412.     ld    c,setdmaF
  413.     jp    bdos
  414.  
  415. ; Move file pointer up a record
  416.  
  417. close:
  418.     ld    de,destfcb
  419.     ld    c,closef
  420.     JP    bdos
  421.  
  422. ; Dest filled.  Erase incomplete copy and reset disk.
  423. full:
  424.     ld    c,ERASEF
  425.     ld    de,destfcb
  426.     call    bdos
  427.     call    print
  428.     db    cr,lf,'Disk ful','l'+80h
  429.     ld    c,13        ; Disk reset BDOS function
  430.     call    bdos
  431. fullx:    xor    a
  432.      IF    MCSP
  433.     jp    spaexit
  434.      ELSE
  435.     jp    exit
  436.      ENDIF
  437.  
  438. cflag:    ds    1        ; Copy not done flag
  439. filptr:    dw    0        ; File pointer
  440. destfcb:
  441.     ds    36        ; Temp storage for destination FCB
  442.  
  443. ; END OF RCPFM.LIB
  444.  Copy not done flag
  445. filptr:    dw    0        ; File pointer
  446. destfcb:
  447.     ds    36        ; Temp storag