sqltimst.pas

这是不可多得的源代码

procedure TSQLTimeStampData.SetAsString(const Value: string);
begin
  FDateTime := StrToSQLTimeStamp(Value); 
end;

procedure TSQLTimeStampData.SetAsDateTime(const Value: TDateTime);
begin
  FDateTime := DateTimeToSQLTimeStamp(Value);
end;

constructor TSQLTimeStampData.Create(const AValue: Integer);
begin
  inherited Create;
  FDateTime := NullSQLTimeStamp;
  FDateTime.Day := AValue;
end;

constructor TSQLTimeStampData.Create(const AValue: SmallInt);
begin
  inherited Create;
  FDateTime := NullSQLTimeStamp;
  FDateTime.Day := AValue;
end;

constructor TSQLTimeStampData.Create(const AValue: TDateTime);
begin
  inherited Create;
  FDateTime := DateTimeToSqlTimeStamp(AValue);
end;

constructor TSQLTimeStampData.Create(const AText: string);
var
  ts: TSQLTimeStamp;
begin
  ts := StrToSQLTimeStamp(AText);
  inherited Create;
  FDateTime := ts;
end;

constructor TSQLTimeStampData.Create(const ASQLTimeStamp: TSQLTimeStamp);
begin
  CheckSqlTimeStamp( ASQLTimeStamp );
  inherited Create;
  move(ASQLTimeStamp, FDateTime, sizeof(TSQLTimeStamp));
end;

constructor TSQLTimeStampData.Create(const ASource: TSQLTimeStampData);
begin
  Create(aSource.DateTime);
end;

procedure TSQLTimeStampData.SetDay(const Value: Word);
begin
  Assert((Value >= 1) and (Value <= DaysInAMonth(Year, Month)));
  FDateTime.Day := Value;
end;

procedure TSQLTimeStampData.SetFractions(const Value: LongWord);
begin
  FDateTime.Fractions := Value;
end;

procedure TSQLTimeStampData.SetHour(const Value: Word);
begin
  Assert(Value <= 23);   // no need to check for > 0 on Word
  FDateTime.Hour := Value;
end;

procedure TSQLTimeStampData.SetMinute(const Value: Word);
begin
  Assert(Value <= 59);   // no need to check for > 0 on Word
  FDateTime.Minute := Value;
end;

procedure TSQLTimeStampData.SetMonth(const Value: Word);
begin
  Assert((Value >= 1) and (Value <= 12));
  FDateTime.Month := Value;
end;

procedure TSQLTimeStampData.SetSecond(const Value: Word);
begin
  Assert(Value <= 59);  // no need to check for > 0 on Word
  FDateTime.Second := Value;
end;

procedure TSQLTimeStampData.SetYear(const Value: SmallInt);
begin
  FDateTime.Year := Value;
end;

{ TSQLTimeStampVariantType }

procedure TSQLTimeStampVariantType.Clear(var V: TVarData);
begin
  V.VType := varEmpty;
  FreeAndNil(TSQLTimeStampVarData(V).VDateTime);
end;

procedure TSQLTimeStampVariantType.Cast(var Dest: TVarData;
  const Source: TVarData);
var
  LSource, LTemp: TVarData;
begin
  VarDataInit(LSource);
  try
    VarDataCopyNoInd(LSource, Source);
    if VarDataIsStr(LSource) then
      TSQLTimeStampVarData(Dest).VDateTime := TSQLTimeStampData.Create(VarDataToStr(LSource))
    else
    begin
      VarDataInit(LTemp);
      try
        VarDataCastTo(LTemp, LSource, varDate);
        TSQLTimeStampVarData(Dest).VDateTime := TSQLTimeStampData.Create(LTemp.VDate);
      finally
        VarDataClear(LTemp);
      end;
    end;
    Dest.VType := VarType;
  finally
    VarDataClear(LSource);
  end;
end;

procedure TSQLTimeStampVariantType.CastTo(var Dest: TVarData;
  const Source: TVarData; const AVarType: TVarType);
var
  LTemp: TVarData;
