home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / basic / bmag / copyit.bas < prev    next >
Encoding:
BASIC Source File  |  1994-04-26  |  2.5 KB  |  78 lines
  1. '─ Area: F-QUICKBASIC ─────────────────────────────────────────────────────────
  2. '  Msg#: 441                                          Date: 14 Apr 94  00:58:00
  3. '  From: Howard Hull Jr                               Read: Yes    Replied: No 
  4. '    To: Blair Colbey                                 Mark:                     
  5. '  Subj: Re: High Speed Qb
  6. '──────────────────────────────────────────────────────────────────────────────
  7. 'BC>MP>I'd be really interested in seeing the "copy files with no shelling" and
  8. 'BC>MP>"file exist" things if you could be convinced to dig 'em out and post
  9. 'BC>MP>'em.
  10.  
  11. '   Blair here is a quick routine that seems a little simpler. at least
  12. 'for me it is. It uses the main theory with some minor differences.
  13. 'Then again how many different Copy functions can there be.
  14.  
  15. DEFINT A-Z
  16. DECLARE FUNCTION CopyIt% (FromFile$, ToFile$)
  17. '$INCLUDE: '\QB\QB.BI'
  18. CONST TRUE = -1, FALSE = NOT TRUE
  19.  
  20. Ct = CopyIt(From$, ToFil$)
  21. END
  22.  
  23.  
  24. FUNCTION CopyIt% (FromFile$, ToFile$)
  25. From = FREEFILE
  26. Tof = FREEFILE
  27. OPEN FromFile$ FOR BINARY AS #From
  28. OPEN ToFile$ FOR BINARY AS #Tof
  29. '---- 32000 is a made-up number and can be changed to suit your needs
  30. '---- it can not be larger than 32766, and all instances must be changed
  31. IF LOF(From) >= 32000 THEN
  32.    Counts = LOF(From) \ 32000
  33.    Extra = LOF(From) MOD 32000
  34. ELSEIF LOF(From) < 32000 THEN
  35.    Counts = 0
  36.    Extra = LOF(From)
  37. END IF
  38. FOR A = 1 TO Counts     ' This loop will be skipped if Counts = 0
  39.    BigSpace$ = SPACE$(32000)
  40.    GET #From, , BigSpace$
  41.    PUT #Tof, , BigSpace$
  42. NEXT A
  43. BigSpace$ = ""          ' erase BigSpace$ to release memory
  44. SmallSpace$ = SPACE$(Extra)
  45. GET #From, , SmallSpace$
  46. PUT #2, , SmallSpace$
  47. SmallSpace$ = ""        ' erase SmallSpace$ to release memory
  48. CLOSE Tof, From         ' Close files
  49.  
  50. '------ Change new files attributes to coencide with old one's.
  51. DIM Reg AS RegTypeX
  52. ZFrom$ = From$ + CHR$(0)
  53. Reg.ax = &H4300                 ' Get file attributes
  54. Reg.ds = VARSEG(ZFrom$)
  55. Reg.dx = SADD(ZFrom$)
  56. INTERRUPTX &H21, Reg, Reg       ' Call the interrupt to get attribute
  57.  
  58. IF Reg.flags AND 1 then        'Error occurred so return it
  59.    CopyIt = Reg.ax
  60.    EXIT FUNCTION
  61. ELSE
  62.    Attributes = Reg.cx
  63. END IF
  64. ZTo$ = To$ + CHR$(0)
  65. Reg.ax = &H4301                 ' Set attributes
  66. Reg.cx = Attributes
  67. Reg.ds = VARSEG(ZTo$)
  68. Reg.dx = SADD(ZTo$)
  69. INTERRUPTX &H21, Reg, Reg       ' Call the interrupt to set attribute
  70.  
  71. IF Reg.flags AND 1 then        'Error occurred so return it
  72.    CopyIt = Reg.ax
  73.    EXIT FUNCTION
  74. ELSE
  75. END IF
  76.  
  77. END FUNCTION
  78.