/beta/include_farsiDateHandling.asp

  1<%
  2Function persian_jdn(iYear, _
  3                     iMonth, _
  4                     iDay) 'As Long
  5    Const PERSIAN_EPOCH = 1948321 ' The JDN of 1 Farvardin 1
  6    Dim epbase 
  7    Dim epyear 
  8    Dim mdays 
  9    If iYear >= 0 Then
 10        epbase = iYear - 474
 11    Else
 12        epbase = iYear - 473
 13    End If
 14    epyear = 474 + (epbase Mod 2820)
 15    If iMonth <= 7 Then
 16        mdays = (CLng(iMonth) - 1) * 31
 17    Else
 18        mdays = (CLng(iMonth) - 1) * 30 + 6
 19    End If
 20    persian_jdn = CLng(iDay) _
 21            + mdays _
 22            + Fix(((epyear * 682) - 110) / 2816) _
 23            + (epyear - 1) * 365 _
 24            + Fix(epbase / 2820) * 1029983 _
 25            + (PERSIAN_EPOCH - 1)
 26End Function
 27
 28Sub jdn_persian(jdn, _
 29                ByRef iYear, _
 30                ByRef iMonth, _
 31                ByRef iDay)
 32    Dim depoch
 33    Dim cycle
 34    Dim cyear
 35    Dim ycycle
 36    Dim aux1, aux2
 37    Dim yday
 38    depoch = jdn - persian_jdn(475, 1, 1)
 39    cycle = Fix(depoch / 1029983)
 40    cyear = depoch Mod 1029983
 41    If cyear = 1029982 Then
 42        ycycle = 2820
 43    Else
 44        aux1 = Fix(cyear / 366)
 45        aux2 = cyear Mod 366
 46        ycycle = Int(((2134 * aux1) + (2816 * aux2) + 2815) / 1028522) + aux1 + 1
 47    End If
 48    iYear = ycycle + (2820 * cycle) + 474
 49    If iYear <= 0 Then
 50        iYear = iYear - 1
 51    End If
 52    yday = (jdn - persian_jdn(iYear, 1, 1)) + 1
 53    If yday <= 186 Then
 54        iMonth = Ceil(yday / 31)
 55    Else
 56        iMonth = Ceil((yday - 6) / 30)
 57    End If
 58    iDay = (jdn - persian_jdn(iYear, iMonth, 1)) + 1
 59End Sub
 60
 61' We needed an alternative to Int and Fix.
 62' Int(8.4) = 8, Int(-8.4) = -9
 63' Fix(8.4) = 8, Fix(-8.4) = -8
 64' Ceil(8.4) = 9, Ceil(-8.4) = -9
 65Function Ceil(number)
 66    Ceil = -Sgn(number) * Int(-Abs(number))
 67' or
 68    'Ceil = CInt(number + (Sgn(number) * 0.5))
 69End Function
 70
 71Const Gregorian = 1
 72Const Julian = 2
 73Function civil_jdn(ByVal iYear, _
 74                   ByVal iMonth, _
 75                   ByVal iDay ) 'As Long
 76	calendarType = Gregorian
 77    Dim lYear
 78    Dim lMonth
 79    Dim lDay
 80
 81    If calendarType = Gregorian And ((iYear > 1582) Or _
 82        ((iYear = 1582) And (iMonth > 10)) Or _
 83        ((iYear = 1582) And (iMonth = 10) And (iDay > 14))) _
 84    Then
 85        lYear = CLng(iYear)
 86        lMonth = CLng(iMonth)
 87        lDay = CLng(iDay)
 88        civil_jdn = ((1461 * (lYear + 4800 + ((lMonth - 14) \ 12))) \ 4) _
 89            + ((367 * (lMonth - 2 - 12 * (((lMonth - 14) \ 12)))) \ 12) _
 90            - ((3 * (((lYear + 4900 + ((lMonth - 14) \ 12)) \ 100))) \ 4) _
 91            + lDay - 32075
 92    Else
 93        civil_jdn = 0 ' julian_jdn(iYear, iMonth, iDay)
 94    End If
 95
 96End Function
 97
 98Sub jdn_civil(ByVal jdn, _
 99              ByRef iyear, _
100              ByRef imonth, _
101              ByRef iday)
102
103    Dim l
104    Dim k
105    Dim n
106    Dim i
107    Dim j
108
109    If (jdn > 2299160) Then
110        l = jdn + 68569
111        n = ((4 * l) \ 146097)
112        l = l - ((146097 * n + 3) \ 4)
113        i = ((4000 * (l + 1)) \ 1461001)
114        l = l - ((1461 * i) \ 4) + 31
115        j = ((80 * l) \ 2447)
116        iday = l - ((2447 * j) \ 80)
117        l = (j \ 11)
118        imonth = j + 2 - 12 * l
119        iyear = 100 * (n - 49) + i + l
120    Else
121        Call jdn_julian(jdn, iyear, imonth, iday)
122    End If
123
124End Sub
125
126
127
128
129
130Function shamsiToday()
131    Dim depoch
132    Dim cycle
133    Dim cyear
134    Dim ycycle
135    Dim aux1, aux2
136    Dim yday
137	Dim jdn
138	tmpDate=date()
139
140	jdn=civil_jdn(clng(year(tmpDate)),clng(Month(tmpDate)),clng(Day(tmpDate)))
141
142    depoch = jdn - 2121446  ' 2121446 = persian_jdn(475, 1, 1)
143    cycle = Fix(depoch / 1029983)
144    cyear = depoch Mod 1029983
145    If cyear = 1029982 Then
146        ycycle = 2820
147    Else
148        aux1 = Fix(cyear / 366)
149        aux2 = cyear Mod 366
150        ycycle = Int(((2134 * aux1) + (2816 * aux2) + 2815) / 1028522) + aux1 + 1
151    End If
152    iYear = ycycle + (2820 * cycle) + 474
153    If iYear <= 0 Then
154        iYear = iYear - 1
155    End If
156    yday = (jdn - persian_jdn(iYear, 1, 1)) + 1
157    If yday <= 186 Then
158        iMonth = Ceil(yday / 31)
159    Else
160        iMonth = Ceil((yday - 6) / 30)
161    End If
162    iDay = (jdn - persian_jdn(iYear, iMonth, 1)) + 1
163	
164	if iDay < 10 then iDay = "0" & iDay
165	if iMonth < 10 then iMonth = "0" & iMonth
166
167shamsiToday=iYear & "/" & iMonth & "/" & iDay
168End Function
169
170Function shamsiDate(inputDate)
171    Dim depoch
172    Dim cycle
173    Dim cyear
174    Dim ycycle
175    Dim aux1, aux2
176    Dim yday
177	Dim jdn
178
179	jdn=civil_jdn(clng(year(inputDate)),clng(Month(inputDate)),clng(Day(inputDate)))
180
181    depoch = jdn - 2121446  ' 2121446 = persian_jdn(475, 1, 1)
182    cycle = Fix(depoch / 1029983)
183    cyear = depoch Mod 1029983
184    If cyear = 1029982 Then
185        ycycle = 2820
186    Else
187        aux1 = Fix(cyear / 366)
188        aux2 = cyear Mod 366
189        ycycle = Int(((2134 * aux1) + (2816 * aux2) + 2815) / 1028522) + aux1 + 1
190    End If
191    iYear = ycycle + (2820 * cycle) + 474
192    If iYear <= 0 Then
193        iYear = iYear - 1
194    End If
195    yday = (jdn - persian_jdn(iYear, 1, 1)) + 1
196    If yday <= 186 Then
197        iMonth = Ceil(yday / 31)
198    Else
199        iMonth = Ceil((yday - 6) / 30)
200    End If
201    iDay = (jdn - persian_jdn(iYear, iMonth, 1)) + 1
202	
203	if iDay < 10 then iDay = "0" & iDay
204	if iMonth < 10 then iMonth = "0" & iMonth
205
206shamsiDate=iYear & "/" & iMonth & "/" & iDay
207End Function
208
209Function CheckDateFormat(ByVal inputDate)
210
211	CheckDateFormat=False
212
213	Set RExp = New RegExp
214		RExp.Pattern = "^13\d\d/(0[1-6]/(0[1-9]|[12][0-9]|3[01])|(0[789]|1[012])/(0[1-9]|[12][0-9]|30))$"
215		RExp.IgnoreCase = False
216		RExp.Global = False
217
218	If RExp.Test(inputDate) Then
219		CheckDateFormat=True
220	end if
221
222	Set RExp = nothing
223
224End Function
225
226Function currentTime10()
227	curTime= now
228	curHour		= Hour(curTime)
229	curMinute	= Minute(curTime)
230	curSecond	= Second(curTime)
231	if (len(curHour) = 1) then curHour = "0" & curHour
232	if (len(curMinute) = 1) then curMinute = "0" & curMinute 
233	if (len(curSecond) = 1) then curSecond = "0" & curSecond 
234	currentTime10= curHour & ":" & curMinute & ":" & curSecond
235End Function 
236function weekdaynameFA(name)
237	select case name
238		case "Saturday":
239			weekdaynameFA="����"
240		case "Sunday":
241			weekdaynameFA="�ߝ����"
242		case "Monday":
243			weekdaynameFA="������"
244		case "Tuesday":
245			weekdaynameFA="�������"
246		case "Wednesday":
247			weekdaynameFA="��������"
248		case "Thursday":
249			weekdaynameFA="��̝����"
250		case "Friday":
251			weekdaynameFA="����"
252		case else
253			 weekdaynameFA=name
254	end select
255end function
256function splitDate(myDate)
257	dim out(3)
258	out(0)=mid(myDate,1,4)
259	out(1)=mid(myDate,6,2)
260	out(2)=mid(myDate,9,2)
261	splitDate=out
262end function
263%>