begin
  if Source.VType = VarType then
    case AVarType of
      varOleStr:
        VarDataFromOleStr(Dest, TSQLTimeStampVarData(Source).VDateTime.AsString);
      varString:
        VarDataFromStr(Dest, TSQLTimeStampVarData(Source).VDateTime.AsString);
    else
      VarDataInit(LTemp);
      try
        LTemp.VType := varDate;
        LTemp.VDate := TSQLTimeStampVarData(Source).VDateTime.AsDateTime;
        VarDataCastTo(Dest, LTemp, AVarType);
      finally
        VarDataClear(LTemp);
      end;
    end
  else
    inherited;
end;

procedure TSQLTimeStampVariantType.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean);
begin
  if Indirect and VarDataIsByRef(Source) then
    VarDataCopyNoInd(Dest, Source)
  else
    with TSQLTimeStampVarData(Dest) do
    begin
      VType := VarType;
      VDateTime := TSQLTimeStampData.Create(TSQLTimeStampVarData(Source).VDateTime);
    end;
end;

function TSQLTimeStampVariantType.GetInstance(const V: TVarData): TObject;
begin
  Result := TSQLTimeStampVarData(V).VDateTime;
end;

procedure TSQLTimeStampVariantType.BinaryOp(var Left: TVarData; const Right: TVarData; const Operator: TVarOp);
begin
  case Operator of
    opAdd:
      TSQLTimeStampVarData(Left).VDateTime.DoAdd(TSQLTimeStampVarData(Right).VDateTime);
    opSubtract:
      TSQLTimeStampVarData(Left).VDateTime.DoSubtract(TSQLTimeStampVarData(Right).VDateTime);
  else
    RaiseInvalidOp;
  end;
end;

procedure TSQLTimeStampVariantType.Compare(const Left, Right: TVarData; var Relationship: TVarCompareResult);
begin
  Relationship := TSQLTimeStampVarData(Left).VDateTime.Compare(TSQLTimeStampVarData(Right).VDateTime);
end;

{ SQLTimeStamp variant create utils }

function VarSQLTimeStampCreate(const AValue: string): Variant; overload;
begin
  VarClear(Result);
  TSQLTimeStampVarData(Result).VType := SQLTimeStampVariantType.VarType;
  TSQLTimeStampVarData(Result).VDateTime := TSQLTimeStampData.Create(AValue);
end;

function VarSQLTimeStampCreate(const AValue: TDateTime): Variant; overload;
begin
  VarClear(Result);
  TSQLTimeStampVarData(Result).VType := SQLTimeStampVariantType.VarType;
  TSQLTimeStampVarData(Result).VDateTime := TSQLTimeStampData.Create(AValue);
end;

procedure VarSQLTimeStampCreate(var aDest: Variant; const ASQLTimeStamp: TSQLTimeStamp);
begin
  VarClear(aDest);
  TSQLTimeStampVarData(aDest).VType := SQLTimeStampVariantType.VarType;
  TSQLTimeStampVarData(aDest).VDateTime := TSQLTimeStampData.Create(ASQLTimeStamp);
end;

function VarSQLTimeStampCreate: Variant;
begin
  VarSQLTimeStampCreate(Result, NullSQLTimeStamp);
end;

function VarSQLTimeStampCreate(const ASQLTimeStamp: TSQLTimeStamp): Variant;
begin
  VarSQLTimeStampCreate(Result, ASQLTimeStamp);
end;

function VarSQLTimeStamp: TVarType;
begin
  Result := SQLTimeStampVariantType.VarType;
end;

function VarIsSQLTimeStamp(const aValue: Variant): Boolean;
begin
  Result := TVarData(aValue).VType = SQLTimeStampVariantType.VarType;
end;

function VarToSQLTimeStamp(const aValue: Variant): TSQLTimeStamp;
begin
  if TVarData(aValue).VType in [varNULL, varEMPTY] then
    Result := NullSqlTimeStamp
  else if (TVarData(aValue).VType = varString) then
    Result := TSQLTimeStampData.Create(String(aValue)).FDateTime
  else if (TVarData(aValue).VType = varOleStr) then
    Result := TSQLTimeStampData.Create(String(aValue)).FDateTime
  else if (TVarData(aValue).VType = varDouble) or (TVarData(aValue).VType = varDate) then
    Result := DateTimeToSqlTimeStamp(TDateTime(aValue))
  else if (TVarData(aValue).VType = SQLTimeStampVariantType.VarType) then
    Result := TSQLTimeStampVarData(aValue).VDateTime.DateTime
  else
    Raise EVariantError.Create(SInvalidVarCast)
