Str2Date Routines
Converts a string containing a Date into a DateTime.

Unit
QESBPCSDateTime

Overloaded Variants
Function Str2Date(const DateStr: string): TDateTime;
Function Str2Date(const DateStr: string; const Year, StartMonth: Integer): TDateTime;

Declaration
Function Str2Date(const DateStr: string): TDateTime;

Description
If the Item has no month and/or year then the current month and year will be assumed.

The following are all exceptable separators for entry: [' ', ',', '.', '/', '-', '\'] though the current DateSeparator will be used for display.

Dates can be entered without Separators but Leading Zeroes must then be used. Date parsing is highly dependant upon the current ShortDateFormat. ESB2DigitYr contols the different ways in which 2 Digit Years are handled in Str2Date.

edyNone - Nothing is done, left to Delphi to handle.

edyCutOff - the ESB2DigitCutOff is used to decide which century the date lies in. If 1900 + Yr less than ESB2DigitCutOff then it is assumed that 2000 + Yr is wanted, otherwise 1900 + Yr is used.

edyHistoric - asssumes that the yr is this year or earlier.

Parameters
DateStr The String to convert.
Year If Year and StartMonth are entered then if the Month is at least StartMonth, then this Year is implied. If it is less then the StartMonth then Year + 1 is implied. Only has meaning if the Year is omitted in the String.
StartMonth If Year and StartMonth are entered then if the Month is at least StartMonth, then this Year is implied. If it is less then the StartMonth then Year + 1 is implied. Only has meaning if the Year is omitted in the String.

Category
Date/Time Conversion Routines

Implementation

function Str2Date (const DateStr: string): TDateTime;
var
     P1, P2, I: Integer;
     Yr: Word;
     DateOrder: TESBDateOrder;
     Hold: Boolean;
     S: string;
     Found: Boolean;
begin
     S := UpperCase (Trim (DateStr));
     if S = '' then
     begin
          Result := 0.0;
          Exit;
     end;

     if S [1] = '+' then
     begin
          Result := ESBToday + Str2Float (RightAfterStr (S, 1));
          Exit;
     end
     else if S [1] = '-' then
     begin
          Result := ESBToday - Str2Float (RightAfterStr (S, 1));
          Exit;
     end;

     DateOrder := GetESBDateOrder (ShortDateFormat);

     Hold := ESBBlankWhenZero;
     ESBBlankWhenZero := False;
     try
          if IsDigitStr (S) then
          begin
               case Length (S) of
                    4: S := LeftStr (S, 2) + DateSeparator + RightStr (S, 2);
                    6: S := LeftStr (S, 2) + DateSeparator + Copy (S, 3, 2)
                         + DateSeparator + Copy (S, 5, 2);
                    8:
                         begin
                              if DateOrder = edoYMD then
                                   S := LeftStr (S, 4) + DateSeparator + Copy (S, 5, 2)
                                        + DateSeparator + Copy (S, 7, 2)
                              else
                                   S := LeftStr (S, 2) + DateSeparator + Copy (S, 3, 2)
                                        + DateSeparator + Copy (S, 5, 4);
                         end;
               end;
          end
          else
          begin
               Found := False;
               for I := 1 to 12 do
               begin
                    P1 := Pos (UpperCase (LongMonthNames [I]), S);
                    if P1 > 0 then
                    begin
                         S := LeftStr (S, P1 - 1) + Int2EStr (I) +
                              RightAfterStr (S, P1 + Length (LongMonthNames [I]) - 1);
                         Found := True;
                         Break;
                    end;
               end;

               if not Found then
               begin
                    for I := 1 to 12 do
                    begin
                         P1 := Pos (UpperCase (ShortMonthNames [I]), S);
                         if P1 > 0 then
                         begin
                              S := LeftStr (S, P1 - 1) + Int2EStr (I) +
                                   RightAfterStr (S, P1 + Length (ShortMonthNames [I]) - 1);
                              Break;
                         end;
                    end;
               end;
          end;

          try
               // Allow '-' and '/' as valid alternatives for DateSeparator
               S := ReplaceChStr (S, '-', DateSeparator);
               S := ReplaceChStr (S, '/', DateSeparator);
               S := ReplaceChStr (S, '\', DateSeparator);
               S := ReplaceChStr (S, ' ', DateSeparator);
               S := ReplaceChStr (S, '.', DateSeparator);
               S := ReplaceChStr (S, ',', DateSeparator);

               // Remove trailing Separator if any
               if S [Length (S)] = DateSeparator then
               begin
                    S := LeftStr (S, Length (S) - 1);
                    if S = '' then
                    begin
                         Result := 0.0;
                         Exit;
                    end;
               end;

               // Remove Duplicate Separators
               repeat
                    P1 := Pos (DateSeparator + DateSeparator, S);
                    if P1 <> 0 then
                         Delete (S, P1, 1);
               until P1 = 0;

               P1 := ESBPosCh (DateSeparator, S);
               if P1 > 0 then // If at least one Date Separator
               begin
                    P2 := ESBPosCh (DateSeparator, Copy (S, P1 + 1, Length (S) - P1));
                    if P2 > 0 then // If 2 Date Separators
                    begin
                         // Get Components
                         case DateOrder of
                              edoDMY, edoMDY:
                                   begin
                                        Yr := Str2Word (Copy (S, P1 + P2 + 1, Length (S) - (P1 + P2)));
                                   end;
                         else
                              begin
                                   Yr := Str2Word (LeftStr (S, P1 - 1));
                              end;
                         end;

                         if Yr < 100 then // If 2 Digit
                         begin
                              case ESB2DigitYr of
                                   // edyNone - Nothing has to be done
                                   edyCutOff: // Process using ESB2DigitCutOff
                                        begin
                                             if 1900 + Yr < ESB2DigitCutOff then
                                                  Yr := 2000 + Yr
                                             else
                                                  Yr := 1900 + Yr
                                        end;
                                   edyHistoric: // Take Yr as this year or earlier
                                        begin
                                             if 2000 + Yr <= ThisYear then
                                                  Yr := 2000 + Yr
                                             else
                                                  Yr := 1900 + Yr;
                                        end;
                              end;
                         end;
                         // Rebuild String
                         case DateOrder of
                              edoDMY, edoMDY:
                                   begin
                                        S := LeftStr (S, P1 + P2) + Int2EStr (Yr);
                                   end;
                              edoYMD:
                                   begin
                                        S := Int2EStr (Yr) + RightAfterStr (S, P1 - 1);
                                   end;
                         end;
                    end
                    else
                    begin
                         // Assume This Year is implied
                         case DateOrder of
                              edoDMY, edoMDY:
                                   begin
                                        S := S + DateSeparator + Int2EStr (ThisYear)
                                   end;
                              edoYMD:
                                   begin
                                        S := Int2EStr (ThisYear) + DateSeparator + S;
                                   end;
                         end;
                    end;
               end
               else
               begin
                    // Assume This Month and Year are implied
                    case DateOrder of
                         edoDMY:
                              begin
                                   S := S + DateSeparator + Int2EStr (ThisMonth)
                                        + DateSeparator + Int2EStr (ThisYear);
                              end;
                         edoMDY:
                              begin
                                   S := Int2EStr (ThisMonth) + DateSeparator + S
                                        + DateSeparator + Int2EStr (ThisYear);
                              end;
                         edoYMD:
                              begin
                                   S := Int2EStr (ThisYear) + DateSeparator +
                                        Int2EStr (ThisMonth) + DateSeparator + S;
                              end;
                    end;
               end;

               //Int ensures the fractional Component is 0
               Result := Int (StrToDate (S));
          except
               Result := 0.0;
               if ESBRaiseDateError then
                    raise EConvertError.Create (rsInvalidDate + ' - ' + DateStr);
          end;
     finally
          ESBBlankWhenZero := Hold;
     end;
End;

Declaration
Function Str2Date(const DateStr: string; const Year, StartMonth: Integer): TDateTime;

Implementation

function Str2Date (const DateStr: string; const Year, StartMonth: Integer): TDateTime;
var
     P1, P2, I: Integer;
     Yr, Mnth: Integer;
     DateOrder: TESBDateOrder;
     Hold: Boolean;
     S: string;
     Found: Boolean;
begin
     if (StartMonth < 1) or (StartMonth > 12) then
          raise EConvertError.Create (rsInvalidMonth);

     S := UpperCase (Trim (DateStr));
     if S = '' then
     begin
          Result := 0.0;
          Exit;
     end;

     if S [1] = '+' then
     begin
          Result := ESBToday + Str2Float (RightAfterStr (S, 1));
          Exit;
     end
     else if S [1] = '-' then
     begin
          Result := ESBToday - Str2Float (RightAfterStr (S, 1));
          Exit;
     end;

     DateOrder := GetESBDateOrder (ShortDateFormat);

     Hold := ESBBlankWhenZero;
     ESBBlankWhenZero := False;
     try
          if IsDigitStr (S) then
          begin
               case Length (S) of
                    4: S := LeftStr (S, 2) + DateSeparator + RightStr (S, 2);
                    6: S := LeftStr (S, 2) + DateSeparator + Copy (S, 3, 2)
                         + DateSeparator + Copy (S, 5, 2);
                    8:
                         begin
                              if DateOrder = edoYMD then
                                   S := LeftStr (S, 4) + DateSeparator + Copy (S, 5, 2)
                                        + DateSeparator + Copy (S, 7, 2)
                              else
                                   S := LeftStr (S, 2) + DateSeparator + Copy (S, 3, 2)
                                        + DateSeparator + Copy (S, 5, 4);
                         end;
               end;
          end
          else
          begin
               Found := False;
               for I := 1 to 12 do
               begin
                    P1 := Pos (UpperCase (LongMonthNames [I]), S);
                    if P1 > 0 then
                    begin
                         S := LeftStr (S, P1 - 1) + Int2EStr (I) +
                              RightAfterStr (S, P1 + Length (LongMonthNames [I]) - 1);
                         Found := True;
                         Break;
                    end;
               end;

               if not Found then
               begin
                    for I := 1 to 12 do
                    begin
                         P1 := Pos (UpperCase (ShortMonthNames [I]), S);
                         if P1 > 0 then
                         begin
                              S := LeftStr (S, P1 - 1) + Int2EStr (I) +
                                   RightAfterStr (S, P1 + Length (ShortMonthNames [I]) - 1);
                              Break;
                         end;
                    end;
               end;
          end;

          try
               // Allow '-' and '/' as valid alternatives for DateSeparator
               S := ReplaceChStr (S, '-', DateSeparator);
               S := ReplaceChStr (S, '/', DateSeparator);
               S := ReplaceChStr (S, '\', DateSeparator);
               S := ReplaceChStr (S, ' ', DateSeparator);
               S := ReplaceChStr (S, '.', DateSeparator);
               S := ReplaceChStr (S, ',', DateSeparator);

               // Remove trailing Separator if any
               if S [Length (S)] = DateSeparator then
               begin
                    S := LeftStr (S, Length (S) - 1);
                    if S = '' then
                    begin
                         Result := 0.0;
                         Exit;
                    end;
               end;

               // Remove Duplicate Separators
               repeat
                    P1 := Pos (DateSeparator + DateSeparator, S);
                    if P1 <> 0 then
                         Delete (S, P1, 1);
               until P1 = 0;

               P1 := ESBPosCh (DateSeparator, S);
               if P1 > 0 then // If at least one Date Separator
               begin
                    P2 := ESBPosCh (DateSeparator, Copy (S, P1 + 1, Length (S) - P1));
                    if P2 > 0 then // If 2 Date Separators
                    begin
                         // Get Components
                         case DateOrder of
                              edoDMY, edoMDY:
                                   begin
                                        Yr := Str2Word (Copy (S, P1 + P2 + 1, Length (S) - (P1 + P2)));
                                   end;
                         else
                              begin
                                   Yr := Str2Word (LeftStr (S, P1 - 1));
                              end;
                         end;

                         if Yr < 100 then // If 2 Digit
                         begin
                              case ESB2DigitYr of
                                   // edyNone - Nothing has to be done
                                   edyCutOff: // Process using ESB2DigitCutOff
                                        begin
                                             if 1900 + Yr < ESB2DigitCutOff then
                                                  Yr := 2000 + Yr
                                             else
                                                  Yr := 1900 + Yr
                                        end;
                                   edyHistoric: // Take Yr as this year or earlier
                                        begin
                                             if 2000 + Yr <= Year + 1 then
                                                  Yr := 2000 + Yr
                                             else
                                                  Yr := 1900 + Yr;
                                        end;
                              end;
                         end;
                         // Rebuild String
                         case DateOrder of
                              edoDMY, edoMDY:
                                   begin
                                        S := LeftStr (S, P1 + P2) + Int2EStr (Yr);
                                   end;
                              edoYMD:
                                   begin
                                        S := Int2EStr (Yr) + RightAfterStr (S, P1 - 1);
                                   end;
                         end;
                    end
                    else
                    begin
                         // Assume This Year is implied
                         case DateOrder of
                              edoDMY:
                                   begin
                                        Mnth := Str2Int (RightAfterChStr (S, DateSeparator));
                                   end;
                         else
                              Mnth := Str2Int (LeftTillChStr (S, DateSeparator));
                         end;
                         if Mnth < StartMonth then
                              Yr := Year + 1
                         else
                              Yr := Year;

                         case DateOrder of
                              edoDMY, edoMDY:
                                   begin
                                        S := S + DateSeparator + Int2EStr (Yr)
                                   end;
                              edoYMD:
                                   begin
                                        S := Int2EStr (Yr) + DateSeparator + S;
                                   end;
                         end;
                    end;
               end
               else
               begin
                    Mnth := ThisMonth;
                    if Mnth < StartMonth then
                         Yr := Year + 1
                    else
                         Yr := Year;

                    // Assume This Month and Year are implied
                    case DateOrder of
                         edoDMY:
                              begin
                                   S := S + DateSeparator + Int2EStr (Mnth)
                                        + DateSeparator + Int2EStr (Yr);
                              end;
                         edoMDY:
                              begin
                                   S := Int2EStr (Mnth) + DateSeparator + S
                                        + DateSeparator + Int2EStr (Yr);
                              end;
                         edoYMD:
                              begin
                                   S := Int2EStr (Yr) + DateSeparator +
                                        Int2EStr (Mnth) + DateSeparator + S;
                              end;
                    end;
               end;

               //Int ensures the fractional Component is 0
               Result := Int (StrToDate (S));
          except
               Result := 0.0;
               if ESBRaiseDateError then
                    raise EConvertError.Create (rsInvalidDate + ' - ' + DateStr);
          end;
     finally
          ESBBlankWhenZero := Hold;
     end;
End;


HTML generated by Time2HELP
http://www.time2help.com