home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb2 / pro20 / setftd.bas < prev    next >
Encoding:
BASIC Source File  |  1988-08-24  |  9.7 KB  |  308 lines
  1. '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  2. '*                                                                         *
  3. '*                              SETFTD.BAS                                 *
  4. '*                                                                         *
  5. '*                        A File Date/Time Editor                            *
  6. '*               written with Microsoft QuickBASIC v4.00b                  *
  7. '*                                                                         *
  8. '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  9. '*                                                                         *
  10. '*  NOTE:                                                                  *
  11. '*                                                                         *
  12. '*  THIS  PROGRAM,  ITS USE,  OPERATION,  AND SUPPORT IS PROVIDED "AS IS"  *
  13. '*  WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING,  *
  14. '*  BUT NOT LIMITED TO,  THE IMPLIED  WARRANTIES  OF  MERCHANTABILITY AND  *
  15. '*  FITNESS FOR A PARTICULAR PURPOSE.   THE ENTIRE RISK AS TO THE QUALITY  *
  16. '*  AND PERFORMANCE OF THIS PROGRAM IS WITH THE USER.   IN NO EVENT SHALL  *
  17. '*  MICROSOFT BE LIABLE FOR  DAMAGES INCLUDING,  WITHOUT LIMITATION,  ANY  *
  18. '*  LOST PROFITS,  LOST  SAVINGS,  OR OTHER  INCIDENTAL OR  CONSEQUENTIAL  *
  19. '*  DAMAGES ARISING FROM  THE USE OR INABILITY TO USE THIS PROGRAM,  EVEN  *
  20. '*  IF MICROSOFT HAS BEEN ADVISED OF THE  POSSIBILTY OF SUCH DAMAGES,  OR  *
  21. '*  FOR ANY CLAIM BY ANY OTHER PARTY.                                      *
  22. '*                                                                         *
  23. '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  24. '
  25. '  This program must be used with QB4DIR.BAS inside QB.EXE, and LINKed to it
  26. '  outside.
  27. '
  28. '----------------------------------------------------------------------------
  29.   
  30.    DEFINT A-Z
  31.  
  32. '----------------------------------------------------------------------------
  33.  
  34.    TYPE Register
  35.         ax    AS INTEGER
  36.         bx    AS INTEGER
  37.         cx    AS INTEGER
  38.         dx    AS INTEGER
  39.         bp    AS INTEGER
  40.         si    AS INTEGER
  41.         di    AS INTEGER
  42.         flags AS INTEGER
  43.         ds    AS INTEGER
  44.         es    AS INTEGER
  45.    END TYPE
  46.  
  47. '----------------------------------------------------------------------------
  48.  
  49.    DECLARE FUNCTION CDate (m%, d%, y%)
  50.    DECLARE FUNCTION CTime (h%, m%, s%)
  51.    DECLARE FUNCTION FileHandle% (File$)
  52.    DECLARE FUNCTION GetDrive$ ()
  53.   
  54. ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  55.   
  56.    DECLARE SUB CloseHandle (Handle%)
  57.    DECLARE SUB CoPrint (f%, b%, m$)
  58.    DECLARE SUB DIR (Path$, DirArray() AS STRING, FA%)
  59.    DECLARE SUB Interrupt (intnum AS INTEGER, inreg AS Register, outreg AS Register)
  60.    DECLARE SUB InterruptX (intnum AS INTEGER, inreg AS Register, outreg AS Register)
  61.    DECLARE SUB ParseCommandLine (Drive$, FileSpec$, NewTime$, NewDate$)
  62.    DECLARE SUB Usage ()
  63.  
  64. '----------------------------------------------------------------------------
  65.  
  66.    DIM regs AS Register
  67.    DIM FileArray(255) AS STRING
  68.    DIM dd AS LONG, tt AS LONG
  69.  
  70. '----------------------------------------------------------------------------
  71.  
  72.    CoPrint 5, 0, "SETFTD.EXE changes the date and time of filespec."
  73.  
  74. '----------------------------------------------------------------------------
  75.  
  76.    ParseCommandLine Drive$, FileSpec$, NewTime$, NewDate$
  77.  
  78. '----------------------------------------------------------------------------
  79.  
  80.    DIR FileSpec$, FileArray(), 0
  81.  
  82. '----------------------------------------------------------------------------
  83.  
  84. 'BEGIN
  85.  
  86.    i = 1
  87.   
  88.    h = VAL(LEFT$(NewTime$, 2))         '
  89.    m = VAL(MID$(NewTime$, 4, 2))       'Parse NewTime$ into hh:mm:ss
  90.    s = VAL(RIGHT$(NewTime$, 2))        '
  91.   
  92.    t = CTime(h, m, s)                  'Convert it to two bytes
  93.   
  94.    m = VAL(LEFT$(NewDate$, 2))         '
  95.    d = VAL(MID$(NewDate$, 4, 2))       'Parse NewDate$ into mm/dd/yy
  96.    y = VAL(RIGHT$(NewDate$, 4)) - 1980 '
  97.   
  98.    d = CDate(m, d, y)                  'Convert in to two bytes
  99.  
  100.    WHILE INSTR(FileArray(i), " ") > 1
  101.  
  102.       Handle = FileHandle%(Drive$ + LEFT$(FileArray(i), INSTR(FileArray(i), " ")))
  103.      
  104.       IF Handle > 0 THEN
  105.          regs.ax = &H5701
  106.          regs.bx = Handle
  107.          regs.cx = t
  108.          regs.dx = d
  109.  
  110.          Interrupt &H21, regs, regs
  111.  
  112.          IF (regs.flags AND 1) = 1 THEN PRINT ">> "; regs.ax
  113.         
  114.          CloseHandle Handle
  115.         
  116.          i = i + 1
  117.       END IF
  118.  
  119.    WEND
  120.  
  121. END
  122.  
  123. FUNCTION CDate (m, d, y)
  124. '----------------------------------------------------------------------------
  125. '  function CDate% encodes the three date parameters into one two-byte
  126. '  numeric (for INT 21H, function 57H, subfunction 01, set file date/time)
  127. '----------------------------------------------------------------------------
  128.  
  129.    t = 0
  130.   
  131.    IF d AND &H1 THEN t = t + &H1
  132.    IF d AND &H2 THEN t = t + &H2
  133.    IF d AND &H4 THEN t = t + &H4
  134.    IF d AND &H8 THEN t = t + &H8
  135.    IF d AND &H10 THEN t = t + &H10
  136.   
  137.    IF m AND &H1 THEN t = t + &H20
  138.    IF m AND &H2 THEN t = t + &H40
  139.    IF m AND &H4 THEN t = t + &H80
  140.    IF m AND &H8 THEN t = t + &H100
  141.  
  142.    IF y AND &H1 THEN t = t + &H200
  143.    IF y AND &H2 THEN t = t + &H400
  144.    IF y AND &H4 THEN t = t + &H800
  145.    IF y AND &H8 THEN t = t + &H1000
  146.    IF y AND &H10 THEN t = t + &H2000
  147.    IF y AND &H20 THEN t = t + &H4000
  148.    IF y AND &H40 THEN t = t + &H8000
  149.       
  150. CDate = t
  151.  
  152. END FUNCTION
  153.  
  154. SUB CloseHandle (Handle)
  155. '----------------------------------------------------------------------------
  156. '  procedure CloseHandle releases a file handle that was aquired via a
  157. '  function that returns a file handle to the program.
  158. '----------------------------------------------------------------------------
  159.  
  160.    DIM regs AS Register
  161.  
  162.    regs.ax = &H3E00
  163.    regs.bx = Handle
  164.   
  165.    Interrupt &H21, regs, regs
  166.   
  167.    IF (regs.flags AND 1) = 1 THEN PRINT "Error"; regs.ax; "closing file"
  168.  
  169. END SUB
  170.  
  171. SUB CoPrint (f, b, m$)
  172. '----------------------------------------------------------------------------
  173. '  procedure CoPrint prints the string passed in the colors specified by
  174. '  f and b in the parameter list.  If the last character in the string is
  175. '  a ";", then <CR><LF> is supressed.
  176. '----------------------------------------------------------------------------
  177.  
  178.    COLOR f, b
  179.    IF RIGHT$(m$, 1) = ";" THEN
  180.       PRINT LEFT$(m$, LEN(m$) - 1);
  181.    ELSE
  182.       PRINT m$
  183.    END IF
  184.  
  185. END SUB
  186.  
  187. FUNCTION CTime (h, m, s)
  188. '----------------------------------------------------------------------------
  189. '  function CTime% encodes the three time parameters into one two-byte
  190. '  numeric (for INT 21H, function 57H, subfunction 01, set file date/time)
  191. '----------------------------------------------------------------------------
  192.  
  193.    t = 0
  194.    
  195.    IF m AND &H1 THEN t = t + &H20
  196.    IF m AND &H2 THEN t = t + &H40
  197.    IF m AND &H4 THEN t = t + &H80
  198.    IF m AND &H8 THEN t = t + &H100
  199.    IF m AND &H10 THEN t = t + &H200
  200.    IF m AND &H20 THEN t = t + &H400
  201.  
  202.    IF h AND &H1 THEN t = t + &H800
  203.    IF h AND &H2 THEN t = t + &H1000
  204.    IF h AND &H4 THEN t = t + &H2000
  205.    IF h AND &H8 THEN t = t + &H4000
  206.    IF h AND &H10 THEN t = t + &H8000
  207.  
  208.    CTime = t
  209.  
  210. END FUNCTION
  211.  
  212. FUNCTION FileHandle% (File$)
  213. '----------------------------------------------------------------------------
  214. '  function FileHandle% returns a file handle to File$
  215. '----------------------------------------------------------------------------
  216.  
  217.    DIM regs AS Register
  218.  
  219.    File$ = File$ + CHR$(0)
  220.    regs.ax = &H3D00 + (128)
  221.    regs.ds = VARSEG(File$)
  222.    regs.dx = SADD(File$)
  223.  
  224.    InterruptX &H21, regs, regs
  225.  
  226.    IF (regs.flags AND 1) = 1 THEN
  227.  
  228.       PRINT "Error"; regs.ax; "getting handle on "; File$
  229.      
  230.       CoPrint 0, 7, "Press a key... "
  231.       WHILE INKEY$ = "": WEND
  232.      
  233.       COLOR 7, 0
  234.       FileHandle = 0
  235.   
  236.    ELSE
  237.      
  238.       FileHandle = regs.ax
  239.   
  240.    END IF
  241.  
  242. END FUNCTION
  243.  
  244. SUB ParseCommandLine (Drive$, FileSpec$, NewTime$, NewDate$)
  245. '----------------------------------------------------------------------------
  246. '  procedure ParseCommandLine takes COMMAND$ and parses it into the
  247. '  various parameters needed by the program.
  248. '----------------------------------------------------------------------------
  249.   
  250.    s1 = INSTR(COMMAND$, " ")
  251.    s2 = INSTR(s1 + 1, COMMAND$, " ")
  252.  
  253.    IF LEN(COMMAND$) > 18 AND s1 = 11 AND s2 = 17 THEN
  254.      
  255.       FileSpec$ = RIGHT$(COMMAND$, LEN(COMMAND$) - 17)
  256.      
  257.       IF INSTR(FileSpec$, ":") = 2 THEN
  258.          Drive$ = LEFT$(FileSpec$, 2)
  259.       ELSE
  260.          Drive$ = GetDrive$ + ":"
  261.       END IF
  262.  
  263.       NewDate$ = LEFT$(COMMAND$, 10)
  264.       NewTime$ = MID$(COMMAND$, 12, 5)
  265.      
  266.       CoPrint 7, 0, "Filespec: [;"
  267.       CoPrint 15, 0, FileSpec$ + ";"
  268.       CoPrint 7, 0, "] Date: [;"
  269.       CoPrint 15, 0, NewDate$ + ";"
  270.       CoPrint 7, 0, "] Time: [;"
  271.       CoPrint 15, 0, NewTime$ + ";"
  272.       CoPrint 7, 0, "]"
  273.  
  274.    ELSE
  275.      
  276.       Usage
  277.       END
  278.  
  279.    END IF
  280.  
  281.    e1$ = LTRIM$(RTRIM$(NewTime$))
  282.    e2$ = LTRIM$(RTRIM$(NewDate$))
  283.    e3$ = LTRIM$(RTRIM$(FileSpec$))
  284.  
  285.    IF LEN(e1$) <> 5 OR LEN(e2$) <> 10 OR LEN(e3$) < 1 THEN
  286.       Usage
  287.       END
  288.    END IF
  289.  
  290. END SUB
  291.  
  292. SUB Usage
  293. '----------------------------------------------------------------------------
  294. '  procedure Usage prints the usage message on the screen if the parameters
  295. '  do not fulfill the needs of the program.
  296. '----------------------------------------------------------------------------
  297.    
  298.    PRINT "Usage:  SETFDT [";
  299.    CoPrint 15, 0, "mm/dd/yyyy;"
  300.    CoPrint 7, 0, "] [;"
  301.    CoPrint 15, 0, "hh:mm;"
  302.    CoPrint 7, 0, "] [;"
  303.    CoPrint 15, 0, "filespec;"
  304.    CoPrint 7, 0, "]"
  305.  
  306. END SUB
  307.  
  308.