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

لطفا اگر اطلاعاتی در این زمینه دارید راهنمایی نمائید

با سلام
یه سری به :
http://www.barnamenevis.org/vi...?p=29280#29280بزن

آقای مهدوی با تشکر از شما
ولی این فایل rar به چه صورت استفاده میشود؟

دوست عزیز
این فایل رو winzip بازش کن. سورس یه فایل asp هستش. با این حال کدشو اینجا گذاشتم :

<%@Language=VBScript%>

<META http-equiv=CONTENT-TYPE content="text/html; charset=utf-8">

<%

D = Array (20, 19, 20, 20, 21, 21, 22, 22, 22, 22, 21, 21)

P = Array (11, 12, 10, 12, 11, 11, 10, 10, 10, 9, 10, 10)

W = Array ("یکشنبه", "دوشنبه", "سه شنبه", "چهارشنبه", "پنجشنبه", "جمعه", "شنبه")

Mon = Array ("فروردین", "اردیبهشت", "خرداد", "تیر", "مرداد", "شهریور", "مهر", "آبان", "آذر", "دی", "بهمن", "اسفند")

Dm = Day(Date)

Mm = Month(Date)

Ym = Year(Date)

U = 0 

Rp = 0

If (Ym Mod 4) = 0 Then U = 1

If ((Ym Mod 100) = 0 AND (Ym Mod 400) <> 0) Then U = 0

Ys = Ym - 622

X = Ys - 22

X = X Mod 33

If ((X Mod 4) = 0 AND X <> 32) Then Rp = 1

I = Not(Rp-2) + NOT(U - 2) * 2

X = 0

If (I = 0 AND Mm = 3) Then X = 1

If I = 0 Then I = 3

Ms = (9 + Mm) Mod 13

If Ms < 10 Then Ms = Ms + 1

D1 = D(Mm - 1)

If (I = 1 AND Mm > 2) Then D1 = D1 - 1

If (I = 2 AND Mm < 3) then D1 = D1 - 1

P1 = P(Mm - 1)

If (I = 1 AND Mm > 2) Then P1 = P1 + 1

If (I = 2 AND Mm < 4) Then P1 = P1 + 1

If (Dm > 0 AND Dm <= D1) Then

    Ds = P1 + Dm + X - 1

    X = 1

Else

    Ds = Dm - D1

    Ms = Ms + 1

    If Ms = 13 Then Ms = 1

    X = 2

End If

If ((Mm = 3 AND X = 2) OR Mm > 3) Then Ys = Ys + 1

DateShamsi = W(WeekDay(Date) - 1) & " " & Ds & " " & Mon(Ms - 1) & " " & Ys

%>

<%= DateShamsi %>

منبع سایت : Iranasp.net

آقای مهدوی بسیار بسیار ممنون
منتها یک سوال و اون اینکه آیا این تابع سالهای کبیسه را هم در محاسبات خود منظور مینماید
با تشکر فراوان از شما

با سلام
خواهش می کنم. بله انشاالله . :lol:

آقای مهدوی سلام
با عرض پوزش تابعی که شما در بالا سورس آن را قرار داده اید امسال را 30 روز محاسبه میکند
یعنی روز شنبه 30/12/82 برگردانده میشود....!
لطفا راهنمایی نمایید.

