27aea1d1ad
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5438 8e941d3f-bd1b-0410-a28a-d453659cc2b4
296 lines
8.4 KiB
ObjectPascal
296 lines
8.4 KiB
ObjectPascal
{*********************************************************}
|
|
{* FlashFiler: Date/time support routines *}
|
|
{*********************************************************}
|
|
|
|
(* ***** BEGIN LICENSE BLOCK *****
|
|
* Version: MPL 1.1
|
|
*
|
|
* The contents of this file are subject to the Mozilla Public License Version
|
|
* 1.1 (the "License"); you may not use this file except in compliance with
|
|
* the License. You may obtain a copy of the License at
|
|
* http://www.mozilla.org/MPL/
|
|
*
|
|
* Software distributed under the License is distributed on an "AS IS" basis,
|
|
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
* for the specific language governing rights and limitations under the
|
|
* License.
|
|
*
|
|
* The Original Code is TurboPower FlashFiler
|
|
*
|
|
* The Initial Developer of the Original Code is
|
|
* TurboPower Software
|
|
*
|
|
* Portions created by the Initial Developer are Copyright (C) 1996-2002
|
|
* the Initial Developer. All Rights Reserved.
|
|
*
|
|
* Contributor(s):
|
|
*
|
|
* ***** END LICENSE BLOCK ***** *)
|
|
|
|
{$I ffdefine.inc}
|
|
|
|
unit fflldate;
|
|
|
|
interface
|
|
|
|
uses
|
|
ffllbase,
|
|
ffstdate,
|
|
Windows,
|
|
SysUtils;
|
|
|
|
const
|
|
{the following characters are meaningful in date Picture masks}
|
|
pmMonth = 'M'; {formatting character for a date string picture mask. }
|
|
pmDay = 'D'; {formatting character for a date string picture mask. }
|
|
pmYear = 'Y'; {formatting character for a date string picture mask}
|
|
pmDateSlash = '/'; {formatting character for a date string picture mask}
|
|
|
|
pmHour = 'h'; {formatting character for a time string picture mask}
|
|
pmMinute = 'm'; {formatting character for a time string picture mask}
|
|
pmSecond = 's'; {formatting character for a time string picture mask}
|
|
{'hh:mm:ss tt' -\> '12:00:00 pm', 'hh:mmt' -\> '12:00p'}
|
|
pmAmPm = 't'; {formatting character for a time string picture mask.
|
|
This generates 'AM' or 'PM'}
|
|
pmTimeColon = ':'; {formatting character for a time string picture mask}
|
|
|
|
MaxDateLen = 40; { maximum length of date picture mask }
|
|
|
|
|
|
function DateStringToDMY(const Picture, S : string; var Day, Month, Year : Integer;
|
|
Epoch : Integer) : Boolean;
|
|
{-extract day, month, and year from S, returning true if string is valid}
|
|
|
|
function DatePCharToDMY(Picture, S : PAnsiChar; var Day, Month, Year : Integer;
|
|
Epoch : Integer) : Boolean;
|
|
{-extract day, month, and year from S, returning true if string is valid}
|
|
|
|
function TimeStringToHMS(const Picture, S : string;
|
|
var Hour, Minute, Second : Integer) : Boolean;
|
|
{-extract Hours, Minutes, Seconds from St, returning true if string is valid}
|
|
|
|
function TimePCharToHMS(Picture, S : PAnsiChar;
|
|
var Hour, Minute, Second : Integer) : Boolean;
|
|
{-extract Hours, Minutes, Seconds from St, returning true if string is valid}
|
|
|
|
implementation
|
|
|
|
var
|
|
w1159 : array[0..5] of AnsiChar;
|
|
w2359 : array[0..5] of AnsiChar;
|
|
|
|
|
|
{===== Internal Routines =====}
|
|
|
|
function StrChPos(P : PAnsiChar; C : AnsiChar;
|
|
var Pos : Cardinal): Boolean; register;
|
|
{-Sets Pos to position of character C within string P returns True if found}
|
|
asm
|
|
push esi {save since we'll be changing}
|
|
push edi
|
|
push ebx
|
|
mov esi, ecx {save Pos}
|
|
|
|
cld {forward string ops}
|
|
mov edi, eax {copy P to EDI}
|
|
or ecx, -1
|
|
xor eax, eax {zero}
|
|
mov ebx, edi {save EDI to EBX}
|
|
repne scasb {search for NULL terminator}
|
|
not ecx
|
|
dec ecx {ecx has len of string}
|
|
|
|
test ecx, ecx
|
|
jz @@NotFound {if len of P = 0 then done}
|
|
|
|
mov edi, ebx {reset EDI to beginning of string}
|
|
mov al, dl {copy C to AL}
|
|
repne scasb {find C in string}
|
|
jne @@NotFound
|
|
|
|
mov ecx, edi {calculate position of C}
|
|
sub ecx, ebx
|
|
dec ecx {ecx holds found position}
|
|
|
|
mov [esi], ecx {store location}
|
|
mov eax, 1 {return true}
|
|
jmp @@ExitCode
|
|
|
|
@@NotFound:
|
|
xor eax, eax
|
|
|
|
@@ExitCode:
|
|
|
|
pop ebx {restore registers}
|
|
pop edi
|
|
pop esi
|
|
end;
|
|
|
|
|
|
function UpCaseChar(C : AnsiChar) : AnsiChar; register;
|
|
asm
|
|
and eax, 0FFh
|
|
push eax
|
|
call CharUpper
|
|
end;
|
|
|
|
procedure ExtractFromPicture(Picture, S : PAnsiChar;
|
|
Ch : AnsiChar; var I : Integer;
|
|
Blank, Default : Integer);
|
|
{-extract the value of the subfield specified by Ch from S and return in
|
|
I. I will be set to -1 in case of an error, Blank if the subfield exists
|
|
in Picture but is empty, Default if the subfield doesn't exist in
|
|
Picture.}
|
|
var
|
|
PTmp : Array[0..20] of AnsiChar;
|
|
J, K : Cardinal;
|
|
Code : Integer;
|
|
Found,
|
|
UpFound : Boolean;
|
|
begin
|
|
{find the start of the subfield}
|
|
I := Default;
|
|
Found := StrChPos(Picture, Ch, J);
|
|
Ch := UpCaseChar(Ch);
|
|
UpFound := StrChPos(Picture, Ch, K);
|
|
|
|
if not Found or (UpFound and (K < J)) then begin
|
|
J := K;
|
|
Found := UpFound;
|
|
end;
|
|
if not Found or (StrLen(S) <> StrLen(Picture)) then
|
|
Exit;
|
|
|
|
{extract the substring}
|
|
PTmp[0] := #0;
|
|
K := 0;
|
|
while (UpCaseChar(Picture[J]) = Ch) and (J < StrLen(Picture)) do begin
|
|
if S[J] <> ' ' then begin
|
|
PTmp[k] := S[J];
|
|
Inc(K);
|
|
PTmp[k] := #0;
|
|
end;
|
|
Inc(J);
|
|
end;
|
|
|
|
if StrLen(PTmp) = 0 then
|
|
I := Blank
|
|
else begin
|
|
{convert to a value}
|
|
Val(PTmp, I, Code);
|
|
if Code <> 0 then
|
|
I := -1;
|
|
end;
|
|
end;
|
|
|
|
{===== Exported routines =====}
|
|
|
|
|
|
function DateStringToDMY(const Picture, S : string; var Day, Month, Year : Integer;
|
|
Epoch : Integer) : Boolean;
|
|
{-extract day, month, and year from S, returning true if string is valid}
|
|
var
|
|
Buf1 : array[0..255] of AnsiChar;
|
|
Buf2 : array[0..255] of AnsiChar;
|
|
begin
|
|
StrPCopy(Buf1, Picture);
|
|
StrPCopy(Buf2, S);
|
|
Result := DatePCharToDMY(Buf1, Buf2, Day, Month, Year, Epoch);
|
|
end;
|
|
|
|
function DatePCharToDMY(Picture, S : PAnsiChar; var Day, Month, Year : Integer;
|
|
Epoch : Integer) : Boolean;
|
|
{-extract day, month, and year from S, returning true if string is valid}
|
|
begin
|
|
Result := False;
|
|
if StrLen(Picture) <> StrLen(S) then
|
|
Exit;
|
|
|
|
ExtractFromPicture(Picture, S, pmMonth, Month, -1, DefaultMonth);
|
|
ExtractFromPicture(Picture, S, pmDay, Day, -1, 1);
|
|
ExtractFromPicture(Picture, S, pmYear, Year, -1, DefaultYear);
|
|
Result := ValidDate(Day, Month, Year, Epoch);
|
|
end;
|
|
|
|
function TimeStringToHMS(const Picture, S : string;
|
|
var Hour, Minute, Second : Integer) : Boolean;
|
|
{-extract Hours, Minutes, Seconds from St, returning true if string is valid}
|
|
var
|
|
Buf1 : array[0..255] of AnsiChar;
|
|
Buf2 : array[0..255] of AnsiChar;
|
|
begin
|
|
StrPCopy(Buf1, Picture);
|
|
StrPCopy(Buf2, S);
|
|
Result := TimePCharToHMS(Buf1, Buf2, Hour, Minute, Second);
|
|
end;
|
|
|
|
function TimePCharToHMS(Picture, S : PAnsiChar;
|
|
var Hour, Minute, Second : Integer) : Boolean;
|
|
{-extract Hours, Minutes, Seconds from St, returning true if string is valid}
|
|
var
|
|
I, J : Cardinal;
|
|
Tmp,
|
|
t1159,
|
|
t2359 : array[0..20] of AnsiChar;
|
|
begin
|
|
Result := False;
|
|
if StrLen(Picture) <> StrLen(S) then
|
|
Exit;
|
|
|
|
{extract hours, minutes, seconds from St}
|
|
ExtractFromPicture(Picture, S, pmHour, Hour, -1, 0);
|
|
ExtractFromPicture(Picture, S, pmMinute, Minute, -1, 0);
|
|
ExtractFromPicture(Picture, S, pmSecond, Second, -1, 0);
|
|
if (Hour = -1) or (Minute = -1) or (Second = -1) then begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
|
|
{check for TimeOnly}
|
|
if StrChPos(Picture, pmAmPm, I) and (w1159[0] <> #0)
|
|
and (w2359[0] <> #0) then begin
|
|
Tmp[0] := #0;
|
|
J := 0;
|
|
while Picture[I] = pmAmPm do begin
|
|
Tmp[J] := S[I];
|
|
Inc(J);
|
|
Inc(I);
|
|
end;
|
|
Tmp[J] := #0;
|
|
FFStrTrimR(Tmp);
|
|
|
|
StrCopy(t1159, w1159);
|
|
t1159[J] := #0;
|
|
StrCopy(t2359, w2359);
|
|
t2359[J] := #0;
|
|
|
|
if (Tmp[0] = #0) then
|
|
Hour := -1
|
|
else if StrIComp(Tmp, t2359) = 0 then begin
|
|
if (Hour < 12) then
|
|
Inc(Hour, 12)
|
|
else if (Hour = 0) or (Hour > 12) then
|
|
{force BadTime}
|
|
Hour := -1;
|
|
end else if StrIComp(Tmp, t1159) = 0 then begin
|
|
if Hour = 12 then
|
|
Hour := 0
|
|
else if (Hour = 0) or (Hour > 12) then
|
|
{force BadTime}
|
|
Hour := -1;
|
|
end else
|
|
{force BadTime}
|
|
Hour := -1;
|
|
end;
|
|
|
|
Result := ValidTime(Hour, Minute, Second);
|
|
end;
|
|
|
|
initialization
|
|
GetProfileString('intl', 's1159', 'AM', w1159, SizeOf(w1159));
|
|
GetProfileString('intl', 's2359', 'PM', w2359, SizeOf(w2359));
|
|
end.
|
|
|
|
|
|
|