تاریخ هجری قمری

[internet2]

تاریخ هجری قمری با Asp رو کسی داره؟
و یا چگونه باید نوشت

مثلا
امروز دوشنبه 14 محرم 1417

با تشکر

[internet2]

به نظر شما در کجای برنامه باید تغییر ایجاد کرد که به ماه قمری تبدیل شود


<%
FMonArray= array (0,31,31,31,31,31,31,30,30,30,30,30,30)
EMonArray= Array(0,31, 28,31,30,31,30,31,31,30,31,30,31)

W = Array ("یک‌شنبه", "دوشنبه", "سه‌شنبه", "چهار‌شنبه", "پنج‌شنبه", "جمعه", "شنبه")
Mon = Array ("فروردین", "اردیبهشت", "خرداد", "تیر", "مرداد", "شهریور", "مهر", "آبان", "آذر", "دی", "بهمن", "اسفند")
EYear= Year(Date)
EMon= Month(Date)
EDay = Day(Date)

ELeap=0

if ((EYear mod 4))= 0 Then
ELeap =1
End if

Cnt=EMon-1
Temp=0
While Cnt<>0
if ((Cnt=2)and(ELeap=1)) Then
Temp= Temp+29
else
Temp= Temp + EMonArray(Cnt)
end if
Cnt=Cnt-1
Wend

EDayOfYear= Temp+EDay
' Convert to Farsi

Temp= EDayOfYear-79
if Temp>0 Then
FYear= EYear-621
else
FYear= EYear-622

if ((FYear mod 4)=3) then
Temp= Temp+366
else
Temp= Temp+365
End if
End if

if (FYear mod 4)=3 Then
FLeap=1
else
Fleap=0
End if

Cnt= 1

While( (Temp<>0) and (Temp>FMonArray(Cnt)) )
if Cnt=12 Then
if (FLeap=1) Then
Temp=Temp-30
else Temp= Temp-29
end if
else Temp= Temp-FMonArray(Cnt)
end if

Cnt= Cnt+1
Wend

if Temp<>0 Then
FMon = Cnt
FDay= Temp
else
FMon= 12
FDay=30
End if

DateShamsi = W(WeekDay(Date) - 1) & " " & FDay& " " & Mon(FMon - 1) & " " &FYear
%>
<%
response.write(DateShamsi)
%>

[internet2]