اقای مهدوی منم فکر کنم یه روز عقب افتاده :(

آره دوست عزیز
من یکی دیگه تو SQL دارم.
اونو درسته. تبدیل می کنم به وبی و اینجا قرار می دم

ممنون :oops:

آقای مهدوی ممنون فقط اگه لطف کنید سریعتر چون خیلی حیاتیه

سلام
و با عرض پوزش از اینکه دیر شد :

<%@ Language=VBScript %>

<META http-equiv=CONTENT-TYPE content="text/html; charset=windows-1256">

<%

 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(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



 %>

<%= DateShamsi %>

این دیگه انشاالله درسته :lol:

سلام.

نقل قول:

---

من یکی دیگه تو SQL دارم.

---

اگر منظورتون در SQL Server است لطفا سورس و نحوه استفاده‌اش رو اینجا برای ما بگذارید.

با سلام
چشم. فقط یه نکته کلیدی داره و اون این که در SQL Server چون آرایه نداریم از یه کلک .... استفاده شده :lol:

CREATE PROCEDURE Hijri_Date

( @FDate Char(10)  output)

 AS

Declare @EDate DateTime

 Declare @EYear int, @EMon smallint, @EDay smallint, @ELeap bit, @EMonArray Char(12), @EDayOfYear int

 Declare @FYear int, @FMon smallint, @FDay smallint, @FLeap bit, @FMonArray Char(12)

 Select @FMonArray= Char(31)+Char(31)+Char(31)  +Char(31)+Char(31)+Char(31&#41  ;+Char(30)+Char(30)+Char(30&#4  1;+Char(30)+Char(30)+Char(29&#  41;

 Select @EMonArray= Char(31)+Char(28)+Char(31)  +Char(30)+Char(31)+Char(30&#41  ;+Char(31)+Char(31)+Char(30&#4  1;+Char(31)+Char(30)+Char(31&#  41;

 set @EDate = Getdate()



 Select @EYear= Year(@EDate)

 Select @EMon= Month(@EDate)

 Select @EDay= Day(@EDate)

 if (@EYear %4)=0 Select @ELeap=1 else Select @ELeap=0

 --------------------- Calc Day Of Year

 Declare @Temp int, @Cnt int

 Select @Cnt=@EMon-1

 Select @Temp=0

 While @Cnt<>0 begin

   if (@Cnt=2)and(@ELeap=1) Select @Temp= @Temp+29

   else Select @Temp= @Temp + Ascii(Substring(@EMonArray, @Cnt, 1))

   Select @Cnt=@Cnt-1

 end

 Select @EDayOfYear= @Temp+@EDay

 ---------------------- Convert to Farsi

 Select @Temp= @EDayOfYear-79

 if @Temp>0 Select @FYear= @EYear-621

 else begin

  Select @FYear= @EYear-622

  if ((@FYear %4)=3) Select @Temp= @Temp+366 else Select @Temp= @Temp+365

 end

  if (@FYear %4)=3 Select @FLeap=1 else Select @Fleap=0

 Select @Cnt= 1

 While (@Temp<>0) and (@Temp>Ascii(Substring(@FMonArray, @Cnt, 1))) begin

   if @Cnt=12

     if (@FLeap=1) Select @Temp=@Temp-30 else Select @Temp= @Temp-29

   else Select @Temp= @Temp-Ascii(Substring(@FMonArray, @Cnt, 1))

   Select @Cnt= @Cnt+1

 end

 if @Temp<>0 begin

  Select @FMon= @Cnt

  Select @FDay= @Temp

 end else begin

  Select @FMon= 12

  Select @FDay=30

 end

 ------------------ Create Output

 Declare @YStr Char(4), @MStr char(2), @DStr Char(2)

 select @YStr= Convert(Char, @FYear)

 if @FMon<10 Select @MStr='0'+Convert(Char,@FMon) else Select @MStr=Convert(Char, @FMon)

 if @FDay<10 Select @DStr='0'+Convert(Char,@FDay) else Select @DStr=Convert(Char, @FDay)

 Select @FDate= @YStr+'/'+@MStr+'/'+@dStr



 ------------------

:تشویق: آقای مهدوی واقعاً ممنونم چون تمام فایلهای aspیم با مشکل اون یه روز مواجه شده بودند که به لطف شما رله :mrgreen: :wink: شد.

این کد رو استفاده کردیم خیلی خوب جواب میده.

<%

Function cabiseMilady(yyMilady)
If (yyMilady Mod 4 = 0) And (yyMilady Mod 100 <> 0) Or (yyMilady Mod 400 = 0) Then
cabiseMilady = True
Exit Function
Else
cabiseMilady = False
End If
End Function

Function cabiseShamsi(yyShamsi)
dim gap
gap = (yyShamsi - 1375) Mod 4
If gap = 0 Then
cabiseShamsi = True
Exit Function
Else
cabiseShamsi = False
End If
End Function

Function checkDate(tarikh)
dim sw
dim mm
dim dd
sw = True
mm = Val(mah(tarikh))
dd = Val(roz(tarikh))
If mm > 12 Or mm < 1 Then
sw = False
Else
Select Case mm
Case 1, 2, 3, 4, 5, 6
If dd > 31 Or dd < 1 Then
sw = False
End If
Case 7, 8, 9, 10, 11, 12
If dd > 30 Or dd < 1 Then
sw = False
End If
End Select
End If
checkDate = sw
End Function

Function darmahdode(t1, t2, t3)
dim n
If t3 >= t1 And t3 <= t2 Then
n = 1 'faseleTarikh(t1, t3)
ElseIf t3 < t1 Then
n = 0
Else
n = -1 '-faseleTarikh(t2, t3)
End If
darmahdode = n
End Function

Function faseletarikh(tarikh1, tarikh2)
dim Sign
dim sal1
dim sal2
dim l
dim n
dim X
If tarikh1 > tarikh2 Then
Sign=-1
sal2 = tarikh1
sal1 = tarikh2
Else
Sign=1
sal2 = tarikh2
sal1 = tarikh1
End If
l = sal(sal2) - sal(sal1)
n = 0
For i = 1 To l
If cabiseShamsi(sal(sal1) + i - 1) Then
n = n + 1
End If
Next
X = rozSal(sal2) - rozSal(sal1)
If l > 0 Then
X = X + n + l * 365
End If
faseletarikh = X*Sign
End Function

Function mah(tarikh)
dim parts
parts=split(tarikh,"/",-1,0)
mah = Cint(parts(1))
End Function

Function miladyToShamsi(tarikh)
dim yyShamsi
dim ddShamsi
dim mmShamsi
dim milady
yyShamsi = sal(tarikh) - 621
If cabiseMilady(sal(tarikh)) = False Then
If cabiseMilady(sal(tarikh) - 1) = True Then
Select Case mah(tarikh)
Case 1
ddShamsi = roz(tarikh) + 11
mmShamsi = 10
yyShamsi = yyShamsi - 1
If ddShamsi > 30 Then
ddShamsi = ddShamsi - 30
mmShamsi = 11
End If
Case 2
ddShamsi = roz(tarikh) + 12
yyShamsi = yyShamsi - 1
mmShamsi = 11
If ddShamsi > 30 Then
ddShamsi = ddShamsi - 30
mmShamsi = 12
End If
Case 3
yyShamsi = yyShamsi - 1
ddShamsi = roz(tarikh) + 10
mmShamsi = 12
If ddShamsi > 30 Then
ddShamsi = ddShamsi - 30
mmShamsi = 1
yyShamsi = yyShamsi + 1
End If
Case 4
ddShamsi = roz(tarikh) + 11
mmShamsi = 1
If ddShamsi > 31 Then
ddShamsi = ddShamsi - 31
mmShamsi = 2
End If
Case 5, 6
ddShamsi = roz(tarikh) + 10
mmShamsi = mah(tarikh) - 3
If ddShamsi > 31 Then
ddShamsi = ddShamsi - 31
mmShamsi = mmShamsi + 1
End If
Case 7, 8, 9
ddShamsi = roz(tarikh) + 9
mmShamsi = mah(tarikh) - 3
If ddShamsi > 31 Then
ddShamsi = ddShamsi - 31
mmShamsi = mmShamsi + 1
End If
Case 10
ddShamsi = roz(tarikh) + 8
mmShamsi = 7
If ddShamsi > 30 Then
ddShamsi = ddShamsi - 30
mmShamsi = 8
End If
Case 11, 12
ddShamsi = roz(tarikh) + 9
mmShamsi = mah(tarikh) - 3
If ddShamsi > 30 Then
ddShamsi = ddShamsi - 30
mmShamsi = mmShamsi + 1
End If
End Select
'---------------------------------------------------------------
Else
Select Case mah(tarikh)
Case 1
ddShamsi = roz(tarikh) + 10
mmShamsi = 10
yyShamsi = yyShamsi - 1
If ddShamsi > 30 Then
ddShamsi = ddShamsi - 30
mmShamsi = 11
End If
Case 2
ddShamsi = roz(tarikh) + 11
yyShamsi = yyShamsi - 1
mmShamsi = 11
If ddShamsi > 30 Then
ddShamsi = ddShamsi - 30
mmShamsi = 12
End If
Case 3
yyShamsi = yyShamsi - 1
ddShamsi = roz(tarikh) + 9
mmShamsi = 12
If ddShamsi > 29 Then
ddShamsi = ddShamsi - 29
mmShamsi = 1
yyShamsi = yyShamsi + 1
End If
Case 4
ddShamsi = roz(tarikh) + 11
mmShamsi = 1
If ddShamsi > 31 Then
ddShamsi = ddShamsi - 31
mmShamsi = 2
End If
Case 5, 6
ddShamsi = roz(tarikh) + 10
mmShamsi = mah(tarikh) - 3
If ddShamsi > 31 Then
ddShamsi = ddShamsi - 31
mmShamsi = mmShamsi + 1
End If
Case 7, 8, 9
ddShamsi = roz(tarikh) + 9
mmShamsi = mah(tarikh) - 3
If ddShamsi > 31 Then
ddShamsi = ddShamsi - 31
mmShamsi = mmShamsi + 1
End If
Case 10
ddShamsi = roz(tarikh) + 8
mmShamsi = 7
If ddShamsi > 30 Then
ddShamsi = ddShamsi - 30
mmShamsi = 8
End If
Case 11, 12
ddShamsi = roz(tarikh) + 9
mmShamsi = mah(tarikh) - 3
If ddShamsi > 30 Then
ddShamsi = ddShamsi - 30
mmShamsi = mmShamsi + 1
End If
End Select
End If
Else
Select Case mah(tarikh)
Case 1
ddShamsi = roz(tarikh) + 10
mmShamsi = 10
yyShamsi = yyShamsi - 1
If ddShamsi > 30 Then
ddShamsi = ddShamsi - 30
mmShamsi = 11
End If
Case 2
ddShamsi = roz(tarikh) + 11
yyShamsi = yyShamsi - 1
mmShamsi = 11
If ddShamsi > 30 Then
ddShamsi = ddShamsi - 30
mmShamsi = 12
End If
Case 3
yyShamsi = yyShamsi - 1
ddShamsi = roz(tarikh) + 10
mmShamsi = 12
If ddShamsi > 29 Then
ddShamsi = ddShamsi - 29
mmShamsi = 1
yyShamsi = yyShamsi + 1
End If
Case 4
ddShamsi = roz(tarikh) + 12
mmShamsi = 1
If ddShamsi > 31 Then
ddShamsi = ddShamsi - 31
mmShamsi = 2
End If
Case 5, 6
ddShamsi = roz(tarikh) + 11
mmShamsi = mah(tarikh) - 3
If ddShamsi > 31 Then
ddShamsi = ddShamsi - 31
mmShamsi = mmShamsi + 1
End If
Case 7, 8, 9
ddShamsi = roz(tarikh) + 10
mmShamsi = mah(tarikh) - 3
If ddShamsi > 31 Then
ddShamsi = ddShamsi - 31
mmShamsi = mmShamsi + 1
End If
Case 10
ddShamsi = roz(tarikh) + 9
mmShamsi = 7
If ddShamsi > 30 Then
ddShamsi = ddShamsi - 30
mmShamsi = 8
End If
Case 11, 12
ddShamsi = roz(tarikh) + 10
mmShamsi = mah(tarikh) - 3
If ddShamsi > 30 Then
ddShamsi = ddShamsi - 30
mmShamsi = mmShamsi + 1
End If
End Select
End If
milady = Trim(Cstr(yyShamsi)) & "/"
'If mmShamsi < 10 Then
' milady = milady & "0"
'End If
milady = milady & Trim(Cstr(mmShamsi)) & "/"
'If ddShamsi < 10 Then
' milady = milady & "0"
'End If
milady = milady & Trim(Cstr(ddShamsi))
miladyToShamsi = milady
End Function

Function roz(tarikh)
dim l
dim dd
l = InStr(InStr(tarikh, "/") + 1, tarikh, "/") + 1
dd = Mid(tarikh, l)
roz = Cint(dd)
End Function

Function rozSal(tarikh)
Select Case mah(tarikh)
Case 1, 2, 3, 4, 5, 6
rozSal = (mah(tarikh) - 1) * 31 + roz(tarikh)
Case 7, 8, 9, 10, 11, 12
rozSal = (mah(tarikh) - 7) * 30 + roz(tarikh) + 186
End Select
End Function
Function sal(tarikh)
dim parts
parts=split(tarikh,"/",-1,0)
sal = Cint(parts(0))
End Function

Function shamsiToMilady(tarikh)
dim yyMilady
dim mmMilady
dim ddMilady
dim shamsi
yyMilady = sal(tarikh) + 621
If cabiseShamsi(sal(tarikh)) = False Then
If cabiseShamsi(sal(tarikh) + 1) = False Then
Select Case mah(tarikh)
Case 1, 11
ddMilady = roz(tarikh) + 20
mmMilady = mah(tarikh) + 2
If mmMilady > 12 Then
mmMilady = mmMilady - 12
yyMilady = yyMilady + 1
End If
If ddMilady > 31 Then
ddMilady = ddMilady - 31
mmMilady = mmMilady + 1
End If
Case 2
ddMilady = roz(tarikh) + 20
mmMilady = 4
If ddMilady > 30 Then
ddMilady = ddMilady - 30
mmMilady = 5
End If
Case 3, 10
ddMilady = roz(tarikh) + 21
mmMilady = (mah(tarikh) + 2)
If ddMilady > 31 Then
ddMilady = ddMilady - 31
mmMilady = mmMilady + 1
End If
If mmMilady > 12 Then
mmMilady = 1
yyMilady = yyMilady + 1
End If
Case 4, 9
ddMilady = roz(tarikh) + 21
mmMilady = (mah(tarikh) + 2)
If ddMilady > 30 Then
ddMilady = ddMilady - 30
mmMilady = mmMilady + 1
End If
Case 5, 6, 8
ddMilady = roz(tarikh) + 22
mmMilady = (mah(tarikh) + 2)
If ddMilady > 31 Then
ddMilady = ddMilady - 31
mmMilady = mmMilady + 1
End If
Case 7
ddMilady = roz(tarikh) + 22
mmMilady = (mah(tarikh) + 2)
If ddMilady > 30 Then
ddMilady = ddMilady - 30
mmMilady = mmMilady + 1
End If
Case 12
ddMilady = roz(tarikh) + 19
mmMilady = 2
If ddMilady > 28 Then
ddMilady = ddMilady - 28
mmMilady = mmMilady + 1
yyMilady = yyMilady + 1
End If
End Select
'--------------------------------------------------------------
Else
Select Case mah(tarikh)
Case 1, 11
ddMilady = roz(tarikh) + 20
mmMilady = mah(tarikh) + 2
If mmMilady > 12 Then
mmMilady = mmMilady - 12
yyMilady = yyMilady + 1
End If
If ddMilady > 31 Then
ddMilady = ddMilady - 31
mmMilady = mmMilady + 1
End If
Case 2
ddMilady = roz(tarikh) + 20
mmMilady = 4
If ddMilady > 30 Then
ddMilady = ddMilady - 30
mmMilady = 5
End If
Case 3, 10
ddMilady = roz(tarikh) + 21
mmMilady = (mah(tarikh) + 2)
If ddMilady > 31 Then
ddMilady = ddMilady - 31
mmMilady = mmMilady + 1
End If
If mmMilady > 12 Then
mmMilady = 1
yyMilady = yyMilady + 1
End If
Case 4, 9
ddMilady = roz(tarikh) + 21
mmMilady = (mah(tarikh) + 2)
If ddMilady > 30 Then
ddMilady = ddMilady - 30
mmMilady = mmMilady + 1
End If
Case 5, 6, 8
ddMilady = roz(tarikh) + 22
mmMilady = (mah(tarikh) + 2)
If ddMilady > 31 Then
ddMilady = ddMilady - 31
mmMilady = mmMilady + 1
End If
Case 7
ddMilady = roz(tarikh) + 22
mmMilady = (mah(tarikh) + 2)
If ddMilady > 30 Then
ddMilady = ddMilady - 30
mmMilady = mmMilady + 1
End If
Case 12
ddMilady = roz(tarikh) + 19
mmMilady = 2
If ddMilady > 29 Then
ddMilady = ddMilady - 29
mmMilady = mmMilady + 1
yyMilady = yyMilady + 1
End If
End Select
End If
Else
Select Case mah(tarikh)
Case 1, 11
ddMilady = roz(tarikh) + 19
mmMilady = mah(tarikh) + 2
If mmMilady > 12 Then
mmMilady = mmMilady - 12
yyMilady = yyMilady + 1
End If
If ddMilady > 31 Then
ddMilady = ddMilady - 31
mmMilady = mmMilady + 1
End If
Case 2
ddMilady = roz(tarikh) + 19
mmMilady = 4
If ddMilady > 30 Then
ddMilady = ddMilady - 30
mmMilady = 5
End If
Case 3, 10
ddMilady = roz(tarikh) + 20
mmMilady = (mah(tarikh) + 2)
If ddMilady > 31 Then
ddMilady = ddMilady - 31
mmMilady = mmMilady + 1
End If
If mmMilady > 12 Then
mmMilady = 1
yyMilady = yyMilady + 1
End If
Case 4, 9
ddMilady = roz(tarikh) + 20
mmMilady = (mah(tarikh) + 2)
If ddMilady > 30 Then
ddMilady = ddMilady - 30
mmMilady = mmMilady + 1
End If
Case 5, 6, 8
ddMilady = roz(tarikh) + 21
mmMilady = (mah(tarikh) + 2)
If ddMilady > 31 Then
ddMilady = ddMilady - 31
mmMilady = mmMilady + 1
End If
Case 7
ddMilady = roz(tarikh) + 21
mmMilady = (mah(tarikh) + 2)
If ddMilady > 30 Then
ddMilady = ddMilady - 30
mmMilady = mmMilady + 1
End If
Case 12
ddMilady = roz(tarikh) + 18
mmMilady = 2
If ddMilady > 28 Then
ddMilady = ddMilady - 28
mmMilady = mmMilady + 1
yyMilady = yyMilady + 1
End If
End Select
End If
shamsi = Trim(Cstr(yyMilady)) & "/"
If mmMilady < 10 Then
shamsi = shamsi & "0"
End If
shamsi = shamsi & Trim(Cstr(mmMilady)) & "/"
If ddMilady < 10 Then
shamsi = shamsi & "0"
End If
shamsi = shamsi & Trim(Cstr(ddMilady))
shamsiToMilady = shamsi
End Function




%>

با عرض سلام لطفا برای مشکل کار با تاریخ سری به سایت www.nano3oft.com بزنید . دیگه فکر نکنم مشکل کار با تاریخ داشته باشید .

نقل قول:

---

نوشته شده توسط Mahdavi

سلام
و با عرض پوزش از اینکه دیر شد :

<%@ Language=VBScript %>

<META http-equiv=CONTENT-TYPE content="text/html; charset=windows-1256">

<%

 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(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



 %>

<%= DateShamsi %>

این دیگه انشاالله درسته :lol:

---

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

ممنون میشم اگه زودتر جواب بدین