Public Function ReadStylePage(Page)
Name = Page
If ObjIsEmpty Then Call ReloadTemplates
Name = Page
ReadStylePage = Value
End Function
'Check administrator permissions
'Parameters: sName (administrator username), sItem (permission item) (sItem=0 only check for over-management permissions)
'Return: True/False
Public Function checkPermission(sName, sItem)
checkPermission = False
If sName = "" Or IsNull(sName) Then Exit Function
Dim cRs
Set cRs = Execute("select isAdmin,Permission,Password from Mesky_SiteManager Where UserName='" & checkStr(sName) & "'")
If Not ( And ) Then
If adminPass = cRs(2) Then
If cRs(0) Then checkPermission = True
If sItem <> 0 Then
If ItemInList(cRs(1), sItem) Then checkPermission = True
End If
End If
End If
Set cRs = Nothing
End Function
'
'Resource classification download list
'Parameters: catalogID (class ID selected by default); tableName (database table name)
'Return: String 0=RootID;1=CatalogID;2=Depth;3=CatalogName
Public Function GetCatalogSelect(catalogID, fromName)
Dim tRs, s, i
s= " <option value="""">All categories</option>" & vbCrLf
Set tRs = Execute("select RootID,CatalogID,Depth,CatalogName from " & fromName & " order by rootid,orders")
Do While Not
s = s & " <option value=""" & tRs(0) & "," & tRs(1) & "," & tRs(2) & "," & tRs(3) & """ "
If catalogID <> 0 Then
If tRs(1) = catalogID Then s = s & "selected"
End If
s = s & ">"
If tRs(2) = 1 Then s = s & " ├ "
If tRs(2) > 1 Then
For i = 2 To tRs(2)
s = s & " │"
Next
s = s & " ├ "
End If
s = s & tRs(3) & "</option>" & vbCrLf
Loop
Set tRs = Nothing
GetCatalogSelect = s
s = Null
End Function
'Related download resources
'Parameters: Keys, cutNum
'for Standard Edition and Premium Edition
Public Function MutualityDownRes(Keys, topNum, ID)
Dim tRs, s
If topNum = 0 Then
Set tRs = Execute("Select ID,ResName,ResVer From Mesky_Down_Resource where (ResName like '%" & Keys & "%') And ID<>" & ID & " and isAuditing=1 order by ID Desc")
Else
Set tRs = Execute("Select top " & topNum & " ID,ResName,ResVer From Mesky_Down_Resource where (ResName like '%" & Keys & "%') And ID<>" & ID & " and isAuditing=1 order by ID Desc")
End If
If And Then
s = ""
Else
dim arrA,arrB,i
i = 1
Do While Not
If i = 1 then
arrA = tRs(0)
arrB = tRs(1) & " " & tRs(2)
Else
arrA = arrA & "###" & tRs(0)
arrB = arrB & "$$$" & tRs(1) & " " & tRs(2)
End If
i = i + 1
Loop
s = arrA & "|||" & arrB
End If
Set tRs = Nothing
MutualityDownRes = s
s = Null
End Function
'Related article resources
'Parameters: Keys, cutNum
'for Standard Edition and Premium Edition
Public Function MutualityCmsRes(Keys, topNum, ID)
Dim tRs, s
If topNum = 0 Then
Set tRs = Execute("Select ID,Title From Mesky_Cms_Resource where Title like '%" & Keys & "%' And ID<>" & ID & " and isAuditing=1 order by ID Desc")
Else
Set tRs = Execute("Select top " & topNum & " ID,Title From Mesky_Cms_Resource where Title like '%" & Keys & "%' And ID<>" & ID & " and isAuditing=1 order by ID Desc")
End If
If And Then
s = ""
Else
dim arrA,arrB,i
i = 1
Do While Not
If i = 1 then
arrA = tRs(0)
arrB = tRs(1)
Else
arrA = arrA & "###" & tRs(0)
arrB = arrB & "$$$" & tRs(1)
End If
i = i + 1
Loop
s = arrA & "|||" & arrB
End If
Set tRs = Nothing
MutualityCmsRes = s
s = Null
End Function
'Related download resources
'Parameters: Keys, cutNum
'for Standard Edition and Premium Edition
Public Function showMutualityDownRes(strRes,cutNum)
If IsNull(strRes) or strRes="" then
showMutualityDownRes = ""
Exit Function
End If
Dim i, s, arrA, arrB
arrA = split(strRes,"|||")(0)
arrB = split(strRes,"|||")(1)
arrA = split(arrA,"###")
arrB = split(arrB,"$$$")
s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""1"">"
For i = 0 to Ubound(arrA)
s = s & "<tr><td>·<a href=""" & sPath & Replace(Setting(77), "{$id}", arrA(i)) & """>" & cutStr(arrB(i), Int(cutNum)) & "</a></td></tr>"
Next
s = s & "</table>"
showMutualityDownRes = s
s = Null
End Function
'Related article resources
'Parameters: Keys, cutNum
'for Standard Edition and Premium Edition
Public Function showMutualityCmsRes(strRes,cutNum)
If IsNull(strRes) or strRes="" then
showMutualityCmsRes = ""
Exit Function
End If
Dim i, s, arrA, arrB
arrA = split(strRes,"|||")(0)
arrB = split(strRes,"|||")(1)
arrA = split(arrA,"###")
arrB = split(arrB,"$$$")
s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""1"">"
For i = 0 to Ubound(arrA)
s = s & "<tr><td>·<a href=""" & sPath & Replace(Setting(101), "{$id}", arrA(i)&"_1") & """>" & cutStr(arrB(i), Int(cutNum)) & "</a></td></tr>"
Next
s = s & "</table>"
showMutualityCmsRes = s
s = Null
End Function
Public Function showNews(topNum,cutNum1,cutNum2,isType)
dim tRs,s,i
if Int(isType) = 1 then
Set tRs = Execute("select top "&topNum&" * from Mesky_News where isType = 1 order By ID Desc")
ElseIf Int(isType) = 2 then
Set tRs = Execute("select top "&topNum&" * from Mesky_News where isType = 2 order By ID Desc")
Else
Set tRs = Execute("select top "&topNum&" * from Mesky_News order By ID Desc")
End if
If and then
showNews = ""
Else
i = 1
Do While Not
If i > 1 then s = s & "<br>"
s = s & "·<a href=""?ID="&tRs("ID")&"&isType="&isType&""" target=""_blank"">"&cutStr(tRs("Title"),Int(cutNum1))&"</a>"
if Int(cutNum2) > 0 then
s = s & "<br>" & cutStr(tRs("Content"),Int(cutNum2))
End If
s = s &" "& FormatDateTime(tRs("DateAndTime"),2)
i = i + 1
Loop
End If
showNews = s
s = Null
Set tRs = Nothing
End Function
'Resource List Classification Navigation
'for Standard Edition And Premium Edition
Public Function catalog_nav(rootID, catalogID, depth, fromName)
Dim s, tRs, i, FileName
If rootID = 0 And catalogID = 0 Then
Set tRs = Execute("select catalogID,catalogName,rootID,depth,Child,ResNum from " & fromName & " where depth=0 order by rootID")
Else 'root classification rootID>0
Set tRs = Execute("select catalogID,catalogName,rootID,depth,Child,ResNum from " & fromName & " where rootID=" & rootID & " and depth>0 order by orders")
End If
If And Then
s= "Sorry! No relevant classification data was found."
Else
s = "<table width=""80%"" border=""0"" align=""center"">" & vbCrLf
Do While Not
s = s & "<tr><td>"
If tRs(3) > 1 Then
For i = 2 To tRs(3)
s = s & " "
Next
End If
If rootID = 0 Then
s = s & "<img src=""" & sPath & "images/+.gif"" border=""0"" align=""absmiddle""> "
ElseIf tRs(4) > 0 And rootID > 0 And catalogID > 0 Then
s = s & "<img src=""" & sPath & "images/+.gif"" border=""0"" align=""absmiddle""> "
Else
s = s & "<img src=""" & sPath & "images/-.gif"" border=""0"" align=""absmiddle""> "
End If
If rootID = 0 Then
If LCase(fromName) = "mesky_down_catalog" Then
FileName = Setting(72)
Else
FileName = Setting(97)
End If
s = s & "<a href=""" & sPath & Replace(Replace(FileName, "{$id}", tRs(2)), "{$pages}", "1") & """>" & tRs(1) & "</a> (<font color=red>" & tRs(5) & "</font>)"
Else
If LCase(fromName) = "mesky_down_catalog" Then
FileName = Setting(73)
Else
FileName = Setting(98)
End If
s = s & "<a href=""" & sPath & Replace(Replace(FileName, "{$id}", tRs(0)), "{$pages}", "1") & """>" & tRs(1) & "</a> (<font color=red>" & tRs(5) & "</font>)"
If tRs(0) = catalogID Then s = s & "←"
End If
s = s & "</td></tr>"
Loop
s = s & "</table>"
End If
Set tRs = Nothing
catalog_nav = s
s = Null
End Function
'Current location Navigation
'for Standard Edition
Public Function site_nav(catalogID, fromName, GetTitle, GetURL)
Dim s, tRs, catalogName, ParentID, ParentStr, depth, rootID, FileName
If LCase(fromName) = "mesky_down_catalog" Then
s s = s & "<a href=""" & sPath & Setting(70) & "">Download Home Page</a> "
Else
s s = s & "<a href=""" & sPath & Setting(95) & "">Home</a> "
End If
If catalogID > 0 Then
Set tRs = Execute("select catalogName,ParentID,ParentStr,depth,rootID from " & fromName & " where catalogID=" & catalogID)
If Not ( And ) Then
catalogName = tRs(0)
ParentID = tRs(1)
ParentStr = tRs(2)
depth = tRs(3)
rootID = tRs(4)
End If
Set tRs = Nothing
If ParentID <> 0 Then
Set tRs = Execute("select catalogID,catalogName,depth,rootID from " & fromName & " where catalogID in(" & ParentStr & ")")
If Not ( And ) Then
Do While Not
If tRs(2) > 0 Then
If LCase(fromName) = "mesky_down_catalog" Then
FileName = Setting(73)
Else
FileName = Setting(98)
End If
s = s & " → <a href=""" & sPath & Replace(Replace(FileName, "{$id}", tRs(0)), "{$pages}", "1") & """>" & tRs(1) & "</a>"
Else
If LCase(fromName) = "mesky_down_catalog" Then
FileName = Setting(72)
Else
FileName = Setting(97)
End If
s = s & " → <a href=""" & sPath & Replace(Replace(FileName, "{$id}", tRs(3)), "{$pages}", "1") & """>" & tRs(1) & "</a>"
End If
Loop
End If
Set tRs = Nothing
End If
If depth > 0 Then
If LCase(fromName) = "mesky_down_catalog" Then
FileName = Setting(73)
Else
FileName = Setting(98)
End If
s = s & " → <a href=""" & sPath & Replace(Replace(FileName, "{$id}", catalogID), "{$pages}", "1") & """>" & catalogName & "</a>"
Else
If LCase(fromName) = "mesky_down_catalog" Then
FileName = Setting(72)
Else
FileName = Setting(97)
End If
s = s & " → <a href=""" & sPath & Replace(Replace(FileName, "{$id}", rootID), "{$pages}", "1") & """>" & catalogName & "</a>"
End If
End If
If GetURL <> "" Then
s = s & " → <a href=""" & GetURL & """>" & GetTitle & "</a>"
Else
s = s & " → " & GetTitle
End If
site_nav = s
s = Null
End Function
'Resource Classification Page
'for Standard Edition and Premium Edition
Public Function showDownResCatalog()
Dim s, Rs, sRs, i, x, y, brNum
brNum = 6
s = s & "<table width=""770"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"">" & vbCrLf
Set Rs = Execute("select catalogID,catalogName,rootID,depth from Mesky_Down_catalog where Depth=0 order by rootID")
i = 1
If Not ( And ) Then
Do While Not
s = s & " <tr class=""tdbg" & i Mod 2 + 1 & """>" & vbCrLf
s = s & " <td width=""100"" align=""center""><a href=""" & sPath & Replace(Replace(Setting(72), "{$id}", Rs(2)), "{$pages}", "1") & """>" & Rs(1) & "</a> <a href=""xml/rss_Down_r" & Rs(2) & ".xml""><img src=""" & sPath & "images/"" border=""0"" align=""absmiddle""></a></td>" & vbCrLf
s = s & " <td><table width=""100%"" border=""0"" cellspacing=""1"" cellpadding=""3"">" & vbCrLf
s = s & " <tr>" & vbCrLf
Set sRs = Execute("select catalogID,catalogName,rootID,depth from Mesky_Down_catalog where ParentID=" & Rs(0) & " order by orders")
If Not ( And ) Then
x = 1
Do While Not
s = s & " <td align=""center"" width=""12.5%""><a href=""" & sPath & Replace(Replace(Setting(73), "{$id}", sRs(0)), "{$pages}", "1") & """>" & sRs(1) & "</a> <a href=""xml/rss_Down_s" & sRs(0) & ".xml"" class=""f11"">(RSS)</a></td>" & vbCrLf
If (x Mod brNum) = 0 Then s = s & "</tr><tr>" & vbCrLf
x = x + 1
Loop
If (x Mod brNum) > 0 Then
For y = 0 To (brNum - (x Mod brNum))
s = s & "<td align=""center"" width=""12.5%"">.</td>" & vbCrLf
Next
End If
If x = brNum Then
For y = 0 To (brNum - x)
s = s & "<td align=""center"" width=""12.5%"">.</td>" & vbCrLf
Next
End If
End If
Set sRs = Nothing
s = s & " </tr>" & vbCrLf
s = s & " </table></td>" & vbCrLf
s = s & " </tr>" & vbCrLf
i = i + 1
Loop
End If
Set Rs = Nothing
s = s & "</table>"
showDownResCatalog = s
s = Null
End Function
'Resource Classification Page
'for Standard Edition Advanced Edition
Public Function showCmsResCatalog()
Dim s, Rs, sRs, i, x, y, brNum
brNum = 5
s = s & "<table width=""770"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"">" & vbCrLf
Set Rs = Execute("select catalogID,catalogName,rootID,depth from Mesky_Cms_catalog where Depth=0 order by rootID")
i = 1
If Not ( And ) Then
Do While Not
s = s & " <tr class=""tdbg" & i Mod 2 + 1 & """>" & vbCrLf
s = s & " <td width=""100"" align=""center""><a href=""" & sPath & Replace(Replace(Setting(97), "{$id}", Rs(2)),"{$pages}","1") & """>" & Rs(1) & "</a> <a href=""xml/rss_Cms_r" & Rs(2) & ".xml""><img src=""" & sPath & "images/"" border=""0"" align=""absmiddle""></a></td>" & vbCrLf
s = s & " <td><table width=""100%"" border=""0"" cellspacing=""1"" cellpadding=""3"">" & vbCrLf
s = s & " <tr>" & vbCrLf
Set sRs = Execute("select catalogID,catalogName,rootID,depth from Mesky_Cms_catalog where ParentID=" & Rs(0) & " order by orders")
If Not ( And ) Then
x = 1
Do While Not
s = s & " <td align=""center"" width=""12.5%""><a href=""" & sPath & Replace(Replace(Setting(98), "{$id}", sRs(0)),"{$pages}","1") & """>" & sRs(1) & "</a> <a href=""xml/rss_Cms_s" & sRs(0) & ".xml"" class=""f11"">(RSS)</a></td>" & vbCrLf
If (x Mod brNum) = 0 Then s = s & "</tr><tr>"
x = x + 1
Loop
If (x Mod brNum) > 0 Then
For y = 0 To (brNum - (x Mod brNum))
s = s & "<td align=""center"" width=""12.5%"">.</td>" & vbCrLf
Next
End If
If x = brNum Then
For y = 0 To (brNum - x)
s = s & "<td align=""center"" width=""12.5%"">.</td>" & vbCrLf
Next
End If
End If
Set sRs = Nothing
s = s & " </tr>" & vbCrLf
s = s & " </table></td>" & vbCrLf
s = s & " </tr>" & vbCrLf
i = i + 1
Loop
End If
Set Rs = Nothing
s = s & "</table>"
showCmsResCatalog = s
s = Null
End Function
'for Standard Edition and Premium Edition Home
Public Function showDownResAdv(strWhere, strOrder, topNum, cutNum, showDate, showDot, showHrline, showCatalogName)
Dim tRs, s, i, strDot, strHits
If InStr(LCase(strOrder), "hits") > 0 Then
strHits = Replace(Replace(Replace(LCase(strOrder), "desc", ""), "asc", ""), " ", "")
Else
strHits = "HitsTotal"
End If
If (showDot = "" Or showDot = "0") Then
strDot = "·"
Else
strDot = showDot
End If
If strWhere <> "" Then
Set tRs = Execute("Select top " & topNum & " ID,ResName,ResVer,catalogID,catalogName," & strHits & ",UpdateTime From Mesky_Down_Resource where " & strWhere & " and isAuditing=1 order by " & strOrder & "")
Else
Set tRs = Execute("Select top " & topNum & " ID,ResName,ResVer,catalogID,catalogName," & strHits & ",UpdateTime From Mesky_Down_Resource where isAuditing=1 order by " & strOrder & "")
End If
s = "<table width=""99%"" border=""0"" cellspacing=""0"" cellpadding=""2"" align=""center"">" & vbCrLf
If And Then
s = s & " <tr>" & vbCrLf
s= s & " <td>Sorry! No records were found.</td>" & vbCrLf
s = s & " </tr>" & vbCrLf
Else
Do While Not
s = s & " <tr>" & vbCrLf
s = s & " <td>" & strDot
If showCatalogName Then 'Show Category
s = s & "[<a href=""" & Replace(Replace(Setting(73), "{$id}", tRs(3)), "{$pages}", "1") & """ target=""_blank"">" & tRs(4) & "</a>]"
End If
s = s & " <a href=""" & Replace(Setting(77), "{$id}", tRs(0)) & """ target=""_blank"" Title=""" & tRs(1) & " " & tRs(2) & """>" & cutStr(tRs(1) & " " & tRs(2), Int(cutNum)) & "</a> </td>"
If showDate = "Hits" Then 'Show time or popularity
s = s & "<td width=""30"">" & tRs(5) & "</td>" & vbCrLf
Else
s = s & "<td width=""30"">" & FormatMyDate(tRs(6), showDate) & "</td>" & vbCrLf
End If
s = s & " </tr>" & vbCrLf
If showHrline Then s = s & "<tr><td height=""1"" colspan=""2"" background=""images/bg_dot.gif""></td></tr>" & vbCrLf
Loop
End If
Set tRs = Nothing
s = s & "</table>" & vbCrLf
showDownResAdv = s
s = Null
End Function
'for Standard Edition and Premium Edition
Public Function showDownRes(strWhere, strOrder, topNum, cutNum, showDot, showHrline)
Dim tRs, s, i, strDot
i = 1
If strWhere <> "" Then
Set tRs = Execute("Select top " & topNum & " ID,ResName,ResVer From Mesky_Down_Resource where " & strWhere & " and isAuditing=1 order by " & strOrder & "")
Else
Set tRs = Execute("Select top " & topNum & " ID,ResName,ResVer From Mesky_Down_Resource where isAuditing=1 order by " & strOrder & "")
End If
If And Then
s = ""
Else
s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""1"">" & vbCrLf
Do While Not
If (showDot = "" Or showDot = "0") Then
strDot = "" & Right("0" & i, 2) & "."
Else
strDot = showDot
End If
s = s & " <tr><td><font color=red>" & strDot & "</font><a href=""" & sPath & Replace(Setting(77), "{$id}", tRs(0)) & """>" & cutStr(tRs(1) & " " & tRs(2), Int(cutNum)) & "</a></td></tr>" & vbCrLf
If showHrline Then s = s & "<tr><td height=""1"" background=""" & sPath & "images/bg_dot.gif""></td></tr>" & vbCrLf
i = i + 1
Loop
s = s & "</table>"
End If
Set tRs = Nothing
showDownRes = s
s = Null
End Function
'for Standard Edition and Premium Edition Home
Public Function showCmsResAdv(strWhere, strOrder, topNum, cutNum, showDate, showDot, showHrline, showCatalogName)
Dim tRs, s, i, strDot
If (showDot = "" Or showDot = "0") Then
strDot = "·"
Else
strDot = showDot
End If
If strWhere <> "" Then
Set tRs = Execute("Select top " & topNum & " ID,Title,catalogID,catalogName,Hits,DateAndTime,isComment,RedirectUrl From Mesky_Cms_Resource where " & strWhere & " and isAuditing=1 order by " & strOrder & "")
Else
Set tRs = Execute("Select top " & topNum & " ID,Title,catalogID,catalogName,Hits,DateAndTime,isComment,RedirectUrl From Mesky_Cms_Resource where isAuditing=1 order by " & strOrder & "")
End If
s = "<table width=""99%"" border=""0"" cellspacing=""0"" cellpadding=""2"" align=""center"">" & vbCrLf
If And Then
s = s & " <tr>" & vbCrLf
s= s & " <td>Sorry! No records were found.</td>" & vbCrLf
s = s & " </tr>" & vbCrLf
Else
Do While Not
s = s & " <tr>" & vbCrLf
s = s & " <td>" & strDot
If showCatalogName Then 'Show Category
s = s & "[<a href=""" & Replace(Replace(Setting(98), "{$id}", tRs(2)),"{$pages}","1") & """ target=""_blank"">" & tRs(3) & "</a>]"
End If
If tRs(7) <> "" then
s = s & " <a href=""" & tRs(7) & """ target=""_blank"" Title=""" & tRs(1) & """>"
Else
s = s & " <a href=""" & Replace(Setting(101), "{$id}", tRs(0)& "_1") & """ target=""_blank"" Title=""" & tRs(1) & """>"
End IF
'Show comments
If tRs(6) = 1 then
s s = s& cutStr(tRs(1), Int(cutNum)-4) & "</a> <a href=""../comment_cms.asp?ID="&tRs(0)&"">Comments</a></td>"
Else
s = s & cutStr(tRs(1), Int(cutNum)) & "</a></td>"
End IF
If showDate = "Hits" Then 'Show time or popularity
s = s & "<td width=""30"">" & tRs(4) & "</td>" & vbCrLf
Else
s = s & "<td width=""30"">" & FormatMyDate(tRs(5), showDate) & "</td>" & vbCrLf
End If
s = s & " </tr>" & vbCrLf
If showHrline Then s = s & "<tr><td height=""1"" colspan=""2"" background=""images/bg_dot.gif""></td></tr>" & vbCrLf
Loop
End If
Set tRs = Nothing
s = s & "</table>" & vbCrLf
showCmsResAdv = s
s = Null
End Function
'for Standard Edition and Premium Edition
Public Function showCmsRes(strWhere, strOrder, topNum, cutNum, showDot, showHrline)
Dim tRs, s, i, strDot
i = 1
If strWhere <> "" Then
Set tRs = Execute("Select top " & topNum & " ID,Title,isComment,RedirectUrl From Mesky_Cms_Resource where " & strWhere & " and isAuditing=1 order by " & strOrder & "")
Else
Set tRs = Execute("Select top " & topNum & " ID,Title,isComment,RedirectUrl From Mesky_Cms_Resource where isAuditing=1 order by " & strOrder & "")
End If
If And Then
s = ""
Else
s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""1"">" & vbCrLf
Do While Not
If (showDot = "" Or showDot = "0") Then
strDot = "" & Right("0" & i, 2) & "."
Else
strDot = showDot
End If
If tRs(3)<>"" then
s = s & " <tr><td><font color=red> " & strDot & "</font><a href=""" & tRs(3) & """>"
Else
s = s & " <tr><td><font color=red> " & strDot & "</font><a href=""" & sPath & Replace(Setting(101), "{$id}", tRs(0)& "_1") & """>"
End IF
'Show comments
If tRs(2) = 1 then
s s = s & cutStr(tRs(1), Int(cutNum)-4) & "</a> <a href=""../comment_cms.asp?ID="&tRs(0)&""">Comments</a></td></tr>" & vbCrLf
Else
s = s & cutStr(tRs(1), Int(cutNum)) & "</a></td></tr>" & vbCrLf
End IF
If showHrline Then s = s & "<tr><td height=""1"" background=""" & sPath & "images/bg_dot.gif""></td></tr>" & vbCrLf
i = i + 1
Loop
s = s & "</table>"
End If
Set tRs = Nothing
showCmsRes = s
s = Null
End Function
Public Function showDownResImages(strWhere, strOrder, topNum, cutNum, intWidth, intHeight, isWH)
Dim tRs, s, i
i = 1
s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""3"">" & vbCrLf
If strWhere <> "" Then
Set tRs = Execute("Select top " & topNum & " ID,ResName,ResVer,SmallImg From Mesky_Down_Resource where " & strWhere & " and isAuditing=1 and SmallImg<>'' order by " & strOrder & "")
Else
Set tRs = Execute("Select top " & topNum & " ID,ResName,ResVer,SmallImg From Mesky_Down_Resource where isAuditing=1 and SmallImg<>'' order by " & strOrder & "")
End If
If And Then
s = s & " <tr>" & vbCrLf
s= s & " <td>Sorry! No records were found.</td>" & vbCrLf
s = s & " </tr>" & vbCrLf
Else
If isWH = 1 Then s = s & " </tr>" & vbCrLf
Do While Not
If isWH = 2 Then s = s & " <tr>" & vbCrLf
s = s & " <td align=""center""><a href=""" & sPath & Replace(Setting(77), "{$id}", tRs(0)) & """ target=""_blank"" Title=""" & tRs(1) & " " & tRs(2) & """><img src=""" & sPath & tRs(3) & """ border=0 width=""" & intWidth & """ height=""" & intHeight & """></a>"
s = s & "<br><a href=""" & sPath & Replace(Setting(77), "{$id}", tRs(0)) & """ target=""_blank"">" & cutStr(tRs(1) & " " & tRs(2), Int(cutNum)) & "</a></td>" & vbCrLf
If isWH = 2 Then s = s & " </tr>" & vbCrLf
Loop
End If
Set tRs = Nothing
If isWH = 1 Then s = s & " </tr>" & vbCrLf
s = s & "</table>" & vbCrLf
showDownResImages = s
s = Null
End Function
Public Function showCmsResImages(strWhere, strOrder, topNum, cutNum, intWidth, intHeight, isWH)
Dim tRs, s, i
i = 1
s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""3"">" & vbCrLf
If strWhere <> "" Then
Set tRs = Execute("Select top " & topNum & " ID,Title,SmallImg,RedirectUrl From Mesky_Cms_Resource where " & strWhere & " and isAuditing=1 and SmallImg<>'' order by " & strOrder & "")
Else
Set tRs = Execute("Select top " & topNum & " ID,Title,SmallImg,RedirectUrl From Mesky_Cms_Resource where isAuditing=1 and SmallImg<>'' order by " & strOrder & "")
End If
If And Then
s = s & " <tr>" & vbCrLf
s= s & " <td>Sorry! No records were found.</td>" & vbCrLf
s = s & " </tr>" & vbCrLf
Else
If isWH = 1 Then s = s & " </tr>" & vbCrLf
Do While Not
If isWH = 2 Then s = s & " <tr>" & vbCrLf
If tRs(3) <> "" then
s = s & " <td align=""center""><a href=""" & tRs(3) & """ target=""_blank"" Title=""" & tRs(1) & """><img src=""" & sPath & tRs(2) & """ border=0 width=""" & intWidth & """ height=""" & intHeight & """></a>"
s = s & "<br><a href=""" & tRs(3) & """>" & cutStr(tRs(1), Int(cutNum)) & "</a></td>" & vbCrLf
Else
s = s & " <td align=""center""><a href=""" & sPath & Replace(Setting(101), "{$id}", tRs(0)& "_1") & """ target=""_blank"" Title=""" & tRs(1) & """><img src=""" & sPath & tRs(2) & """ border=0 width=""" & intWidth & """ height=""" & intHeight & """></a>"
s = s & "<br><a href=""" & sPath & Replace(Setting(101), "{$id}", tRs(0)& "_1") & """>" & cutStr(tRs(1), Int(cutNum)) & "</a></td>" & vbCrLf
End IF
If isWH = 2 Then s = s & " </tr>" & vbCrLf
Loop
End If
Set tRs = Nothing
If isWH = 1 Then s = s & " </tr>" & vbCrLf
s = s & "</table>" & vbCrLf
showCmsResImages = s
s = Null
End Function
Public Function showCmsResExcerptImages(strWhere, strOrder, topNum, cutNum1, cutNum2, intWidth, intHeight, isWH)
Dim tRs, s, i
i = 1
s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""3"">" & vbCrLf
If strWhere <> "" Then
Set tRs = Execute("Select top " & topNum & " ID,Title,SmallImg,Excerpt,RedirectUrl From Mesky_Cms_Resource where " & strWhere & " and isAuditing=1 and SmallImg<>'' order by " & strOrder & "")
Else
Set tRs = Execute("Select top " & topNum & " ID,Title,SmallImg,Excerpt,RedirectUrl From Mesky_Cms_Resource where isAuditing=1 and SmallImg<>'' order by " & strOrder & "")
End If
If And Then
s = s & " <tr>" & vbCrLf
s= s & " <td>Sorry! No records were found.</td>" & vbCrLf
s = s & " </tr>" & vbCrLf
Else
If isWH = 1 Then s = s & " </tr>" & vbCrLf
Do While Not
If isWH = 2 Then s = s & " <tr>" & vbCrLf
s = s & " <td><img src=""" & sPath & tRs(2) & """ border=0 width=""" & intWidth & """ height=""" & intHeight & """ align=""left"">"
If tRs(4) <> "" then
s = s & "<a href=""" & tRs(4) & """>" & cutStr(tRs(1), Int(cutNum1)) & "</a>"
Else
s = s & "<a href=""" & sPath & Replace(Setting(101), "{$id}", tRs(0)& "_1") & """>" & cutStr(tRs(1), Int(cutNum1)) & "</a>"
End If
If Int(cutNum2) > 0 then s = s & "<br>"&cutStr(tRs(3),Int(cutNum2))
s = s & "</td>" & vbCrLf
If isWH = 2 Then s = s & " </tr>" & vbCrLf
Loop
End If
Set tRs = Nothing
If isWH = 1 Then s = s & " </tr>" & vbCrLf
s = s & "</table>" & vbCrLf
showCmsResExcerptImages = s
s = Null
End Function
'//Intercept the string of specified length
'//Return type: string
Public Function cutStr(str, strlen)
If str="" or isnull(str) then Exit Function
Dim l, t, c, i
l = Len(str)
t = 0
For i = 1 To l
c = Abs(Asc(Mid(str, i, 1)))
If c > 255 Then
t = t + 2
Else
t = t + 1
End If
If t >= strlen Then
cutStr = Left(str, i) & ".."
Exit For
Else
cutStr = str
End If
Next
cutStr = Replace(cutStr, Chr(10), "")
End Function
Public Sub SystemMsg()
"<TABLE width=""75%"" align=""center"">" & vbCrLf
" <TR>" & vbCrLf
" <TD>" & vbCrLf
"<DIV class=ContainerSection>" & vbCrLf
" <DIV class=ContainerTopBorder>" & vbCrLf
" <DIV class=ContainerTop></DIV>" & vbCrLf
" </DIV>" & vbCrLf
" <DIV class=ContainerContent> System Message:</DIV> " & vbCrLf
" <DIV><br> <B>" & strMsg & "</B><BR><BR>" & vbCrLf
" <DIV class=ContainerContent align=""center""><a href=""" & RefererPage & ""><<Return to previous page</a>" & vbCrLf
" </DIV> " & vbCrLf
" </DIV>" & vbCrLf
" <DIV class=BottomWrapper>" & vbCrLf
" <DIV class=ContainerBottomBorder>" & vbCrLf
" <DIV class=ContainerBottom></DIV>" & vbCrLf
" </DIV>" & vbCrLf
" </DIV>" & vbCrLf
"</DIV>" & vbCrLf
" </TD>" & vbCrLf
" </TR>" & vbCrLf
"</TABLE>" & vbCrLf
End Sub
Public Function CopyRight()
Dim reval
reval = reval & "Powered By <a href="""" title=""Powered By "">Dynamic Download System (MeskyDMS) V3.0</a>"
CopyRight = reval
reval = Null
End Function
Public Function HtmlHead()
Dim reval
reval = reval & "<!--Published Date:" & Now() & " Powered by -->" & vbCrLf
reval = reval & "<!--" & vbCrLf
reval = reval & "┌───────────────────── MESKY─┐" & vbCrLf
reval = reval & "│Dynamic Download System V3.0 ——│" & vbCrLf
reval = reval & "│Program purchase QQ: 26934364 Mobile: 13586085531 │" & vbCrLf
reval = reval & "└───────────────────────.NET┘" & vbCrLf
reval = reval & "-->" & vbCrLf
HtmlHead = reval
reval = Null
End Function
Public Function DMSVer()
If IsSqlDataBase = 1 Then
DMSVer = "Dynamic Download System (MeskyDMS) V3.0 Build 050623 SQL Version"
Else
DMSVer = "Dynamic Download System (MeskyDMS) V3.0 Build 050623 Access Version"
End If
End Function
Public Function F469e80d32(tr)
If ("SERVER_NAME")="127.0.0.1" then
F469e80d32 = "1"
Exit Function
End If
F469e80d32 = "0"
Dim tRs,tempStr, RegCode
tempStr = ("SERVER_NAME") & "C0559f8d32"
RegCode = MD5(tempStr, 16)
Set tRs = Execute("select * from Mesky_Key where RegType = " & tr)
If Not ( And ) Then
If tRs("RegCode") <> RegCode Then
F469e80d32 = "2"
ElseIf tRs("RegKey") <> MD5(RegCode & tr & "F469e80d32", 32) Then
F469e80d32 = "0"
ElseIf tRs("RegCode") = RegCode And tRs("RegKey") = MD5(RegCode & tr & "F469e80d32", 32) Then
F469e80d32 = "1"
End If
End If
Set tRs = Nothing
End Function
Public Function C0559f8d32(tr)
C0559f8d32 = 0
End Function
Public Function F469e88d32(tr)
F469e88d32 = 0
End Function
Public Function Execute(Command)
If Not IsObject(Conn) Then ConnectionDatabase
'Check permissions to prevent injection attacks.
'If InStr(LCase(Command),"Mesky_SiteManager")>0 And Left(ScriptName,6)<> "Mesky_SiteManager" Then
'If savelog=1 Then
' SaveSQLLOG(Command,"")
'End If
'Command=Replace(LCase(Command),"Mesky_SiteManager","Mesky<i>"&Chr(95)&"</i>SiteManager")
'End If
If IsDeBug = 0 Then
On Error Resume Next
Set Execute = (Command)
If Err Then
Set Conn = Nothing
If savelog = 1 Then
SaveSQLLOG(Command, "After querying data, please check whether your query code is correct. <br>For security reasons, only this information is displayed. To view detailed error information, please modify your program file. Change ""Const IsDeBug = 0"" to: ""Const IsDeBug = 1""")
Else
"When querying the data, you find an error. Please check whether your query code is correct."
End If
End If
Else
' Command & "<br>"
Set Execute = (Command)
End If
SqlQueryNum = SqlQueryNum + 1
End Function
'---------------------------------------------------------------------
'Time formatting
'Parameters: time, format template
'Return: Formatted string
'Note: Detailed explanation of formatted keywords:
' "{Y}": 4 years
' "{y}": 2 years
' "{M}" : Months that do not fill up
' "{m}" : The month of replacement, such as 03,01
' "{D}" : The day without replacement
' "{d}" : The day of replacement
' "{H}" : Hours without replacement
' "{h}": The hour of replacement
' "{MI}": Minutes not to fill up
' "{mi}": Minutes to fill up
' "{S}" : The seconds without replacement
' "{s}" : Second of replacement
'---------------------------------------------------------------------
Public Function FormatMyDate(myDate, Template)
If Not IsDate(myDate) Or Template = "" Then
FormatMyDate = ""
Exit Function
End If
Dim mYear, mMonth, mDay, mHour, mMin, mSec
mYear = Year(myDate)
mMonth = Month(myDate)
mDay = Day(myDate)
mHour = Hour(myDate)
mMin = Minute(myDate)
mSec = Second(myDate)
FormatMyDate = Template
FormatMyDate = Replace(FormatMyDate, "{Y}", Year(myDate))
FormatMyDate = Replace(FormatMyDate, "{y}", Right(Year(myDate), 2))
FormatMyDate = Replace(FormatMyDate, "{M}", Month(myDate))
FormatMyDate = Replace(FormatMyDate, "{m}", Right("00" & Month(myDate), 2))
FormatMyDate = Replace(FormatMyDate, "{D}", Day(myDate))
FormatMyDate = Replace(FormatMyDate, "{d}", Right("00" & Day(myDate), 2))
FormatMyDate = Replace(FormatMyDate, "{H}", Hour(myDate))
FormatMyDate = Replace(FormatMyDate, "{h}", Right("00" & Hour(myDate), 2))
FormatMyDate = Replace(FormatMyDate, "{MI}", Minute(myDate))
FormatMyDate = Replace(FormatMyDate, "{mi}", Right("00" & Minute(myDate), 2))
FormatMyDate = Replace(FormatMyDate, "{S}", Second(myDate))
FormatMyDate = Replace(FormatMyDate, "{s}", Right("00" & Second(myDate), 2))
If FormatDateTime(myDate, 1) = FormatDateTime(Date, 1) Then
FormatMyDate = "<font color=red>" & FormatMyDate & "</font>"
End If
'Template = Null
End Function
Rem Judge whether the speech comes from outside
Public Function ChkPost()
Dim server_v1, server_v2
ChkPost = False
server_v1 = CStr(("HTTP_REFERER"))
server_v2 = CStr(("SERVER_NAME"))
If Mid(server_v1, 8, Len(server_v2)) <> server_v2 Then
ChkPost = False
Else
ChkPost = True
End If
End Function
'Filtering SQL illegal characters
Public Function checkStr(str)
If IsNull(str) Then
checkStr = ""
Exit Function
End If
str = Replace(str, Chr(0), "")
checkStr = Replace(str, "'", "''")
End Function
'Show verification code
Public Function GetCode()
Dim test
On Error Resume Next
'Set test = ("")
'Set test = Nothing
If Err Then
Dim zNum
Randomize Timer
zNum = CInt(8999 * Rnd + 1000)
Session("GetCode") = zNum
GetCode = "<input type=""text"" name=""codestr"" maxlength=""4"" size=""4""> " & Session("GetCode")
Else
GetCode = "<input type=""text"" name=""codestr"" maxlength=""4"" size=""4""> <img src="""">"
End If
End Function
'Check whether the verification code is correct
Public Function CodeIsTrue()
Dim CodeStr
CodeStr = Trim(Request("CodeStr"))
If CStr(Session("GetCode")) = CStr(CodeStr) And CodeStr <> "" Then
CodeIsTrue = True
Session("GetCode") = Empty
Else
CodeIsTrue = False
Session("GetCode") = Empty
End If
End Function
'The system allocates random passwords
Public Function Createpass()
Dim Ran, i, LengthNum
LengthNum = 16
Createpass = ""
For i = 1 To LengthNum
Randomize
Ran = CInt(Rnd * 2)
Randomize
If Ran = 0 Then
Ran = CInt(Rnd * 25) + 97
Createpass = Createpass & UCase(Chr(Ran))
ElseIf Ran = 1 Then
Ran = CInt(Rnd * 9)
Createpass = Createpass & Ran
ElseIf Ran = 2 Then
Ran = CInt(Rnd * 25) + 97
Createpass = Createpass & Chr(Ran)
End If
Next
End Function
'//Take the text content from the HTML tag
Public Function GetTextFromHtml(strHtml)
strHtml = Replace(Replace(Replace(Replace(strHtml, "<br>", vbCrLf), "<BR>", vbCrLf), "</p>", vbCrLf & vbCrLf), "</P>", vbCrLf & vbCrLf)
Dim strPatrn
strPatrn = "<.*?>"
Dim regEx
Set regEx = New RegExp
= strPatrn
= True
= True
GetTextFromHtml = (strHtml, "")
Set regEx = Nothing
End Function
'//Detection of Email
'//Return:True/False
Public Function CheckEmail(strng)
CheckEmail = False
Dim regEx, Match
Set regEx = New RegExp
= "^\w+((-\w+)|(\.\w+))*\@[A-Za-z0-9]+((\.|-)[A-Za-z0-9]+)*\.[A-Za-z0-9]+$"
= True
Set Match = (strng)
If Then CheckEmail = True
Set Match = Nothing
Set regEx = Nothing
End Function
'//Is the string in [0-9]&[a-z] and underscore (case insensitive)
'//Return:True/False
Public Function IsChar26AndInt(str)
IsChar26AndInt = True
Dim regEx, Match
Set regEx = New RegExp
= "[\W]{1,}?"
= True
Set Match = (str)
If >= 1 Then
IsChar26AndInt = False
End If
Set Match = Nothing
Set regEx = Nothing
End Function
'//Is the string in [a-z] (case insensitive)
'//Return:True/False
Public Function IsChar26(str)
IsChar26 = True
Dim regEx, Match
Set regEx = New RegExp
= "[^a-zA-Z]{1,}?"
= True
Set Match = (str)
If >= 1 Then
IsChar26 = False
End If
Set Match = Nothing
Set regEx = Nothing
End Function
'//Is the string in [0-9] (case insensitive)
Public Function IsIntChar(str)
IsIntChar = True
Dim regEx, Match
Set regEx = New RegExp
= "\D{1,}?"
= True
Set Match = (str)
If >= 1 Then
IsIntChar = False
End If
Set Match = Nothing
Set regEx = Nothing
End Function
'//Html string to Js string
Public Function HTMLToJS(strHtml)
If Trim(strHtml) = "" Then
HTMLToJS = ""
Exit Function
End If
strHtml = Replace(strHtml, "\", "\\")
strHtml = Replace(strHtml, """", "\""")
strHtml = Replace(strHtml, vbCrLf, "")
HTMLToJS = strHtml
End Function
'//Convert the Html key tag to the Html special string
Public Function HTMLEncode(str)
If Not IsNull(str) Then
str = Replace(str, Chr(13), "")
str = Replace(str, Chr(10) & Chr(10), "<P></P>")
str = Replace(str, Chr(10), "<BR>")
str = Replace(str, ">", ">")
str = Replace(str, "<", "<")
str = Replace(str, "&", "&")
str = Replace(str, " ", " ")
str = Replace(str, """", """)
HTMLEncode = str
str = Null
End If
End Function
Public Function HTMLEncode1(str)
If Not IsNull(str) Then
str = Replace(str, Chr(32) & Chr(32) & Chr(32), " ")
str = Replace(str, Chr(13), "")
str = Replace(str, Chr(10) & Chr(10), "<br>")
str = Replace(str, Chr(10), "<br>")
HTMLEncode1 = str
str = Null
End If
End Function
Function HTMLToData(str)
If IsNull(str) Then
HTMLToData = ""
Exit Function
End If
str = Replace(str, "&", "&")
str = Replace(str, Chr(13),"
")'Carriage return
str = Replace(str, Chr(10), "
") 'Line Newline
str = Replace(str, Chr(9),"	")'Tab
str = Replace(str, "'", "'")'Single quotes
str = Replace(str, """", """) 'Double quotes
str = Replace(str, "<", "<")
str = Replace(str, ">", ">")
HTMLToData = str
str = Null
End Function
'//Convert the Html key tag to Html special string (not converting hard carriage return and soft carriage return characters)
Public Function HTMLEncode2(str)
If Not IsNull(str) Then
str = Replace(str, ">", ">")
str = Replace(str, "<", "<")
'str = replace(str, "&", "&")
'str = replace(str, " ", " ")
'str = replace(str, """", """)
HTMLEncode2 = str
str = Null
End If
End Function
'//Function: String replacement
'//Article: Regular expression, replaced string, replaced string
Public Function ReplaceTest(patrn, mStr, replStr)
Dim regEx
Set regEx = New RegExp
= patrn
= True
= True
ReplaceTest = (mStr, replStr)
Set regEx = Nothing
End Function
'//Function: String search
'//Article: Regular expression, replaced string, replaced string
'//Return: Bool(True: Found)
Public Function FindText(patrn, mStr)
Dim regEx
Set regEx = New RegExp
= patrn
= True
= True
FindText = (mStr)
Set regEx = Nothing
End Function
'//Detection whether there is a prohibited string
'// Parameters: detected character string, prohibited character list (separated by number)
'//Return: True (with prohibited characters)/False
'//Example: ("You fuck bastard, Fuck You","fuck you, bastard, you are pig")
Public Function BadWord(str, BadWordList)
BadWord = False
Dim arrBadWord
arrBadWord = Split(BadWordList, ",", -1, 1)
Dim regEx
Set regEx = New RegExp
= True 'Case insensitive
= True
Dim Match
Dim i
For i = 0 To UBound(arrBadWord)
arrBadWord(i) & "<br>"
If arrBadWord(i) <> "" Then
= arrBadWord(i)
Set Match = (str)
If Then
BadWord = True
Exit For
End If
End If
Next
End Function
'Keyword coloring
Public Function KeywordColor(str, Keyword)
KeywordColor = ReplaceTest(Keyword, str, "<font color=red>" & Keyword & "</font>")
End Function
'Get the first character in the character
'Return: A-Z ;123 ;###
Public Function GetSpellChar(str)
Dim tmp
GetSpellChar = "@"
tmp = 65536 + Asc(str)
If (tmp >= 45217 And tmp <= 45252) Or (tmp = 65601) Or (tmp = 65633) Or (tmp = 37083) Then
GetSpellChar = "A1"
ElseIf (tmp >= 45253 And tmp <= 45760) Or (tmp = 65602) Or (tmp = 65634) Or (tmp = 39658) Then
GetSpellChar = "B1"
ElseIf (tmp >= 45761 And tmp <= 46317) Or (tmp = 65603) Or (tmp = 65635) Or (tmp = 33405) Then
GetSpellChar = "C1"
ElseIf (tmp >= 46318 And tmp <= 46930) Or (tmp = 61884) Or (tmp = 63468) Or (tmp = 65604) Or (tmp >= 36820 And tmp <= 38524) Or (tmp = 65636) Then
GetSpellChar = "D1"
ElseIf (tmp >= 46931 And tmp <= 47009) Or (tmp >= 46827 And tmp <= 46842) Or (tmp = 65605) Or (tmp = 65637) Or (tmp = 61513) Then '46827 46833 46842
GetSpellChar = "E1"
ElseIf (tmp >= 47010 And tmp <= 47296) Or (tmp = 65606) Or (tmp = 65638) Or (tmp = 61320) Or (tmp = 63568) Or (tmp = 36281) Then
GetSpellChar = "F1"
ElseIf (tmp >= 47297 And tmp <= 47613) Or (tmp = 65607) Or (tmp = 65639) Or (tmp = 35949) Or (tmp = 36089) Or (tmp = 36694) Or (tmp = 34808) Then
GetSpellChar = "G1"
ElseIf (tmp >= 47614 And tmp <= 48118) Or (tmp = 59112) Or (tmp = 40296) Or (tmp = 65608) Or (tmp = 65640) Then
GetSpellChar = "H1"
ElseIf (tmp = 65641) Or (tmp = 65609) Or (tmp = 65641) Then
GetSpellChar = "I1"
ElseIf (tmp >= 48119 And tmp <= 49061 And tmp <> 48739) Or (tmp >= 62430 And tmp <= 62430) Or (tmp = 65610) Or (tmp = 65642) Or (tmp = 39048) Then
GetSpellChar = "J1"
ElseIf (tmp >= 49062 And tmp <= 49323) Or (tmp = 65611) Or (tmp = 65643) Then
GetSpellChar = "K1"
ElseIf (tmp >= 49324 And tmp <= 49895) Or (tmp >= 58838 And tmp <= 58838) Or (tmp = 65612) Or (tmp = 65644) Or (tmp = 62418) Or (tmp = 48739) Then
GetSpellChar = "L1"
ElseIf (tmp >= 49896 And tmp <= 50370) Or (tmp = 63432) Or (tmp = 65613) Or (tmp = 65645) Then
GetSpellChar = "M1"
ElseIf (tmp >= 50371 And tmp <= 50613) Or (tmp = 65614) Or (tmp = 65646) Then
GetSpellChar = "N1"
ElseIf (tmp >= 50614 And tmp <= 50621) Or (tmp = 65615) Or (tmp = 65615) Or (tmp = 65647) Then
GetSpellChar = "O1"
ElseIf (tmp >= 50622 And tmp <= 50905) Or (tmp = 65616) Or (tmp = 65648) Then
GetSpellChar = "P1"
ElseIf (tmp >= 50906 And tmp <= 51386) Or (tmp >= 62659 And tmp <= 63172) Or (tmp = 63464) Or (tmp = 63226) Or (tmp = 65617) Or (tmp = 65649) Then
GetSpellChar = "Q1"
ElseIf (tmp >= 51387 And tmp <= 51445) Or (tmp = 65618) Or (tmp = 65650) Then
GetSpellChar = "R1"
ElseIf (tmp >= 51446 And tmp <= 52217) Or (tmp = 65619) Or (tmp = 65651) Or (tmp = 34009) Then
GetSpellChar = "S1"
ElseIf (tmp >= 52218 And tmp <= 52697) Or (tmp = 65620) Or (tmp = 65652) Then
GetSpellChar = "T1"
ElseIf (tmp = 65621) Or (tmp = 65653) Then
GetSpellChar = "U1"
ElseIf (tmp = 65622) Or (tmp = 65654) Then
GetSpellChar = "V1"
ElseIf (tmp >= 52698 And tmp <= 52979) Or (tmp = 65623) Or (tmp = 65655) Then
GetSpellChar = "W1"
ElseIf (tmp >= 52980 And tmp <= 53688) Or (tmp = 63182) Or (tmp = 65624) Or (tmp = 65656) Then
GetSpellChar = "X1"
ElseIf (tmp >= 53689 And tmp <= 54480) Or (tmp = 65625) Or (tmp = 65657) Then
GetSpellChar = "Y1"
ElseIf (tmp >= 54481 And tmp <= 62383 And tmp <> 59112 And tmp <> 58838 And tmp <> 57566) Or (tmp = 65626) Or (tmp = 65658) Or (tmp = 38395) Or (tmp = 39783) Then
GetSpellChar = "Z1"
End If
If (tmp >= 65601 And tmp <= 65658) Then GetSpellChar = UCase(Left(Trim(str), 1)) 'Letter
If (tmp >= 65584 And tmp <= 65593) Then GetSpellChar = "123" 'Number
'(tmp)
End Function
Previous page123Next pageRead the full text