1.FMonArray
.EMonArray .2
3 .
W = Array ("یک‌شنبه", "دوشنبه", "سه‌شنبه", "چهار‌شنبه", "پنج‌شنبه", "جمعه", "شنبه")
Mon = Array ("فروردین", "اردیبهشت", "خرداد", "تیر", "مرداد", "شهریور", "مهر", "آبان", "آذر", "دی", "بهمن", "اسفند

[mosyhey]

با جستجوی عبارت میلادی به قمری در گوگل نتایج خوبی به دست می آید. همچنین در یکی از آن صفحه ها گفته که با net. به راحتی این کار بدون برنامه نویسی امکان پذیر است.

[internet2]

دوست عزیز من که کدی که تاریخ قمری باشد با Asp نتونستم پیدا کنم

شما لینک خاصی دارید
با تشکر

[mosyhey]

با سلام. لطفاً این را امتحان کنید. کلش را در یک فایل asp بریزید و آن را اجرا کنید. خط آخر را بایستی تاریخ میلادی قرار داد. متغیر TIMEZ هم فکر کنم تفاوت با گرینویچ محلی که می خواهیم است چون تاریخ قمری ممکن است این کشور تا کشور همسایه یک روز فرق کند. اگر درست کار کرد آن را بازنویسی کنید چون همه متغیر هایش چند بار تعریف و از آن ها استفاده شده و ممکن است دردسر ساز شود. همچنین نام ماه های قمری و ... را هم به آن اضافه کنید.
نکته مهم دیگر اینکه برای تشخیص تاریخ قمری در روز های مهم مثل اول رمضان یا عید فطر و ... نمی توان از آن استفاده کرد چون آن روز ها باید با دیدن ماه در آن مکان تعیین شود و شاید ماه باشد ولی ابر باشد.

<%
Function julian_jdn(iYear,iMonth,iDay)
Dim lYear
Dim lMonth
Dim lDay

lYear = CLng(iYear)
lMonth = CLng(iMonth)
lDay = CLng(iDay)
julian_jdn = 367 * lYear - ((7 * (lYear + 5001 + ((lMonth - 9) \ 7))) \ 4) + ((275 * lMonth) \ 9) + lDay + 1729777
End Function


Function civil_jdn(iYear,iMonth,iDay)
Dim lYear
Dim lMonth
Dim lDay
CalendarType="Gregorian"
If CalendarType="Gregorian" And ((iYear > 1582) Or ((iYear = 1582) And (iMonth > 10)) Or ((iYear = 1582) And (iMonth = 10) And (iDay > 14))) Then
lYear = CLng(iYear)
lMonth = CLng(iMonth)
lDay = CLng(iDay)
civil_jdn = ((1461 * (lYear + 4800 + ((lMonth - 14) \ 12))) \ 4) + ((367 * (lMonth - 2 - 12 * (((lMonth - 14) \ 12)))) \ 12) - ((3 * (((lYear + 4900 + ((lMonth - 14) \ 12)) \ 100))) \ 4) + lDay - 32075
Else
civil_jdn = julian_jdn(iYear, iMonth, iDay)
End If
End Function


Sub jdn_julian(jdn,iYear,iMonth,iDay)
Dim l
Dim k
Dim n
Dim i
Dim j
j = jdn + 1402
k = ((j - 1) \ 1461)
l = j - 1461 * k
n = ((l - 1) \ 365) - (l \ 1461)
i = l - 365 * n + 30
j = ((80 * i) \ 2447)
iDay = i - ((2447 * j) \ 80)
i = (j \ 11)
iMonth = j + 2 - 12 * i
iYear = 4 * k + n + i - 4716
End Sub


Sub jdn_civil(jdn,iYear,iMonth,iDay)
Dim l
Dim k
Dim n
Dim i
Dim j
If (jdn > 2299160) Then
l = jdn + 68569
n = ((4 * l) \ 146097)
l = l - ((146097 * n + 3) \ 4)
i = ((4000 * (l + 1)) \ 1461001)
l = l - ((1461 * i) \ 4) + 31
j = ((80 * l) \ 2447)
iDay = l - ((2447 * j) \ 80)
l = (j \ 11)
iMonth = j + 2 - 12 * l
iYear = 100 * (n - 49) + i + l
Else
jdn_julian jdn,iYear,iMonth,iDay
End If
End Sub


Function tmoonphase(n,nph)
RPD = (1.74532925199433E-02) ' radians per degree (pi/180)
Dim jd
Dim t
Dim t2
Dim t3
Dim k
Dim ma
Dim sa
Dim tf
Dim xtra
k = n + nph / 4
t = k / 1236.85
t2 = t * t
t3 = t2 * t
jd = 2415020.75933 + 29.53058868 * k - 0.0001178 * t2 - 0.000000155 * t3 + 0.00033 * Sin(RPD * (166.56 + 132.87 * t - 0.009173 * t2))
sa = RPD * (359.2242 + 29.10535608 * k - 0.0000333 * t2 - 0.00000347 * t3)
ma = RPD * (306.0253 + 385.81691806 * k + 0.0107306 * t2 + 0.00001236 * t3)
tf = RPD * 2 * (21.2964 + 390.67050646 * k - 0.0016528 * t2 - 0.00000239 * t3)
Select Case nph
Case 0, 2
xtra = (0.1734 - 0.000393 * t) * Sin(sa) + 0.0021 * Sin(sa * 2) - 0.4068 * Sin(ma) + 0.0161 * Sin(2 * ma) - 0.0004 * Sin(3 * ma) + 0.0104 * Sin(tf) - 0.0051 * Sin(sa + ma) - 0.0074 * Sin(sa - ma) + 0.0004 * Sin(tf + sa) - 0.0004 * Sin(tf - sa) - 0.0006 * Sin(tf + ma) + 0.001 * Sin(tf - ma) + 0.0005 * Sin(sa + 2 * ma)
Case 1, 3
xtra = (0.1721 - 0.0004 * t) * Sin(sa) _
+ 0.0021 * Sin(sa * 2) - 0.628 * Sin(ma) + 0.0089 * Sin(2 * ma) - 0.0004 * Sin(3 * ma) + 0.0079 * Sin(tf) - 0.0119 * Sin(sa + ma) - 0.0047 * Sin(sa - ma) + 0.0003 * Sin(tf + sa) - 0.0004 * Sin(tf - sa) - 0.0006 * Sin(tf + ma) + 0.0021 * Sin(tf - ma) + 0.0003 * Sin(sa + 2 * ma) + 0.0004 * Sin(sa - 2 * ma) - 0.0003 * Sin(2 * sa + ma)
If (nph = 1) Then
xtra = xtra + 0.0028 - 0.0004 * Cos(sa) + 0.0003 * Cos(ma)
Else
xtra = xtra - 0.0028 + 0.0004 * Cos(sa) - 0.0003 * Cos(ma)
End If
Case Else
tmoonphase = 0
Exit Function
End Select
tmoonphase = jd + xtra - (0.41 + 1.2053 * t + 0.4992 * t2) / 1440
End Function


Function visibility(n)
TIMZ = 3.5
MINAGE = 13.5
SUNSET = 19.5
TIMDIF=(SUNSET-MINAGE)
Dim jd
Dim tf
Dim d
jd = tmoonphase(n, 0)
d = Int(jd)
tf = (jd - d)
If (tf <= 0.5) Then
visibility = (jd + 1)
Else
tf = (tf - 0.5) * 24 + TIMZ
If (tf > TIMDIF) Then
visibility = (jd + 1)
Else
visibility = (jd)
End If
End If
End Function


Sub jdn_islamic(jd,iYear,iMonth,iDay)
Dim mjd
Dim k
Dim hm
jdn_civil jd,iYear,iMonth,iDay
k = Int(0.6 + (iYear + (CInt(iMonth - 0.5)) / 12 + iDay / 365 - 1900) * 12.3685)
Do
mjd = visibility(k)
k = k - 1
Loop While (mjd > (jd - 0.5))
k = k + 1
hm = k - 1048
iYear = 1405 + Fix(hm / 12)
'iYear = 1405 + Int(hm / 12)
iMonth = (hm Mod 12) + 1
If (hm <> 0 And iMonth <= 0) Then
iMonth = iMonth + 12
iYear = iYear - 1
End If
If iYear <= 0 Then iYear = iYear - 1
iDay = Int(jd - mjd + 0.5)
Response.Write(iYear & "/" & iMonth & "/" & iDay)
End Sub


Sub civil_islamic(iYear,iMonth,iDay)
jdn_islamic civil_jdn(iYear,iMonth,iDay),iYear, iMonth, iDay
End Sub


civil_islamic 2007,07,16
%>

[internet2]

دوست عزیز خیلی عالی بود فقط میشه بگی من ماه ها رو چه جوری کجا بزنم
مثلا
محرم
صفر . . .

[mosyhey]

با سلام. برای این کار می توانید جای 6 خط آخر را با این 7 خط عوض کنید. البته شما اجزای آرایه را فارسی کنید.

Response.Write(iYear & "/" & ghmonth_arr(iMonth-1) & "/" & iDay)
End Sub


Sub civil_islamic(iYear,iMonth,iDay)
jdn_islamic civil_jdn(iYear,iMonth,iDay),iYear, iMonth, iDay
End Sub

ghmonth_arr=Array("Moharram","Safar","Rabiolavval","Rabiossani","Jamadiolavval","Jamadiossani","Rajab","Shaban","Ramazan","Shavval","Zelghada","Zelhajja")
civil_islamic 2007,07,16

[hector2000]

با سلام
اقا کسی تبدیل تاریخ شمسی به میلادی را دارد؟