This is just a test posting to see how awful large chunks of code will look on the blog.
The code for the drop-in replacement for REALbasic's ParseDate can be found on my website
Thanks to Norman Palardy, Joe Strout, Dennis Birch and Maximilian Tyrtania for their help and advice with this function on the NUG
Function validDate(text as String, ByRef value As Date, assumePastFuture as integer= 0) As Boolean
// If the year provided has only one or 2 digits, check assumePastFuture
// negative value means the past, positive means future, 0 means current century
// If no year is supplied, assumePastFuture has a granularity of 1 year
Static yearPos as Integer = -9
Static monthPos as Integer = -9
Static dayPos as Integer = -9
if yearPos = -9 then // first time through
yearPos = -1 // only try this once
// try to work out local date format
// assume Gregorian calendar
// assume shortDate contains all 3 numbers
// don't use NthField or Split in case it contains other characters
dim d as new date
// clear any time numbers, in case of unusual shortDate format
d.TotalSeconds = 0
// set unique values for year, month & date
d.SQLDate = "2005-12-31"
dim s as String = d.ShortDate
dim pos() As integer
dim thisPos as Integer
thisPos = InStr( 0, s, "05" )
if thisPos > 0 then pos.Append thisPos
thisPos = InStr( 0, s, "12" )
if thisPos > 0 then pos.Append thisPos
thisPos = InStr( 0, s, "31" )
if thisPos > 0 then pos.Append thisPos
if UBound( pos ) = 2 then
// we've found all three elements
// sort them by position in shortDate
dim typ() As string = Array( "y", "m", "d" )
pos.SortWith typ
yearPos = typ.IndexOf( "y" )
monthPos = typ.IndexOf( "m" )
dayPos = typ.IndexOf( "d" )
end if
end if
if yearPos < 0 or monthPos < 0 or dayPos < 0 then
// we don't know how to parse the date
// some might want to set defaults instead of returning false
Return false
end if
// now check the date has just numbers and two delimiters
Dim sep as String
Dim tmp as String
Dim i as Integer
Dim noYearSupplied as Boolean
tmp = text
// first figure out what separator they gave us .. have to both be the same one
for i = 0 to 9
tmp = replaceAll(tmp,format(i,"0"),"")
next
select case len(tmp)
case 0
// unable to understand the format entered
return false
case 1
sep = tmp
case 2
sep = mid(tmp,1,1)
if sep <> mid(tmp,2,1) then
// invalid - two different separators
return false
end if
else
return false
end select
//make array of elements
Dim dats() as String = Split( text, sep )
if UBound( dats ) <> 2 then
// add in the missing year ?
dim tmpDate as new date
dats.Insert yearPos, format(tmpDate.year,"0000")
noYearSupplied = True
end if
if UBound( dats ) <> 2 then
//invalid date - should never get here.
Return false
end if
dim yr As integer = CDbl( dats( yearPos ) )
if yr < 100 then
// fix short year by assuming current century
// proving that we learned nothing from y2k
dim today as new Date
dim century as integer
century = today.year \ 100
century = century * 100
yr = yr + century
// use any assumptions about whether the date is past or future to set century
if assumePastFuture < 0 then
if yr > today.Year then
yr = yr - 100
end if
elseif assumePastFuture > 0 and yr < today.Year then
yr = yr + 100
end if
dats( yearPos ) = CStr( yr )
elseif noYearSupplied then
// use any assumptions about whether the date is past or future to set year
dim mth as integer = CDbl( dats( monthPos ) )
dim dy as integer = CDbl( dats( dayPos ) )
dim today as new Date
if assumePastFuture < 0 then
if mth > today.Month or ( mth = today.Month and dy > today.Day ) then
yr = yr - 1
end if
elseif assumePastFuture > 0 and ( mth < today.Month or ( mth = today.Month and dy < today.Day ) ) then
yr = yr + 1
end if
dats( yearPos ) = CStr( yr )
end if
// put detail into a date object
dim retVal as new date
dim yy,mm,dd as Integer
yy = val( dats( yearPos ) )
mm = val( dats( monthPos ) )
dd = val( dats( dayPos ) )
retVal.TotalSeconds = 0
retVal.Year = yy
retVal.Month = mm
retVal.Day = dd
// check the date object is not making corrections
if retVal.Year <> yy or retVal.Month <> mm or retVal.Day <> dd then
//probably an invalid day of the month
Return false
end if
//populate value ( ByRef side-effect )
if value = nil Then
value = new Date
end if
value.totalseconds = retVal.TotalSeconds
return true
End Function
I really should put some sort of free use licence on the code but I need to speak to Norman about that first as he contributed a significant part of the code.
