dim mode mode=1 sub ConvertKeyToFarsi() dim Key ,unicode Key=Chrw(window.event.keyCode) 'Alert "" & window.event.keyCode & " Ch=" & Key Select Case (Key) ' case "'", "?" , "/" : ' Hamzah Kochak ' unicode=191 case "" , "m": ' Hamzah Kochak unicode=1574 case "", "M": ' Hamzah Bozorg unicode = 1569 case "", "h": unicode=1575 case "", "H": unicode = 1570 case "", "f", "F": unicode = 1576 case "" , "`",Chrw(247) : 'Pe unicode = 1662 case "" , "j" , "J": 'Te unicode = 1578 case "", "e" , "E": 'Ce unicode = 1579 case "", "[": 'Je unicode = 1580 case "", "]": 'Che unicode = 1670 case "" , "p" , "P": 'Haa unicode = 1581 case "","o" , "O": 'Kha unicode = 1582 case "", "n" , "N": 'Dal unicode = 1583 case "","b", "B": 'Zal unicode = 1584 case "" , "v" , "V": 'Re unicode = 1585 case "" , "c": 'Ze unicode = 1586 case "" , "|","\", "C": ' Zhe unicode = 1688 case "" , "s" , "S": 'Sin unicode = 1587 case "" , "a" , "A": 'Shin unicode = 1588 case "" , "w", "W": 'Saad unicode = 1589 case "" , "q", "Q": 'Zaad unicode = 1590 case "" , "x" , "X": ' Taa unicode = 1591 case "" , "z" , "Z": ' Zaa unicode = 1592 case "" , "t", "T": 'Fe unicode = 1601 case "" , "r" , "R": ' Ghaaf unicode = 1602 case "" , "u" , "U": ' Aein unicode = 1593 case "" , "y" , "Y": ' Ghain unicode = 1594 case "" , ";": ' Kaf unicode = 1603 case chr(39), "" : ' Gaf unicode = 1711 case "" , "g" , "G": ' Lam unicode = 1604 case "" , "l" , "L": ' Mim unicode = 1605 case "" , "k" , "K": ' Noon unicode = 1606 case "" , "i" , "I": ' He unicode = 1607 case "" , ",": ' Wav unicode = 1608 case "" , "d" , "D": ' Ya unicode = 1610 Case Else unicode=Asc(Key ) End Select 'Alert "PCode:" & Asc(Key) & " Unicode=" & unicode & " cc " & Chrw(UniCode) window.event.keyCode=unicode window.event.returnValue=TRUE End sub '----------------------------------------------- 'this Function Calculate Hijridate from current date '-------------------------------- Function HijriDate(CENTURY,DateStr) Dim Curdate, sal, mah, roz, s_sal, s_mah,s_roz,ss, t_sal, gam, i, sals,tt if (DateStr)="" then Curdate = Date else Curdate = DateStr end if sal = Year(Curdate): mah = Month(Curdate): roz = Day(Curdate) Dim k, t If ((sal > 1995) And (sal Mod 4 = 0)) Then k = 1 Else k = 0 If (mah > 3 Or (mah = 3 And roz > 20 - k) ) Then k = 0 Else k = 1 s_sal = sal - 621 - k If (s_sal < 1374) Then t = 2 Else t = 3 If ((s_sal - t) Mod 4 = 0) Then ss = 1 Else ss =0 If ((s_sal - 3) Mod 4 = 0 And s_sal > 1374) Then tt = 1 Else tt = 0 t_sal = sal Mod 4 If (t_sal = 0) Then t_sal = 4 Dim Miladi(12) Dim Shamsi(13) Miladi(1) = 31: Miladi(3) = 31: Miladi(5) = 31: Miladi(7) = 31: Miladi(8) = 31 Miladi(10) = 31: Miladi(12) = 31: Miladi(4) = 30 Miladi(6) = 30: Miladi(9) = 30: Miladi(11) = 30: Miladi(2) = 28 + t_sal \ 4 Shamsi(4) = 31: Shamsi(5) = 31: Shamsi(6) = 31: Shamsi(7) = 31: Shamsi(8) = 31 Shamsi(9) = 31: Shamsi(2) = 30: Shamsi(10) = 30: Shamsi(11) = 30: Shamsi(12) = 30 Shamsi(1) = 20 - tt: Shamsi(3) = 29 + ss: Shamsi(13) = 10 + tt gam = 0 For i = 1 To mah - 1 gam = gam + Miladi(i) Next gam = gam + roz i = 1 Do While (gam - Shamsi(i) > 0) gam = gam - Shamsi(i) i = i + 1 Loop s_mah = i + 9 - Int((i + 9) / 13) * 12 If (s_mah = 10 And mah = 1) Then s_roz = gam + 10 + tt Else s_roz = gam Dim dd, mm, yyyy If s_roz < 10 Then dd = "0" + LTrim(CStr(s_roz)) Else dd = LTrim(CStr(s_roz)) If s_mah < 10 Then mm = "0" + LTrim(CStr(s_mah)) Else mm = LTrim(CStr(s_mah)) If (CENTURY = 0) Then s_sal = s_sal Mod 100 If (s_sal < 10) Then yyyy = "0" + LTrim(CStr(s_sal)) Else yyyy = LTrim(CStr(s_sal)) Else yyyy = LTrim(CStr(s_sal)) End If HijriDate = yyyy & "/" & mm & "/" & dd End function '----------------------------------------------- 'this Function Convert YMD Date To DMY Hijridate date '-------------------------------- Function DMYHijriDate(DateStr) Dim yy,mm,dd,L L=len(DateStr) if ( L=8 ) then yy=Left(DateStr,2) mm=Mid(DateStr,4,2) dd=Right(DateStr,2) else yy=Left(DateStr,4) mm=Mid(DateStr,6,2) dd=Right(DateStr,2) end if DMYHijriDate = dd &"/" & mm & "/" & yy End function '----------------------------------------------- 'this Function Convert DMY Date To YMD Hijridate date '-------------------------------- Function YMDHijriDate(DateStr) Dim yy,mm,dd,L L=len(DateStr) if ( L=8 ) then dd=Left(DateStr,2) mm=Mid(DateStr,4,2) yy=Right(DateStr,2) else yy=Right(DateStr,4) mm=Mid(DateStr,4,2) dd=Left(DateStr,2) end if YMDHijriDate = yy &"/" & mm & "/" & dd End function '----------------------------------------------- ' this Function determine Valid Hijridate '-------------------------------- Function ValidHijridate(DateStr) Dim yy,mm,dd,sal,mah,roz,Result,L DateStr=FillSpace(DateStr,"0") L= Len(DateStr) If ( L=8 or L=10 ) then if ( L=8 ) then dd=Left(DateStr,2) mm=Mid(DateStr,4,2) yy=Right(DateStr,2) else yy=Right(DateStr,4) mm=Mid(DateStr,4,2) dd=Left(DateStr,2) end if if( IsIntValue(yy) And IsIntValue(mm) And IsIntValue(dd) ) then sal=Cint(yy) mah=Cint(mm) roz=Cint(dd) ' Alert "L=" & L & "Dt=" & DateStr & "Sal=" & Sal & "mah=" & mah & "roz=" & roz Result= (sal>0 And mah>0 And mah<13 And roz>0 And roz<32 ) else Result=False end if else Result=False end if ValidHijridate=Result End function '----------------------------------------------- ' this Function Fill Space With Char in sample '-------------------------------- Function FillSpace(txt,sample) Dim L, Filltxt ,i,c L=Len(txt) Filltxt="" for i=1 to L c=Mid( txt,i,1 ) If (c=" " ) then Filltxt=Filltxt+sample else Filltxt=Filltxt+c end if Next FillSpace=Filltxt End function '----------------------------------------------- ' this Function determine Valid Int Number '-------------------------------- Function IsIntValue(StrData) Dim L,i,v L=Len(StrData) v=True For i =1 to L Select Case Mid(StrData,i,1) Case "0" ,"1","2","3","4","5","6","7","8","9" v=v Case Else v=False Exit For End Select Next IsIntValue=v End function '----------------------------------------------- ' this sub logout user '-------------------------------- sub logoutUser(url) document.url=url+"login/logout.asp" End sub