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

[Rambod]

سلام
من توی ASP نیاز به یک کد تبدیل تاریخ میلادی به شمسی داشتم که وقتی توی فروم جستجو کردم این کد رو بدست آوردم:


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

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

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(TrueDate) - 1) & " " & FDay& " " & Mon(FMon - 1) & " " &FYear

این کد کد خیلی خوبیه و من مشکلی باهاش نداشتم. امروز میخواستم یک تست بکنم و ببینیم که آیا سالهای کبیسه را درست حساب میکند یا نه. میدونین که امسال سال کبیسه هست. برای همین تاریخ کامپیوترمو به 20 مارس 2005 یعنی 30 اسفند 1383 تغییر دادم و کد رو اجرا کردم که کد به خطا برخورد کرد.
من نمیدونم این کد رو کی نوشته... ولی خواهشاً هر کی نوشته این کد رو اصلاح کنه چون من شدیداً به یک کد درست و حسابی و بدون اشکال تبدیل میلادی به شمسی احتیاج دارم.
اگر کد دیگری هم در اختیار دارین، خیلی ممنون میشم اینجا پستش کنید...

[vbprogramer]

سلام

فکر کنم شما کد رو برای ASP می خواستین درسته؟
:متفکر:
پس چرا تو بخش VB سؤال کردین ؟

[Rambod]

ASP , VB تقریباً یکین! در ضمن توی بخش VB بهتر جواب میگیریم! اگر توی جفتشون هم پست بکنیم، یدونشو پاک میکنند.

[vbprogramer]

والا من که ASP بلد نیستم (البته خیلی دلم میخواهد یاد بگیرم :( )
ولی شرمنده :sorry:

[Rambod]

بابا کد بالا رو توی VB هم اجرا کنی کار میکنه! :kaf: