' (C) 2002-2003, xordad.com
Function PersianDate(strDate, Short)
orgDate = CDate(strDate)
lngDay = DateDiff("d", "3/21/621", orgDate)
intDay = lngDay Mod 7
If lngDay < 1 Then ' Error in strDate
PersianDate = strDate
Exit Function
End If
intCheckFor4 = 0
intCheckFor32 = 0
If lngDay < 8400 Then
intYear = 0
Else
lngDay = lngDay - (8400)
intYear = 23
End If
Do
intCheckFor4 = intCheckFor4 + 1
intCheckFor32 = intCheckFor32 + 1
intYear = intYear + 1
tmpDay = 365
If intCheckFor4 = 4 And intCheckFor32 < 32 Then
tmpDay = 366
intCheckFor4 = 0
End If
If intCheckFor32 = 32 Then
tmpDay = 365
intCheckFor4 = intCheckFor4 - 1
intCheckFor32 = -1
End If
lngDay = lngDay - tmpDay
Loop Until lngDay < tmpDay
If lngDay <= 0 Then
intYear = intYear - 1
lngDay = lngDay + tmpDay
End If
If lngDay <= 186 Then
intMonth = 1 + lngDay \ 31
lngDay = lngDay Mod 31
If lngDay = 0 Then
intMonth = intMonth - 1
lngDay = 31
End If
Else
lngDay = lngDay - 186
intMonth = 7 + lngDay \ 30
lngDay = lngDay Mod 30
If lngDay = 0 Then
intMonth = intMonth - 1
lngDay = 30
End If
End If
If Short Then
PersianDate = String(4 - Len(Trim(" " & (intYear))), "0") & intYear & "-" & String(2 - Len(Trim(" " & (intMonth))), "0") & intMonth & "-" & String(2 - Len(Trim(" " & (lngDay))), "0") & lngDay
Else
Select Case intDay
Case 0
strDay = "چهار شنبه، "
Case 1
strDay = "پنج شنبه، "
Case 2
strDay = "جمعه، "
Case 3
strDay = "شنبه، "
Case 4
strDay = "يک شنبه، "
Case 5
strDay = "دو شنبه، "
Case 6
strDay = "سه شنبه، "
End Select
Select Case intMonth
Case 1
PersianDate = strDay & lngDay & " فروردين " & intYear
Case 2
PersianDate = strDay & lngDay & " ارديبهشت " & intYear
Case 3
PersianDate = strDay & lngDay & " خرداد " & intYear
Case 4
PersianDate = strDay & lngDay & " تير " & intYear
Case 5
PersianDate = strDay & lngDay & " مرداد " & intYear
Case 6
PersianDate = strDay & lngDay & " شهريور " & intYear
Case 7
PersianDate = strDay & lngDay & " مهر " & intYear
Case 8
PersianDate = strDay & lngDay & " آبان " & intYear
Case 9
PersianDate = strDay & lngDay & " آذر " & intYear
Case 10
PersianDate = strDay & lngDay & " دی " & intYear
Case 11
PersianDate = strDay & lngDay & " بهمن " & intYear
Case 12
PersianDate = strDay & lngDay & " اسفند " & intYear
End Select
End If
End Function