end;

{ SQLTimeStamp to string conversion }

function SQLTimeStampToStr(const Format: string;
  DateTime: TSQLTimeStamp): string;
var
  FTimeStamp: TDateTime;
begin
  FTimeStamp := SqlTimeStampToDateTime(DateTime);
  DateTimeToString(Result, Format, FTimeStamp);
end;

function IsSqlTimeStampValid(const ts: TSQLTimeStamp): Boolean;
begin
  if (ts.Month > 12) or (ts.Day > DaysInAMonth(ts.Year, ts.Month)) or
       (ts.Hour > 23) or (ts.Minute > 59) or (ts.Second > 59) then
    Result := False
  else
    Result := True;
end;

function TryStrToSQLTimeStamp(const S: string; var TimeStamp: TSQLTimeStamp): Boolean;
var
  DT: TDateTime;
begin
  Result := TryStrToDateTime(S, DT);
  if Result then
  begin
    TimeStamp := DateTimeToSQLTimeStamp(DT);
    Result := IsSqlTimeStampValid(TimeStamp);
  end;
  if not Result then
    TimeStamp := NullSQLTimeStamp;
end;

function StrToSQLTimeStamp(const S: string): TSQLTimeStamp;
begin
  if not TryStrToSqlTimeStamp(S, Result) then
    raise EConvertError.Create(SCouldNotParseTimeStamp);
end;

function DateTimeToSQLTimeStamp(const DateTime: TDateTime): TSQLTimeStamp;
var
  FFractions, FYear: Word;
begin
  with Result do
  begin
    DecodeDate(DateTime, FYear, Month, Day);
    Year := FYear;
    DecodeTime(DateTime, Hour, Minute, Second, FFractions);
    Fractions := FFractions;
  end;
end;

function SQLTimeStampToDateTime(const DateTime: TSQLTimeStamp): TDateTime;
begin
  if IsSQLTimeStampBlank(DateTime) then
    Result := 0
  else with DateTime do
  begin
    Result := EncodeDate(Year, Month, Day);
    if Result >= 0 then
      Result := Result + EncodeTime(Hour, Minute, Second, Fractions)
    else
      Result := Result - EncodeTime(Hour, Minute, Second, Fractions);
  end;
end;

function SQLDayOfWeek(const DateTime: TSQLTimeStamp): integer;
var
  dt: TDateTime;
begin
  dt := SQLTimeStampToDateTime(DateTime);
  Result := DayOfWeek(dt);
end;

procedure CheckSqlTimeStamp(const ASQLTimeStamp: TSQLTimeStamp);
begin  // only check if not an empty timestamp
  if ASQLTimeStamp.Year + ASQLTimeStamp.Month + ASQLTimeStamp.day +
     ASQLTimeStamp.Hour + ASQLTimeStamp.Minute + ASQLTimeStamp.Second > 0 then
  begin
    if ASQLTimeStamp.Year + ASQLTimeStamp.Month + ASQLTimeStamp.Day > 0 then
      if (ASQLTimeStamp.Year = 0) or (ASQLTimeStamp.Month = 0) or
       (ASQLTimeStamp.Day =0) or (ASQLTimeStamp.Month > 31) or (ASQLTimeStamp.Day >
       DaysInAMonth(ASQLTimeStamp.Year,ASQLTimeStamp.Month)) then
         raise EConvertError.Create(SInvalidSQLTimeStamp);
    if ASQLTimeStamp.Hour + ASQLTimeStamp.Minute + ASQLTimeStamp.Second > 0 then
       if (ASQLTimeStamp.Hour > 23) or (ASQLTimeStamp.Second > 59) or
       (ASQLTimeStamp.Minute > 59) then
         raise EConvertError.Create(SInvalidSQLTimeStamp);
  end;
end;

initialization
  SQLTimeStampVariantType := TSQLTimeStampVariantType.Create;
finalization
  FreeAndNil(SQLTimeStampVariantType);
end.