Function fdate(dat) 
  Dim dd, yy, mm, hh, idays, ldays, ff, gg, qstr,i
  Dim d(12), dy(7), my(12)
  yy = Year(dat)
  dy(1) = "يك‌شنبه"
  dy(2) = "دوشنبه"
  dy(3) = "سه‌شنبه"
  dy(4) = "چهارشنبه"
  dy(5) = "پنج‌شنبه"
  dy(6) = "آدينه"
  dy(7) = "شنبه"

  d(1) = 31
  If (yy / 4) = Int(yy / 4) Then
     d(2) = 29
  Else
     d(2) = 28
  End If

  d(3) = 31
  d(4) = 30
  d(5) = 31
  d(6) = 30
  d(7) = 31
  d(8) = 31
  d(9) = 30
  d(10) = 31
  d(11) = 30
  d(12) = 31

  my(1)="فروردین"
  my(2)="اردیبهشت"
  my(3)="خرداد"
  my(4)="تیر"
  my(5)="مرداد"
  my(6)="شهریور"
  my(7)="مهر"
  my(8)="آبان"
  my(9)="آذر"
  my(10)="دی"
  my(11)="بهمن"
  my(12)="اسفند"
  mm = 0

  For I = 1 To Month(dat) - 1
      mm = mm + d(I)
  Next
  yy = yy - 1
  dd = Day(dat)
  ldays = (yy * 365) + (Int(yy / 4)) + mm + dd
  idays = ldays - 226899
  ff = LTrim(Month(dat))
  gg = LTrim(Day(dat))
  If Len(ff) < 2 Then
     ff = "0" + ff
  End If
  If Len(gg) < 2 Then
     gg = "0" + gg
  End If
  hh = ff + gg
  If hh <= "0320" Then
     yy = Year(dat) - 622
  Else
     yy = Year(dat) - 621
  End If
  mm = idays - (Int(yy / 4)) - ((yy - 1) * 365)
  If mm <= 186 Then
     dd = mm Mod 31
     If dd = 0 Then
        dd = 31
        mm = Int(mm / 31)
     Else
        mm = Int(mm / 31) + 1
     End If
  Else
     mm = mm - 186
     dd = mm Mod 30
     If dd = 0 Then
        dd = 30
        mm = Int(mm / 30) + 6
     Else
        mm = Int(mm / 30) + 7
     End If
  End If
' If (Year(dat) / 4) = Int(Year(dat) / 4) And hh > "0320" Or (((Year(dat) - 1) / 4) = Int((Year(dat) - 1) / 4) And hh <= "0320") Then
'   dd=dd-1
' End If
  dim ss1,ss2
  If Len(Trim(mm)) = 1 then ss1= "0" & trim(mm) else ss1= Trim(mm)  
  If Len(Trim(dd)) = 1 then ss2= "0" & Trim(dd) else ss2= Trim(dd) 
  fdate = dy(Weekday(dat)) & "، " & trim(ss2) & " " & trim(my(ss1)) &  " "  &  trim(yy)
End Function