uw3cdtf.pas

自己写的一个 RSS 阅读器

unit uW3CDTF;

interface
uses SysUtils, FastStrings;
type
	TW3CDTF = class
    public
      constructor Create(sDate : string);
      constructor CreateDateTime(dDate : TDateTime);
      function ToW3CDTFString() : string;
      function ToRFC822String() : string;
      function ToDateTime() : TDateTime;
      function ToString() : string;
      function IsEmpty() : boolean;
      function isToDay:Boolean;
      function isYestoday:Boolean;
    private
      Error:Boolean;
      DateString:string;
      dateValue : TDateTime;
      function ToShortRFC822String: string;
      function ArrToMonth(S:string):Integer;
      procedure SetDateTime(sY,sM,sD,sH,sMM,sS,sPM:string);
      procedure CreateW3CDTF(sDate : string);
      procedure CreateRFC822(sDate : string);

    end;
const
  C_Months: array[1..12] of string = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  C_Days: array[1..7] of string = ( 'Sun','Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');

var
	TimeZone : TDateTime;
function ToDayStr:string;
function YestoDayStr:string;

implementation

uses DateUtils,Classes,Windows,RegExpr,Dialogs;


{ TW3CDTF }
function ToDayStr:string;
var W3C:TW3CDTF;
begin
  W3C:=TW3CDTF.CreateDateTime(now);
  Result := W3C.ToShortRFC822String;
end;
function YestoDayStr:string;
var W3C:TW3CDTF;
  yd:TDateTime;
  sday,sYear,sMonth:Word;
begin
  sday := DayOf(Now);
  sYear := YearOf(Now);
  sMonth := MonthOf(Now);
  yd := EncodeDate(sYear, sMonth, sDay -1);
  W3C:=TW3CDTF.CreateDateTime(yd);
  Result := W3C.ToShortRFC822String;
end;
function Str2Lint (const S: String): LongInt;
begin
	try
		Result := StrToInt (S);
	except
		Result := 0;
	end;
end;

function RFC822Value(const RFC822: string): Extended;
var
	S: String;
	L: LongInt;
const
    MinsInDays = 1440;

begin
	S := UpperCase (Trim (RFC822));
	Result := 0.0;
	if (S = 'GMT') or (S = 'UT') or (S = 'Z') or (S = '') then
		Exit
	else if (S = 'M') then
		Result := -12.0
	else if (S = 'PST') then
		Result := -8.0
	else if (S = 'MST') or (S = 'PDT') then
		Result := -7.0
	else if (S = 'CST') or (S = 'MDT') then
		Result := -6.0
	else if (S = 'EST') or (S = 'CDT') then
		Result := -5.0
	else if (S = 'EDT') then
		Result := -4.0
	else if (S = 'A') then
		Result := -1.0
	else if (S = 'N') then
		Result := 1.0
	else if (S = 'Y') then
		Result := 12.0
	else
	begin
		L := Str2LInt (S);
		Result := L div 100 + (L mod 100) / 60;
	end;
    Result := (Result * 60) / MinsInDays;
end;

function TW3CDTF.isToDay:Boolean;
begin
  Result := ToShortRFC822String = todayStr;
end;
function TW3CDTF.isYestoday:Boolean;
begin
  Result := ToShortRFC822String = YestoDayStr;
end;

function TW3CDTF.ArrToMonth(S:String):Integer;
var i:Integer;
begin
  Result := 1;
  for i := 1 to 12 do    // Iterate
    begin
      if C_Months[i]=S then
      begin
         Result := i;
         Break;
      end;
    end;    // for
end;

procedure TW3CDTF.SetDateTime(sY,sM,sD,sH,sMM,sS,sPM:string);
var
  iY,iM,iD,iH,iMM,iSe:Integer;
begin
  iY := StrToInt(sY);
  iM := StrToInt(sM);
  iD := StrToInt(sD);
  iH := StrToInt(sH);
  if (LowerCase(sPM)='pm') and (iH<=12) then
   iH:=iH+12;
  iMM := StrToInt(sMM);
  if sS='' then
    iSe:=0
  else
    iSe := StrToInt(sS);
  dateValue :=  EncodeDateTime(iY, iM, iD, iH, iMM, iSe, 0);
end;

