home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PASCAL / IOSTUFF.ZIP / SAMPLE.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  4.7 KB  |  100 lines
  1. (*********************************************************************)
  2. program dodos(input,output);
  3. (*********************************************************************)
  4. {    Declare external procedures and functions                     }
  5. {                                          }
  6. {        The following routines are not predeclared Pascal     }
  7. {    procedures/functions and must be declared using the EXTERN    }
  8. {    directive.                              }
  9. (*********************************************************************)
  10. procedure date(var s:string); extern;
  11. function dosxqq(command:byte; parm:word):byte; extern;
  12.  
  13. (*********************************************************************)
  14. {                                      }
  15. {    Declare Global variables                      }
  16. {                                      }
  17. (*********************************************************************)
  18. var
  19.   doscall : byte;            {DOS return code (value in AL)}
  20.   command : byte;            {DOS function #              }
  21.   parm    : word;            {DOS parameter list (DS:DX)   }
  22.   smonth  : lstring(2);            {Month string.              }
  23.   sday    : lstring(2);            {Day string.              }
  24.   syear   : lstring(4);            {Year string.           }
  25.   delim   : lstring(1);            {An arbitrary delimiter.      }
  26.   month   : word;            {Current month.              }
  27.   day     : word;            {Current day.              }
  28.   message : lstring(80);        {Character string to be prtd. }
  29.   answer  : string(10);            {MM-DD-YYYY              }
  30.   crcxqq [extern] : word;        {Ext. variable (val. in CX)   }
  31.   crdxqq [extern] : word;        {Ext. variable (val. in DX)   }
  32.  
  33. begin
  34. {*********************************************************************}
  35. {                                      }
  36. {    DOS function call #09:                          }
  37. {                                      }
  38. {    PRINT STRING - On entry, DS:DX must point to a character      }
  39. {    string in memory terminated by a "$" (24H).  Each character   }
  40. {    in the string will be output to the display.              }
  41. {                                      }
  42. {*********************************************************************}
  43.   command := #09;            {Set Function # for Prt. Strg.}
  44.   parm := wrd(adr message[1]);        {Point DS:DX at string          }
  45.   message := 'Today''s date is: $';    {$ terminates string.          }
  46.   doscall := dosxqq(command,parm);    {Call DOS to print string.    }
  47. {*********************************************************************}
  48. {                                      }
  49. {    DOS Function call #2A:                          }
  50. {                                   }
  51. {    GET DATE - Returns date in CX:DX.  CX has the year (1980-     }
  52. {    2099 in binary), DH has the month (1=Jan, 2=Feb, etc) and     }
  53. {    DL has the day.  If the time-of-day clock rolls over to       }
  54. {    the next day, the date is adjusted accordingly, taking into   }
  55. {    account the number of days in each month and leap years.      }
  56. {    Note that the resulant variable, doscall, will contain the    }
  57. {    value in AL upon return from DOS; however, in this particu-   }
  58. {    lar case the information is meaningless.              }
  59. {                                      }
  60. {*********************************************************************}
  61.   command := #2A;            {Set function # for Get Date. }
  62.   doscall := dosxqq(command,parm);    {Call DOS to get date.          }
  63.   month := hibyte(crdxqq);        {Month is returned in DH      }
  64.   day := lobyte(crdxqq);        {Day is returned in DL        }
  65.   writeln(month:2,'-',day:2,'-',crcxqq:4); {Use conventional writeln  }
  66.   writeln('Enter new date as MM-DD-YYYY:');{Prompt for new date.      }
  67.   readln(smonth,delim,sday,delim,syear);{Get new MM-DD-YYYY           }
  68. {*********************************************************************}
  69. {                                      }
  70. {    Do simple preliminary check to catch any format errors        }
  71. {                                          }
  72. {*********************************************************************}
  73.   if (decode(smonth,month) and decode(sday,day) and decode(syear,crcxqq))
  74.      then
  75.      else repeat
  76.        writeln('Invalid format...reenter.');
  77.          readln(smonth,delim,sday,delim,syear);
  78.      until (decode(smonth,month and decode(sday,day) and decode(syear,crcxqq));
  79. {*********************************************************************}
  80. {                                      }
  81. {    DOS Function call #2B:                          }
  82. {                                      }
  83. {    SET DATE - On entry, CRCXQQ must have a valid year (as set    }
  84. {    above); PARM must have a valid month and day value (as set    }
  85. {    below).  If the date is valid the function value returned     }
  86. {    will be a 00, otherwise the returned value will be set to FF. }
  87. {                                      }
  88. {*********************************************************************}
  89.   parm := byword(month,day);        {Make month,day into a word.  }
  90.   command := #2B;            {Set function # to SET DATE.  }
  91.   if (dosxqq(command,parm) = 0)        {If valid date           }
  92.     then
  93.       begin
  94.         writeln('Date has been reset.');
  95.         date(answer);
  96.         writeln('New date is: ',answer);
  97.       end
  98.     else writeln('Error in DOS set-date function.')
  99. end.
  100.