Dateconversions-routines

[Intel_C_Intel]

Hi,

Ive called a VB-DLL by using the COM-wizard. The function Ive used i VB is DateAdd which adds seconds to a date and returns the new date. This is working fins BUT the program starts to leak memory so I have to find a workaround. Ive searched everywhere but havent found any datefunctions that I can use. The only ones that exist i DATE_AND_TIME, DATE and a few more.
My goal is to replace this VB-DLL with only VF-code.
Does anyone now if there are functions in VF that can be used???
Ive found a function thats called NEXTIME which uses the date and time from DATE_AND_TIME but its not supported under Windows.

Assistance anyone?

/Martin

[pcurtis]

MODULE datesub
SAVE

TYPE timestamp
INTEGER(4) :: jdate
REAL :: secs
END TYPE timestamp

REAL,PARAMETER :: spd = 86400., &
sph = 3600., &
spm = 60.

TYPE(timestamp),PARAMETER :: ts_null = timestamp(0, 0.)
TYPE(timestamp) :: ts_now
CHARACTER(LEN=3),DIMENSION(12) :: short_month = &
(/'Jan','Feb','Mar','Apr','May','Jun', &
'Jul','Aug','Sep','Oct','Nov','Dec'/)

CONTAINS

FUNCTION real_time () RESULT (ts)
TYPE(timestamp) :: ts
INTEGER,DIMENSION(8) :: tval
INTEGER :: yyyy,mm,dd
CALL date_and_time (values=tval) ! intrinsic clock function
ts%jdate = julian_date(tval(1),tval(2),tval(3))
ts%secs = sph*tval(5) & ! hours
+ spm*tval(6) & ! minutes
+ tval(7) & ! seconds
+.001*tval(8) ! milliseconds
END FUNCTION real_time

FUNCTION make_timestamp (yyyy,mon,dd,hh,mm,ss) RESULT (ts)
TYPE(timestamp) :: ts
INTEGER,INTENT(IN) :: yyyy,mon,dd,hh,mm,ss
ts%jdate = julian_date(yyyy,mon,dd)
ts%secs = sph*hh + spm*mm + ss
END FUNCTION make_timestamp

SUBROUTINE dup_timestamp (ts1,ts2)
TYPE(timestamp) :: ts1,ts2
ts2%jdate = ts1%jdate
ts2%secs = ts1%secs
END SUBROUTINE dup_timestamp

FUNCTION tdif_secs (ts1,ts2) RESULT (dif)
TYPE(timestamp),INTENT(IN) :: ts1,ts2
REAL :: dif
dif = spd*FLOAT(ts2%jdate - ts1%jdate) + ts2%secs - ts1%secs
END FUNCTION tdif_secs

SUBROUTINE add_secs (ts,seconds)
TYPE(timestamp),INTENT(INOUT) :: ts
REAL,INTENT(IN) :: seconds
ts%secs = ts%secs + seconds
DO WHILE (ts%secs >= spd)
ts%jdate = ts%jdate + 1
ts%secs = ts%secs - spd
END DO
END SUBROUTINE add_secs

FUNCTION julian_date (yyyy,mm,dd) RESULT (julian)
! converts calendar date to Julian date
! cf Fliegel & Van Flandern, CACM 11(10):657, 1968
! example: julian_date(1970,1,1)=2440588
INTEGER,INTENT(IN) :: yyyy,mm,dd
INTEGER :: julian
julian = dd - 32075 + 1461*(yyyy + 4800 + (mm - 14)/12)/4 + &
367*(mm - 2 - ((mm - 14)/12)*12)/12 - &
3*((yyyy + 4900 + (mm - 14)/12)/100)/4
END FUNCTION julian_date

SUBROUTINE get_ymd (jd,yyyy,mm,dd)
! expands a Julian date into a calendar date
! cf Fliegel & Van Flandern, CACM 11(10):657, 1968
INTEGER,INTENT(IN) :: jd
INTEGER,INTENT(OUT) :: yyyy,mm,dd
INTEGER :: l,n
l = jd + 68569
n = 4*l/146097
l = l - (146097*n + 3)/4
yyyy = 4000*(l + 1)/1461001
l = l - 1461*yyyy/4 + 31
mm = 80*l/2447
dd = l - 2447*mm/80
l = mm/11
mm = mm + 2 - 12*l
yyyy = 100*(n - 49) + yyyy + l
END SUBROUTINE get_ymd

INTEGER FUNCTION dow (yyyy,mm,dd)
! Day_Of_Week: (0=Sunday,1=Monday...6=Saturday)
! cf J.D.Robertson, CACM 15(10):918
INTEGER,INTENT(IN) :: yyyy,mm,dd
dow = MOD((13*(mm+10-(mm+10)/13*12)-1)/5+dd+77 &
+5*(yyyy+(mm-14)/12-(yyyy+(mm-14)/12)/100*100)/4 &
+(yyyy+(mm-14)/12)/400-(yyyy+(mm-14)/12)/100*2,7)
END FUNCTION dow

INTEGER FUNCTION ndiy (yyyy,mm,dd)
! day count in year
! cf J.D.Robertson, CACM 15(10):918
INTEGER,INTENT(IN) :: yyyy,mm,dd
ndiy = 3055*(mm+2)/100-(mm+10)/13*2-91 &
+(1-(MOD(yyyy,4)+3)/4+(MOD(yyyy,100)+99)/100 &
-(MOD(yyyy,400)+399)/400)*(mm+10)/13+dd
END FUNCTION ndiy

FUNCTION max_day (month,year) RESULT (maxd)
INTEGER,INTENT(IN) :: month,year
INTEGER

[pcurtis]

Yikes, this forum textentry completely mangles code;
send me your email & I'll send the code module directly.
pcurtis@kiltel.com