constructor TW3CDTF.Create(sDate:string);
const
  D1='(\d{4})[-|.|\/](\d{1,2})[-|.|\/](\d{1,2})[ |T](\d{1,2})[:](\d{1,2})([:](\d{1,2}))?([ ](PM|AM))?';
  D2='(\d{1,2})[ ](Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ](\d{4})[ ](\d{1,2})[:](\d{1,2})[:](\d{1,2})';
  D3='(\d{4})[-|.|\/](\d{1,2})[-|.|\/](\d{1,2})';
var Reg:TRegExpr;
  sYear,sMonth,sDay,sHour,sMin,sSec,sPM:string;
begin
  DateString:=Trim(sDate);
  while Pos('  ',DateString)>0 do
    begin
      DateString:=FastReplace(DateString,'  ',' ');
    end;    // while
  Reg:=TRegExpr.Create;
  Reg.ModifierI := True;
  Reg.Expression := D1;
  if Reg.Exec(DateString) then
  begin
    sYear  := Reg.Match[1];
    sMonth := Reg.Match[2];
    sDay   := Reg.Match[3];
    sHour  := Reg.Match[4];
    sMin   := Reg.Match[5];
    sSec   := Reg.Match[7];
    sPM    := Reg.Match[9];
    SetDateTime(sYear,sMonth,sDay,sHour,sMin,sSec,sPM);
  end
  else
  begin
    Reg.Expression := D2;
    if Reg.Exec(DateString) then
    begin
      CreateRFC822(DateString);
    end
    else
    begin
      Reg.Expression := D3;
      if Reg.Exec(DateString) then
      begin
        sYear  := Reg.Match[1];
        sMonth := Reg.Match[2];
        sDay   := Reg.Match[3];
        sHour  := '0';
        sMin   := '0';
        sSec   := '0';
        sPM    :='';
        SetDateTime(sYear,sMonth,sDay,sHour,sMin,sSec,sPM);
      end;
    end;
  end;
end;

constructor TW3CDTF.CreateDateTime(dDate: TDateTime);
begin
	dateValue := dDate;
end;

procedure TW3CDTF.CreateRFC822(sDate: string);
var
	i,j : integer;
  str : string;
  sDay, sMonth, sYear, sTime, sHour, sMinute, sSecond, sGMT : string;
  iDay, iMonth, iYear, iHour, iMinute, iSecond : integer;
  dtGMT : Extended;
  slst,timelst:TStringList;
begin
    str := sDate;
    if SplitString(sDate,', ').Count>1 then
      str := SplitString(str,', ').ValueFromIndex[1];
    slst:=SplitString(str,' ');
    sDay:=slst.Strings[0];
    sMonth:=slst.Strings[1];
    sYear:=slst.Strings[2];
    sTime:=slst.Strings[3];
    if slst.Count=5 then
       sGMT:=slst.Strings[4]
    else
      sGMT := 'GTM';
    timelst:=SplitString(sTime,':');
    sHour := timelst.Strings[0];
    sMinute := timelst.Strings[1];
    if timelst.Count>2 then
      sSecond:=timelst.Strings[2]
    else
      sSecond:='0';
    try
    	iMonth := 1;
    	if length(sMonth) = 3 then begin
            for i := 1 to 12 do
            	if upperCase(C_Months[i]) = upperCase(sMonth) then begin
                	iMonth := i;
                    break;
	            end;
        end;
    except on EConvertError do
    	  iMonth := 1;
    end;
    try iYear := strToInt(sYear); except on EConvertError do iYear := 1900; end;
    try iDay := strToInt(sDay); except on EConvertError do iDay := 1; end;
    try iHour := strToInt(sHour); except on EConvertError do iHour := 1; end;
    try iMinute := strToInt(sMinute); except on EConvertError do iMinute := 1; end;
    try iSecond := strToInt(sSecond); except on EConvertError do iSecond := 1; end;
    try
    	dtGMT := RFC822Value(sGmt);
    except on EConvertError do dtGMT := 0;end;
    dateValue := EncodeDateTime(iyear, imonth, iday, ihour, iminute, isecond, 0)+dtGmt;
end;

procedure TW3CDTF.CreateW3CDTF(sDate: string);
var
	str, tmp: string;
  timePointer : integer;
  month, hour, day, year, minute, sec,
  tzHour, tzMinute, tzSign : integer;
  delta : Extended;
