home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1995 November / PCWK1195.iso / inne / podstawy / dos / 4dos / 4uzytki / 4utils86.exe / STRINGDA.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-09  |  14KB  |  493 lines
  1. UNIT StringDateHandling;
  2. {$F+} (* I'am using procedural variables! *)
  3. (* ----------------------------------------------------------------------
  4.    Part of 4DESC - A Simple 4DOS File Description Editor
  5.        and 4FF   - 4DOS File Finder
  6.  
  7.        David Frey,         & Tom Bowden
  8.        Urdorferstrasse 30    1575 Canberra Drive
  9.        8952 Schlieren ZH     Stone Mountain, GA 30088-3629
  10.        Switzerland           USA
  11.  
  12.        Code created using Turbo Pascal 7.0, (c) Borland International 1992
  13.  
  14.    DISCLAIMER: This unit is freeware: you are allowed to use, copy
  15.                and change it free of charge, but you may not sell or hire
  16.                this part of 4DESC. The copyright remains in our hands.
  17.  
  18.                If you make any (considerable) changes to the source code,
  19.                please let us know. (send a copy or a listing).
  20.                We would like to see what you have done.
  21.  
  22.                We, David Frey and Tom Bowden, the authors, provide absolutely
  23.                no warranty of any kind. The user of this software takes the
  24.                entire risk of damages, failures, data losses or other
  25.                incidents.
  26.  
  27.  
  28.        Code created using Turbo Pascal 6.0 (c) Borland International 1990
  29.  
  30.    This unit provides the string handling and the date/time handling.
  31.  
  32.    ----------------------------------------------------------------------- *)
  33.  
  34. INTERFACE USES Dos;
  35.  
  36. TYPE  DateStr    = STRING[8];  (* 'mm-dd-yy','dd.mm.yy' or 'yy/mm/dd' *)
  37.       TimeStr    = STRING[6];  (* 'hh:mmp' or 'hh:mm'                 *)
  38.  
  39. VAR   DateFormat: DateStr; (* 'mm-dd-yy','dd.mm.yy','yy/mm/dd' or 'ddmmmyy' *)
  40.       TimeFormat: TimeStr; (* 'hh:mmp' or 'hh:mm'                           *)
  41.  
  42. (* String handling routines. The strings can be converted to lower/upper-
  43.    case. National characters will be converted.                           *)
  44.  
  45. FUNCTION  Chars(c: CHAR; Count: BYTE): STRING;
  46. FUNCTION  DownCase(C: CHAR): CHAR;
  47. FUNCTION  DownStr(s: STRING): STRING;
  48. PROCEDURE DownString(VAR s: STRING);
  49. FUNCTION  UpStr(s: STRING): STRING;
  50. PROCEDURE UpString(VAR s: STRING);
  51.  
  52. PROCEDURE StripLeadingSpaces(VAR s: STRING);
  53. PROCEDURE StripTrailingSpaces(VAR s: STRING);
  54.  
  55. (* Date/Time handling routines. Date/Time and Numbers will be formatted
  56.    in accordance with your COUNTRY=-settings in CONFIG.SYS.               *)
  57.  
  58. TYPE  FormDateFunc = FUNCTION (DateRec: DateTime) : DateStr;
  59.       FormTimeFunc = FUNCTION (DateRec: DateTime) : TimeStr;
  60.  
  61. VAR   FormDate : FormDateFunc;
  62.       FormTime : FormTimeFunc;
  63.  
  64.  
  65. FUNCTION FormattedIntStr(nr: WORD;minlength: BYTE): STRING;
  66. FUNCTION FormattedLongIntStr(nr: LONGINT;minlength: BYTE): STRING;
  67.  
  68. PROCEDURE EvaluateINIFileSettings;
  69.  
  70. IMPLEMENTATION USES HandleINIFile;
  71.  
  72. CONST MonthName: ARRAY[1..12] OF STRING[3] =
  73.                   ('Jan','Feb','Mar','Apr','May','Jun',
  74.                    'Jul','Aug','Sep','Oct','Nov','Dec');
  75.  
  76. CONST DateSep  : CHAR = '.';
  77.       TimeSep  : CHAR = ':';
  78.       MilleSep : CHAR = '''';
  79.  
  80. VAR   Buffer: ARRAY[0..15] OF CHAR;
  81.       (* Buffer for country code information.
  82.          This buffer may not be moved into GetCountryInfo,
  83.          since MS-DOS needs the address of this buffer!    *)
  84.  
  85. (*-------------------------------------------------------- String-Handling *)
  86. FUNCTION Chars(c: CHAR; Count: BYTE): STRING; ASSEMBLER;
  87. (* Concats Count times the character c *)
  88.  
  89. ASM
  90.  LES DI,@Result
  91.  MOV AL,&Count
  92.  CLD
  93.  STOSB
  94.  MOV CL,AL
  95.  XOR CH,CH
  96.  MOV AL,&c
  97.  REP STOSB
  98. END;
  99.  
  100. FUNCTION  DownCase(C: CHAR): CHAR; ASSEMBLER;
  101. (* Returns the character c in lower case, national characters will not
  102.    be handled correctly. [we will use this function to lowercase file
  103.    names and DOS doesn't like special characters in filenames anyway] *)
  104.  
  105. ASM
  106.   MOV AL,&c
  107.   CMP AL,'A'
  108.   JB  @@9                  (* No conversion below 'A'                     *)
  109.   CMP AL,'Z'
  110.   JA  @@9                  (* Conversion between 'A' and 'Z'              *)
  111.   ADD AL,$20
  112. @@9:
  113. END;                       (* finished. *)
  114.  
  115. FUNCTION  DownStr(s: STRING): STRING; ASSEMBLER;
  116. (* Returns the string s in lower case, national characters will not
  117.    be handled correctly. [we will use this function to lowercase file
  118.    names and DOS doesn't like special characters in filenames anyway] *)
  119.  
  120. ASM
  121.  PUSH DS
  122.  CLD
  123.  LDS SI,s
  124.  LES DI,@Result
  125.  LODSB
  126.  STOSB
  127.  XOR AH,AH
  128.  XCHG AX,CX
  129.  JCXZ @11
  130. @10:
  131.  LODSB
  132.  CMP AL,'A'
  133.  JB  @@9                  (* No conversion below 'A'                     *)
  134.  CMP AL,'Z'
  135.  JA  @@9                  (* Conversion between 'A' and 'Z'              *)
  136.  ADD AL,$20
  137. @@9:
  138.  STOSB
  139.  LOOP @10
  140. @11:
  141.  POP DS
  142. END;
  143.  
  144.  
  145. PROCEDURE DownString(VAR s: STRING);
  146. (* Returns the string s in lower case, national characters will not
  147.    be handled correctly. [we will use this function to lowercase file
  148.    names and DOS doesn't like special characters in filenames anyway] *)
  149.  
  150. VAR i : BYTE;
  151.  
  152. BEGIN
  153.  FOR i := 1 TO Length(s) DO s[i] := DownCase(s[i]);
  154. END;
  155.  
  156.  
  157. FUNCTION  UpStr(s: STRING): STRING; ASSEMBLER;
  158. (* Returns the string s in upper case, national characters will not
  159.    be handled correctly.                                              *)
  160.  
  161. ASM
  162.  PUSH DS
  163.  CLD
  164.  LDS SI,s
  165.  LES DI,@Result
  166.  LODSB
  167.  STOSB
  168.  XOR AH,AH
  169.  XCHG AX,CX
  170.  JCXZ @11
  171. @10:
  172.  LODSB
  173.  CMP AL,'a'
  174.  JB @@9
  175.  CMP AL,'z'
  176.  JA @@9
  177.  SUB AL,20H
  178. @@9:
  179.  STOSB
  180.  LOOP @10
  181. @11:
  182.  POP DS
  183. END;
  184.  
  185. PROCEDURE UpString(VAR s: STRING);
  186. (* Returns the string s in upper case, national characters will not
  187.    be handled correctly.                                              *)
  188.  
  189. VAR l : BYTE;
  190.  
  191. BEGIN
  192.  FOR l := 1 TO Length(s) DO s[l] := UpCase(s[l]);
  193. END;
  194.  
  195. PROCEDURE StripLeadingSpaces(VAR s: STRING);
  196.  
  197. BEGIN
  198.  WHILE (Length(s) > 0) AND ((s[1] = ' ') OR (s[1] = #9)) DO
  199.    System.Delete(s,1,1);
  200. END;
  201.  
  202. PROCEDURE StripTrailingSpaces(VAR s: STRING);
  203.  
  204. VAR l : BYTE;
  205.  
  206. BEGIN
  207.  l := Length(s);
  208.  WHILE (l>0) AND ((s[l] = ' ') OR (s[l] = #9)) DO
  209.   BEGIN System.Delete(s,l,1); l := Length(s); END;
  210. END;
  211.  
  212. (*-------------------------------------------------------- Date-Handling *)
  213.  
  214. (* Various Date/Time format utilities to suit national date/time formats *)
  215.  
  216. FUNCTION FormDateEuropean(DateRec: DateTime): DateStr;
  217.  
  218. VAR MonStr, DayStr, YearStr : STRING[2];
  219.     res                     : DateStr;
  220.  
  221. BEGIN
  222.  Str(DateRec.Day:2, DayStr);
  223.  
  224.  Str(DateRec.Month:2, MonStr);
  225.  IF DateRec.Month < 10 THEN MonStr[1] := '0';
  226.  
  227.  DateRec.Year := DateRec.Year MOD 100;
  228.  Str(DateRec.Year:2, YearStr);
  229.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  230.  
  231.  FormDateEuropean := DayStr + DateSep + MonStr + DateSep + YearStr;
  232. END;
  233.  
  234. FUNCTION FormDateUS(DateRec: DateTime): DateStr;
  235.  
  236. VAR MonStr, DayStr, YearStr : STRING[2];
  237.     res                     : DateStr;
  238.  
  239. BEGIN
  240.  Str(DateRec.Day:2, DayStr);
  241.  IF DateRec.Day < 10 THEN DayStr[1] := '0';
  242.  
  243.  Str(DateRec.Month:2, MonStr);
  244.  
  245.  DateRec.Year := DateRec.Year MOD 100;
  246.  Str(DateRec.Year:2, YearStr);
  247.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  248.  
  249.  FormDateUS := MonStr + DateSep + DayStr + DateSep + YearStr;
  250. END;
  251.  
  252. FUNCTION FormDateJapanese(DateRec: DateTime): DateStr;
  253.  
  254. VAR MonStr, DayStr, YearStr : STRING[2];
  255.     res                     : DateStr;
  256.  
  257. BEGIN
  258.  Str(DateRec.Day:2, DayStr);
  259.  IF (DateRec.Day < 10) THEN DayStr[1] := '0';
  260.  
  261.  Str(DateRec.Month:2, MonStr);
  262.  IF (DateRec.Month < 10) THEN MonStr[1] := '0';
  263.  
  264.  DateRec.Year := DateRec.Year MOD 100;
  265.  Str(DateRec.Year:2, YearStr);
  266.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  267.  
  268.  FormDateJapanese := YearStr + DateSep + MonStr + DateSep + DayStr;
  269. END;
  270.  
  271. FUNCTION FormDateMyOwn(DateRec: DateTime): DateStr;
  272.  
  273. VAR DayStr, YearStr : STRING[2];
  274.     res             : DateStr;
  275.  
  276. BEGIN
  277.  Str(DateRec.Day:2, DayStr);
  278.  
  279.  DateRec.Year := DateRec.Year MOD 100;
  280.  Str(DateRec.Year:2, YearStr);
  281.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  282.  
  283.  FormDateMyOwn := DayStr + MonthName[DateRec.Month] + YearStr;
  284. END;
  285.  
  286. FUNCTION FormTime12(DateRec: DateTime): TimeStr;
  287.  
  288. VAR HourStr, MinStr, SecStr : STRING[2];
  289.     amflag                  : CHAR;
  290.     res                     : TimeStr;
  291.  
  292. BEGIN
  293.  IF DateRec.Hour < 12 THEN amflag := 'a'
  294.                       ELSE BEGIN amflag := 'p'; DEC(DateRec.Hour,12); END;
  295.  Str(DateRec.Hour:2,HourStr);
  296.  Str(DateRec.Min :2,MinStr ); IF DateRec.Min < 10 THEN MinStr[1] := '0';
  297.  Str(DateRec.Sec :2,SecStr ); IF DateRec.Sec < 10 THEN SecStr[1] := '0';
  298.  
  299.  FormTime12 := HourStr + TimeSep + MinStr + amflag;
  300. END;
  301.  
  302. FUNCTION FormTime24(DateRec: DateTime): TimeStr;
  303.  
  304. VAR HourStr, MinStr, SecStr : STRING[2];
  305.     res                     : TimeStr;
  306.  
  307. BEGIN
  308.  Str(DateRec.Hour:2,HourStr);
  309.  Str(DateRec.Min :2,MinStr ); IF DateRec.Min < 10 THEN MinStr[1] := '0';
  310.  Str(DateRec.Sec :2,SecStr ); IF DateRec.Sec < 10 THEN SecStr[1] := '0';
  311.  
  312.  FormTime24 := HourStr + TimeSep + MinStr;
  313. END;
  314.  
  315. (*------------------------------------------------ Formatting of numbers *)
  316.  
  317. FUNCTION FormattedIntStr(nr: WORD;minlength: BYTE): STRING;
  318. (* Converts an integer number into a string of the form xxx'xxx...') *)
  319.  
  320. VAR helpstr  : STRING;
  321.     millestr : STRING[4];
  322.     n,i      : BYTE;
  323.  
  324. BEGIN
  325.  IF nr = 0 THEN FormattedIntStr := Chars(' ',minlength-1)+'0'
  326.  ELSE
  327.   BEGIN
  328.    helpstr := ''; millestr := '';
  329.    n := nr DIV 1000; nr := nr MOD 1000;
  330.    IF n > 0 THEN
  331.     BEGIN
  332.      Str(n,helpstr);
  333.      helpstr := millestr+helpstr+MilleSep;
  334.     END;
  335.  
  336.    IF n = 0 THEN Str(nr,millestr)
  337.    ELSE
  338.     BEGIN
  339.      Str(nr:3,millestr);
  340.      FOR i := 1 TO 3 DO IF millestr[i] = ' ' THEN millestr[i] := '0';
  341.     END;
  342.    helpstr:=helpstr+millestr;
  343.    n := Length(helpstr);
  344.    IF n < minlength THEN helpstr := Chars(' ',minlength-n)+helpstr;
  345.  
  346.    FormattedIntStr := helpstr;
  347.   END;
  348. END;
  349.  
  350. FUNCTION FormattedLongIntStr(nr: LONGINT;minlength: BYTE): STRING;
  351. (* Converts a long integer number into a string of the form xxx'xxx...') *)
  352.  
  353. VAR helpstr  : STRING;
  354.     millestr : STRING[4];
  355.     n,i      : WORD;
  356.  
  357. BEGIN
  358.  IF nr = 0 THEN FormattedLongIntStr := Chars(' ',minlength-1)+'0'
  359.  ELSE
  360.   BEGIN
  361.    helpstr := '';
  362.  
  363.    n := nr DIV 1000000; nr := nr MOD 1000000;
  364.    IF n > 0 THEN
  365.     BEGIN
  366.      Str(n,millestr); helpstr := millestr+MilleSep;
  367.     END;
  368.  
  369.    n := nr DIV 1000; nr := nr MOD 1000;
  370.    IF n > 0 THEN
  371.     BEGIN
  372.      Str(n:3,millestr);
  373.      IF helpstr > '' THEN
  374.       BEGIN
  375.        FOR i := 1 TO 3 DO IF millestr[i] = ' ' THEN millestr[i] := '0';
  376.        helpstr := helpstr+millestr+MilleSep;
  377.       END
  378.      ELSE helpstr := millestr+MilleSep;
  379.     END;
  380.  
  381.    IF n = 0 THEN Str(nr,millestr)
  382.    ELSE
  383.     BEGIN
  384.      Str(nr:3,millestr);
  385.      FOR i := 1 TO 3 DO IF millestr[i] = ' ' THEN millestr[i] := '0';
  386.     END;
  387.    helpstr:=helpstr+millestr;
  388.    n := Length(helpstr);
  389.    IF n < minlength THEN helpstr := Chars(' ',minlength-n)+helpstr;
  390.  
  391.    FormattedLongIntStr := helpstr;
  392.   END;
  393. END;
  394.  
  395. (*------------------------------------------------------- Initialisation *)
  396.  
  397. PROCEDURE GetCountryInfo;
  398.  
  399. VAR Regs  : Registers;
  400.  
  401. BEGIN
  402.  WITH Regs DO
  403.   BEGIN
  404.    ah := $38; (* Get / Set Country Data *)
  405.    al := $00;
  406.    ds := Seg(Buffer); dx := Ofs(Buffer); (* Address of Buffer *)
  407.   END;
  408.  MsDos(Regs);
  409.  
  410.  IF Regs.Flags AND FCarry = 0 THEN
  411.   BEGIN
  412.    MilleSep := Buffer[ 7];
  413.    DateSep  := Buffer[11];
  414.    TimeSep  := Buffer[13];
  415.   END;
  416.  
  417.  CASE Ord(Buffer[0]) OF
  418.   0 : BEGIN
  419.        FormDate := FormDateUS;       DateFormat := 'mm'+DateSep+'dd'+DateSep+'yy';
  420.        FormTime := FormTime12;       TimeFormat := 'hh'+TimeSep+'mmp';
  421.       END;
  422.   1 : BEGIN
  423.        FormDate := FormDateEuropean; DateFormat := 'dd'+DateSep+'mm'+DateSep+'yy';
  424.        FormTime := FormTime24;       TimeFormat := 'hh'+TimeSep+'mm';
  425.       END;
  426.   2 : BEGIN
  427.        FormDate := FormDateJapanese; DateFormat := 'yy'+DateSep+'mm'+DateSep+'dd';
  428.        FormTime := FormTime24;       TimeFormat := 'hh'+TimeSep+'mm';
  429.       END;
  430.  ELSE
  431.   BEGIN
  432.    FormDate := FormDateEuropean;     DateFormat := 'dd'+DateSep+'mm'+DateSep+'yy';
  433.    FormTime := FormTime24;           TimeFormat := 'hh'+TimeSep+'mm';
  434.   END;
  435.  END; (* CASE *)
  436. END;
  437.  
  438. PROCEDURE EvaluateINIFileSettings;
  439.  
  440. VAR s : STRING[7];
  441.     c : CHAR;
  442.  
  443. BEGIN
  444.  MilleSep := ReadSettingsChar('dateandtimeformats','millesep',MilleSep);
  445.  TimeSep  := ReadSettingsChar('dateandtimeformats','timesep' ,TimeSep);
  446.  DateSep  := ReadSettingsChar('dateandtimeformats','datesep' ,DateSep);
  447.  
  448.  s := ReadSettingsString('dateandtimeformats','dateformat','ddmmmyy');
  449.  IF s = 'ddmmyy' THEN
  450.   BEGIN
  451.    FormDate := FormDateEuropean; DateFormat := 'dd'+DateSep+'mm'+DateSep+'yy';
  452.   END
  453.  ELSE
  454.  IF s = 'mmddyy' THEN
  455.   BEGIN
  456.    FormDate := FormDateUS;       DateFormat := 'mm'+DateSep+'dd'+DateSep+'yy';
  457.   END
  458.  ELSE
  459.  IF s = 'yymmdd' THEN
  460.   BEGIN
  461.    FormDate := FormDateJapanese; DateFormat := 'yy'+DateSep+'mm'+DateSep+'dd';
  462.   END
  463.  ELSE
  464.   BEGIN
  465.    FormDate := FormDateMyOwn;    DateFormat := 'ddmmmyy';
  466.   END;
  467.  
  468.  s := ReadSettingsString('dateandtimeformats','timeformat','24');
  469.  IF s = '12' THEN
  470.   BEGIN
  471.    FormTime := FormTime12; TimeFormat := 'hh'+TimeSep+'mmp';
  472.   END
  473.  ELSE
  474.   BEGIN
  475.    FormTime := FormTime24; TimeFormat := 'hh'+TimeSep+'mm';
  476.   END;
  477.  
  478.  c := ReadSettingsChar('','ampm',#0); (* from 4DOS.INI *)
  479.  IF c <> '' THEN
  480.   IF c = 'y' THEN
  481.    BEGIN
  482.     FormTime := FormTime12; TimeFormat := 'hh'+TimeSep+'mmp';
  483.    END
  484.   ELSE
  485.    BEGIN
  486.     FormTime := FormTime24; TimeFormat := 'hh'+TimeSep+'mm';
  487.    END
  488. END;
  489.  
  490. BEGIN
  491.  GetCountryInfo;
  492. END.
  493.