begin
	tmp := '';
    str := sDate;
  	if Length(str) > 3 then
    begin
      month:=1; day:=1; hour:=0; minute:=0; sec:=0; tzSign:=1; delta:=0; tzSign:=0; tzHour := 0; tzMinute := 0;
      year := StrToInt(Copy(str, 1,4));
      month := (StrToInt(Copy(str,6,2)) ); //-1); //if(isNaN(month)) month = 0;
      tmp := Copy(str,9,2);
      if Copy(tmp,1,1)='0' then
        tmp := Copy(tmp,2,1);
      day := StrToInt(tmp);
      timePointer := FastCharPos(str, 'T', 1);
      if timePointer > 0 then
      begin
          hour := StrToInt(Copy(str,timePointer+1,2)); //if(isNaN(hour)) hour = 0;
          minute := StrToInt(Copy(str,timePointer+4,2)); //if(isNaN(minute)) minute = 0;
          sec := StrToInt(Copy(str,timePointer+7,2)) //if(isNaN(sec)) sec = 0;
      end;
      if length(str) > 6 then
      begin
        tmp := Copy(str, Length(str)-4, 1);
        if tmp = '-' then
          tzSign := -1
        else
          tzSign := 1;
        if ( (tmp='+') or (tmp='-') ) and (timePointer >= 0) then
        begin
              tzHour := StrToInt(Copy(str,Length(str)-3,2));
              tzMinute := StrToInt(Copy(str,Length(str)-1,2));
              //if(isNaN(tzHour)) tzHour = 0;
              //if(isNaN(tzMinute)) tzMinute = 0;
              tzMinute := tzMinute + (tzHour * 60);
              delta := (tzSign * tzMinute )/ 1440;
              dateValue := EncodeDateTime(year, month, day, hour, minute, sec, 0) + delta + timeZone;
        end; //else if(str.charAt(str.length-1)=="Z")
        dateValue := EncodeDateTime(year, month, day, hour, minute, sec, 0);
      end;
    end
    else
		dateValue := 0;
end;

function TW3CDTF.IsEmpty: boolean;
begin
	Result := (YearOf(dateValue)<1950);
end;

function TW3CDTF.ToDateTime: TDateTime;
begin
	Result := dateValue;
end;

function TW3CDTF.ToRFC822String: string;
begin
  if IsEmpty then
    Result:=DateString
  else
  begin
    Result := formatdatetime('dd "mo" yyyy hh:nn:ss "GMT"', dateValue);
    Result := fastReplace(Result, 'mo', C_Months[MonthOf(dateValue)],false);
    Result := C_days[DayOfWeek(dateValue)]+', '+Result;
  end;
end;

function TW3CDTF.ToShortRFC822String: string;
begin
  if IsEmpty then
    Result:=DateString
  else
  begin
    Result := formatdatetime('dd "mo" yyyy', dateValue);
    Result := fastReplace(Result, 'mo', C_Months[MonthOf(dateValue)],false);
    Result := C_days[DayOfWeek(dateValue)]+', '+Result;
  end;
end;

function TW3CDTF.ToString: string;
begin
  if IsEmpty then
    Result:=DateString
  else
  begin
	if YearOf(dateValue) < 1950 then
    	Result := ''
    else
	    Result := formatdatetime('yyyy.mm.dd hh:nn:ss', dateValue);
  end;
end;

function TW3CDTF.ToW3CDTFString: string;
begin
  if IsEmpty then
    Result:=DateString
  else
    Result := formatdatetime('yyyy-mm-dd"T"hh:nn:ss-0200', dateValue);
end;


function CurrentLocalBias: TDateTime;
const 
  MinsInDay = 1440; 
var 
  TZInfo: TTimeZoneInformation;
begin 
  //Get the between UTC and time for this locale and convert 
  //to TDateTime by dividing by MinsInDay 
  //NB: If local time is ahead of UTC, bias is negative 
  case GetTimeZoneInformation(TZInfo) of 
    TIME_ZONE_ID_DAYLIGHT:
      Result := (TZInfo.Bias + TZInfo.DaylightBias) / MinsInDay;
    TIME_ZONE_ID_STANDARD:
      Result := (TZInfo.Bias + TZInfo.StandardBias) / MinsInDay; 
    TIME_ZONE_ID_UNKNOWN: 
      Result := TZInfo.Bias / MinsInDay; 
  else 
   Result := TZInfo.Bias / MinsInDay; 
  end; 
end;

initialization
	try
		timeZone := CurrentLocalBias();
  except
  	timeZone := 0;
  end;

end.