SoFunction
Updated on 2025-04-14

Parameters of pjblog2


'*************************************
'Cut contents - Segment by character
'*************************************
Function CutStr(byVal Str,byVal StrLen)
    Dim l,t,c,i
    If IsNull(Str) Then CutStr="":Exit Function
    l=Len(str)
    StrLen=int(StrLen)
    t=0
    For i=1 To l
        c=Asc(Mid(str,i,1))
        If c<0 Or c>255 Then t=t+2 Else t=t+1
        IF t>=StrLen Then
            CutStr=left(Str,i)&"..."
            Exit For
        Else
            CutStr=Str
        End If
    Next
End Function

'*************************************
'Trackback Function
'*************************************
Function Trackback(trackback_url, url, title, excerpt, blog_name) 
    Dim query_string, objXMLHTTP

    query_string = "title="&cutStr((title),100)&"&url="&(url)&"&blog_name="&(blog_name)&"&excerpt="&cutStr((excerpt), 252)
    Set objXMLHTTP = (getXMLHTTP)

     "POST", trackback_url, false
     "Content-Type","application/x-www-Form-urlencoded"

    'HAndling timeout
    On Error Resume Next
     query_string
    

    Set objXMLHTTP = Nothing
End Function


'*************************************
'Delete the reference tag
'*************************************
Function DelQuote(strContent)
    If IsNull(strContent) Then Exit Function
    Dim re
    Set re=new RegExp
     =True
    =True
    ="\[quote\](.[^\]]*?)\[\/quote\]"
    strContent= (strContent,"")
    ="\[quote=(.[^\]]*)\](.[^\]]*?)\[\/quote\]"
    strContent= (strContent,"")
    Set re=Nothing
    DelQuote=strContent
End Function

'*************************************
'Get client IP
'*************************************
function getIP() 
         dim strIP,IP_Ary,strIP_list
         strIP_list=Replace(("HTTP_X_FORWARDED_FOR"),"'","")

         If InStr(strIP_list,",")<>0 Then
            IP_Ary = Split(strIP_list,",")
            strIP = IP_Ary(0)
         Else
            strIP = strIP_list
         End IF

         If strIP=Empty Then strIP=Replace(("REMOTE_ADDR"),"'","")
         getIP=strIP
End Function


'*************************************
'Get client browser information
'*************************************
function getBrowser(strUA) 
 dim arrInfo,strType,temp1,temp2
 strType=""
 strUA=LCase(strUA)
 arrInfo=Array("Unkown","Unkown")
'Browser judgment
    if Instr(strUA,"mozilla")>0 then arrInfo(0)="Mozilla"
    if Instr(strUA,"icab")>0 then arrInfo(0)="iCab"
    if Instr(strUA,"lynx")>0 then arrInfo(0)="Lynx"
    if Instr(strUA,"links")>0 then arrInfo(0)="Links"
    if Instr(strUA,"elinks")>0 then arrInfo(0)="ELinks"
    if Instr(strUA,"jbrowser")>0 then arrInfo(0)="JBrowser"
    if Instr(strUA,"konqueror")>0 then arrInfo(0)="konqueror"
    if Instr(strUA,"wget")>0 then arrInfo(0)="wget"
    if Instr(strUA,"ask jeeves")>0 or Instr(strUA,"teoma")>0 then arrInfo(0)="Ask Jeeves/Teoma"
    if Instr(strUA,"wget")>0 then arrInfo(0)="wget"
    if Instr(strUA,"opera")>0 then arrInfo(0)="opera"

    if Instr(strUA,"gecko")>0 then 
      strType="[Gecko]"
      arrInfo(0)="Mozilla"
      if Instr(strUA,"aol")>0 then arrInfo(0)="AOL"
      if Instr(strUA,"netscape")>0 then arrInfo(0)="Netscape"
      if Instr(strUA,"firefox")>0 then arrInfo(0)="FireFox"
      if Instr(strUA,"chimera")>0 then arrInfo(0)="Chimera"
      if Instr(strUA,"camino")>0 then arrInfo(0)="Camino"
      if Instr(strUA,"galeon")>0 then arrInfo(0)="Galeon"
      if Instr(strUA,"k-meleon")>0 then arrInfo(0)="K-Meleon"
      arrInfo(0)=arrInfo(0)+strType
   end if

   if Instr(strUA,"bot")>0 or Instr(strUA,"crawl")>0 then 
      strType="[Bot/Crawler]"
      arrInfo(0)=""
      if Instr(strUA,"grub")>0 then arrInfo(0)="Grub"
      if Instr(strUA,"googlebot")>0 then arrInfo(0)="GoogleBot"
      if Instr(strUA,"msnbot")>0 then arrInfo(0)="MSN Bot"
      if Instr(strUA,"slurp")>0 then arrInfo(0)="Yahoo! Slurp"
      arrInfo(0)=arrInfo(0)+strType
  end if

  if Instr(strUA,"applewebkit")>0 then 
      strType="[AppleWebKit]"
      arrInfo(0)=""
      if Instr(strUA,"omniweb")>0 then arrInfo(0)="OmniWeb"
      if Instr(strUA,"safari")>0 then arrInfo(0)="Safari"
      arrInfo(0)=arrInfo(0)+strType
  end if 

  if Instr(strUA,"msie")>0 then 
      strType="[MSIE"
      temp1=mid(strUA,(Instr(strUA,"msie")+4),6)
      temp2=Instr(temp1,";")
      temp1=left(temp1,temp2-1)
      strType=strType & temp1 &"]"
      arrInfo(0)="Internet Explorer"
      if Instr(strUA,"msn")>0 then arrInfo(0)="MSN"
      if Instr(strUA,"aol")>0 then arrInfo(0)="AOL"
      if Instr(strUA,"webtv")>0 then arrInfo(0)="WebTV"
      if Instr(strUA,"myie2")>0 then arrInfo(0)="MyIE2"
      if Instr(strUA,"maxthon")>0 then arrInfo(0)="Maxthon"
      if Instr(strUA,"gosurf")>0 then arrInfo(0)="GoSurf"
      if Instr(strUA,"netcaptor")>0 then arrInfo(0)="NetCaptor"
      if Instr(strUA,"sleipnir")>0 then arrInfo(0)="Sleipnir"
      if Instr(strUA,"avant browser")>0 then arrInfo(0)="AvantBrowser"
      if Instr(strUA,"greenbrowser")>0 then arrInfo(0)="GreenBrowser"
      if Instr(strUA,"slimbrowser")>0 then arrInfo(0)="SlimBrowser"
      arrInfo(0)=arrInfo(0)+strType
   end if

'Operating system judgment
    if Instr(strUA,"windows")>0 then arrInfo(1)="Windows"
    if Instr(strUA,"windows ce")>0 then arrInfo(1)="Windows CE"
    if Instr(strUA,"windows 95")>0 then arrInfo(1)="Windows 95"
    if Instr(strUA,"win98")>0 then arrInfo(1)="Windows 98"
    if Instr(strUA,"windows 98")>0 then arrInfo(1)="Windows 98"
    if Instr(strUA,"windows 2000")>0 then arrInfo(1)="Windows 2000"
    if Instr(strUA,"windows xp")>0 then arrInfo(1)="Windows XP"

    if Instr(strUA,"windows nt")>0 then
      arrInfo(1)="Windows NT"
      if Instr(strUA,"windows nt 5.0")>0 then arrInfo(1)="Windows 2000"
      if Instr(strUA,"windows nt 5.1")>0 then arrInfo(1)="Windows XP"
      if Instr(strUA,"windows nt 5.2")>0 then arrInfo(1)="Windows 2003"
    end if
    if Instr(strUA,"x11")>0 or Instr(strUA,"unix")>0 then arrInfo(1)="Unix"
    if Instr(strUA,"sunos")>0 or Instr(strUA,"sun os")>0 then arrInfo(1)="SUN OS"
    if Instr(strUA,"powerpc")>0 or Instr(strUA,"ppc")>0 then arrInfo(1)="PowerPC"
    if Instr(strUA,"macintosh")>0 then arrInfo(1)="Mac"
    if Instr(strUA,"mac osx")>0 then arrInfo(1)="MacOSX"
    if Instr(strUA,"freebsd")>0 then arrInfo(1)="FreeBSD"
    if Instr(strUA,"linux")>0 then arrInfo(1)="Linux"
    if Instr(strUA,"palmsource")>0 or Instr(strUA,"palmos")>0 then arrInfo(1)="PalmOS"
    if Instr(strUA,"wap ")>0 then arrInfo(1)="WAP"

 'arrInfo(0)=strUA 
 getBrowser=arrInfo
end function

'*************************************
'Computing random numbers
'*************************************
function randomStr(intLength)
    dim strSeed,seedLength,pos,str,i
    strSeed = "abcdefghijklmnopqrstuvwxyz1234567890"
    seedLength=len(strSeed)
    str=""
    Randomize
    for i=1 to intLength
     str=str+mid(strSeed,int(seedLength*rnd)+1,1)
    next
    randomStr=str
end function

'*************************************
'Automatically closed UBB
'*************************************
function closeUBB(strContent)
  dim arrTags,i,OpenPos,ClosePos,re,strMatchs,j,Match
    Set re=new RegExp
     =True
    =True
    arrTags=array("code","quote","list","color","align","font","size","b","i","u","html")
  for i=0 to ubound(arrTags)
   OpenPos=0
   ClosePos=0

   ="\["+arrTags(i)+"(=[^\[\]]+|)\]"
   Set strMatchs=(strContent)
   For Each Match in strMatchs
    OpenPos=OpenPos+1
   next
   ="\[/"+arrTags(i)+"\]"
   Set strMatchs=(strContent)
   For Each Match in strMatchs
    ClosePos=ClosePos+1
   next
   for j=1 to OpenPos-ClosePos
      strContent=strContent+"[/"+arrTags(i)+"]"
   next
  next
closeUBB=strContent
end function

'*************************************
'Automatically close HTML
'*************************************
function closeHTML(strContent)
  dim arrTags,i,OpenPos,ClosePos,re,strMatchs,j,Match
    Set re=new RegExp
     =True
    =True
    arrTags=array("p","div","span","table","ul","font","b","u","i","h1","h2","h3","h4","h5","h6")
  for i=0 to ubound(arrTags)
   OpenPos=0
   ClosePos=0

   ="\<"+arrTags(i)+"( [^\<\>]+|)\>"
   Set strMatchs=(strContent)
   For Each Match in strMatchs
    OpenPos=OpenPos+1
   next
   ="\</"+arrTags(i)+"\>"
   Set strMatchs=(strContent)
   For Each Match in strMatchs
    ClosePos=ClosePos+1
   next
   for j=1 to OpenPos-ClosePos
      strContent=strContent+"</"+arrTags(i)+">"
   next
  next
closeHTML=strContent
end function

'*************************************
'Read the file
'*************************************
Function LoadFromFile(ByVal File)
    Dim objStream
    Dim RText
    RText=array(0,"")
    On Error Resume Next
    Set objStream = ("")
    If Err Then 
        RText=array(,)
        LoadFromFile=RText
        
        exit function
    End If
    With objStream
        .Type = 2
        .Mode = 3
        .Open
        .Charset = "utf-8"
        .Position = 
        .LoadFromFile (File)
        If <>0 Then
           RText=array(,)
           LoadFromFile=RText
           
           exit function
        End If
        RText=array(0,.ReadText)
        .Close
    End With
    LoadFromFile=RText
    Set objStream = Nothing
End Function

'*************************************
'Save the file
'*************************************
Function SaveToFile(ByVal strBody,ByVal File)
    Dim objStream
    Dim RText
    RText=array(0,"")
    On Error Resume Next
    Set objStream = ("")
    If Err Then 
        RText=array(,)
        
        exit function
    End If
    With objStream
        .Type = 2
        .Open
        .Charset = "utf-8"
        .Position = 
        .WriteText = strBody
        .SaveToFile (File),2
        .Close
    End With
RText=array(0,"Save the file successfully!")
    SaveToFile=RText
    Set objStream = Nothing
End Function

'*************************************
'Domain addition modification operation
'*************************************
function DBQuest(table,DBArray,Action)
 dim AddCount,TempDB,i,v
 if Action<>"insert" or Action<>"update" then Action="insert"
 if Action="insert" then v=2 else v=3
 if not IsArray(DBArray) then
   DBQuest=-1
   exit function
 else
   Set TempDB=("")
   On Error Resume Next
    table,Conn,1,v
   if err then
    DBQuest=-2
    exit function
   end if
   if Action="insert" then 
   AddCount=UBound(DBArray,1)
   for i=0 to AddCount
    TempDB(DBArray(i)(0))=DBArray(i)(1)
   next
   
   
   set TempDB=nothing
   DBQuest=0
 end if
end Function

'*************************************
'Check whether the system components are installed
'*************************************
Function CheckObjInstalled(strClassString)
    On Error Resume Next
    Dim Temp
    Err = 0
    Dim TmpObj
    Set TmpObj = (strClassString)
    Temp = Err
    IF Temp = 0 OR Temp = -2147221477 Then
        CheckObjInstalled=true
    ElseIF Temp = 1 OR Temp = -2147221005 Then
        CheckObjInstalled=false
    End IF
    
    Set TmpObj = Nothing
    Err = 0
End Function

'*************************************
'Judge the server
'*************************************
Function getXMLDOM
    On Error Resume Next
    Dim Temp
    getXMLDOM=""
    Err = 0
    Dim TmpObj
    Set TmpObj = (getXMLDOM)
    Temp = Err
    IF Temp = 1 OR Temp = -2147221005 Then
        getXMLDOM=".5.0"
    End IF
    
    Set TmpObj = Nothing
    Err = 0
end function

'*************************************
'Judge the server
'*************************************
Function getXMLHTTP
    On Error Resume Next
    Dim Temp
    getXMLHTTP=""
    Err = 0
    Dim TmpObj
    Set TmpObj = (getXMLHTTP)
    Temp = Err
    IF Temp = 1 OR Temp = -2147221005 Then
        getXMLHTTP=".5.0"
    End IF
    
    Set TmpObj = Nothing
    Err = 0
end function

'*************************************
'Check whether the plugin is installed successfully
'*************************************
Function Checkplugins 
   Dim PlugS,Plug,PlugItem
   Checkplugins=-1
    PlugS=Split(function_Plugin,"$*$")
    For Each Plug In PlugS
      PlugItem = Split(Plug,"%|%")
      If Getplugins=PlugItem(0) Then 
        Checkplugins=PlugItem
        Exit Function
      End If
    Next
End Function 

'*************************************
'Show help information
'*************************************
sub showmsg(title,des,icon,showType)
 on error resume next
 
 set Conn=nothing
 
 session(CookieName&"_ShowMsg")=true
 session(CookieName&"_title")=title
 session(CookieName&"_des")=des
 session(CookieName&"_icon")=icon
'icon type
 'MessageIcon
 'ErrorIcon
 'WarningIcon
 'QuestionIcon
 if showType="plugins" then
   ("../../")
 else
   ("")
 end if
end sub

'*************************************
'Garbage keyword filtering
'*************************************
function filterSpam(str,path)
  on error resume next
     filterSpam = false
     dim spamXml,spamItem
     Set spamXml = (getXMLDOM)
       If Err Then  
           
           exit function
       end if
      = false  
     ((path))
     if =0 then
       For Each spamItem in ("//key")
               if InStr(Lcase(str),Lcase())<>0 then
                  filterSpam = true
                  exit function
               end if
       next
     end if
     set spamXml=nothing
end function

%> p;   if Instr(strUA,"links")>0 then arrInfo(0)="Links"
    if Instr(strUA,"elinks")>0 then arrInfo(0)="ELinks"
    if Instr(strUA,"jbrowser")>0 then arrInfo(0)="JBrowser"
    if Instr(strUA,"konqueror")>0 then arrInfo(0)="konqueror"
    if Instr(strUA,"wget")>0 then arrInfo(0)="wget"
    if Instr(strUA,"ask jeeves")>0 or Instr(strUA,"teoma")>0 then arrInfo(0)="Ask Jeeves/Teoma"
    if Instr(strUA,"wget")>0 then arrInfo(0)="wget"
    if Instr(strUA,"opera")>0 then arrInfo(0)="opera"

    if Instr(strUA,"gecko")>0 then 
      strType="[Gecko]"
      arrInfo(0)="Mozilla"
      if Instr(strUA,"aol")>0 then arrInfo(0)="AOL"
      if Instr(strUA,"netscape")>0 then arrInfo(0)="Netscape"
      if Instr(strUA,"firefox")>0 then arrInfo(0)="FireFox"
      if Instr(strUA,"chimera")>0 then arrInfo(0)="Chimera"
      if Instr(strUA,"camino")>0 then arrInfo(0)="Camino"
      if Instr(strUA,"galeon")>0 then arrInfo(0)="Galeon"
      if Instr(strUA,"k-meleon")>0 then arrInfo(0)="K-Meleon"
      arrInfo(0)=arrInfo(0)+strType
   end if

   if Instr(strUA,"bot")>0 or Instr(strUA,"crawl")>0 then 
      strType="[Bot/Crawler]"
      arrInfo(0)=""
      if Instr(strUA,"grub")>0 then arrInfo(0)="Grub"
      if Instr(strUA,"googlebot")>0 then arrInfo(0)="GoogleBot"
      if Instr(strUA,"msnbot")>0 then arrInfo(0)="MSN Bot"
      if Instr(strUA,"slurp")>0 then arrInfo(0)="Yahoo! Slurp"
      arrInfo(0)=arrInfo(0)+strType
  end if

  if Instr(strUA,"applewebkit")>0 then 
      strType="[AppleWebKit]"
      arrInfo(0)=""
      if Instr(strUA,"omniweb")>0 then arrInfo(0)="OmniWeb"
      if Instr(strUA,"safari")>0 then arrInfo(0)="Safari"
      arrInfo(0)=arrInfo(0)+strType
  end if 

  if Instr(strUA,"msie")>0 then 
      strType="[MSIE"
      temp1=mid(strUA,(Instr(strUA,"msie")+4),6)
      temp2=Instr(temp1,";")
      temp1=left(temp1,temp2-1)
      strType=strType & temp1 &"]"
      arrInfo(0)="Internet Explorer"
      if Instr(strUA,"msn")>0 then arrInfo(0)="MSN"
      if Instr(strUA,"aol")>0 then arrInfo(0)="AOL"
      if Instr(strUA,"webtv")>0 then arrInfo(0)="WebTV"
      if Instr(strUA,"myie2")>0 then arrInfo(0)="MyIE2"
      if Instr(strUA,"maxthon")>0 then arrInfo(0)="Maxthon"
      if Instr(strUA,"gosurf")>0 then arrInfo(0)="GoSurf"
      if Instr(strUA,"netcaptor")>0 then arrInfo(0)="NetCaptor"
      if Instr(strUA,"sleipnir")>0 then arrInfo(0)="Sleipnir"
      if Instr(strUA,"avant browser")>0 then arrInfo(0)="AvantBrowser"
      if Instr(strUA,"greenbrowser")>0 then arrInfo(0)="GreenBrowser"
      if Instr(strUA,"slimbrowser")>0 then arrInfo(0)="SlimBrowser"
      arrInfo(0)=arrInfo(0)+strType
   end if

'Operating system judgment
    if Instr(strUA,"windows")>0 then arrInfo(1)="Windows"
    if Instr(strUA,"windows ce")>0 then arrInfo(1)="Windows CE"
    if Instr(strUA,"windows 95")>0 then arrInfo(1)="Windows 95"
    if Instr(strUA,"win98")>0 then arrInfo(1)="Windows 98"
    if Instr(strUA,"windows 98")>0 then arrInfo(1)="Windows 98"
    if Instr(strUA,"windows 2000")>0 then arrInfo(1)="Windows 2000"
    if Instr(strUA,"windows xp")>0 then arrInfo(1)="Windows XP"

    if Instr(strUA,"windows nt")>0 then
      arrInfo(1)="Windows NT"
      if Instr(strUA,"windows nt 5.0")>0 then arrInfo(1)="Windows 2000"
      if Instr(strUA,"windows nt 5.1")>0 then arrInfo(1)="Windows XP"
      if Instr(strUA,"windows nt 5.2")>0 then arrInfo(1)="Windows 2003"
    end if
    if Instr(strUA,"x11")>0 or Instr(strUA,"unix")>0 then arrInfo(1)="Unix"
    if Instr(strUA,"sunos")>0 or Instr(strUA,"sun os")>0 then arrInfo(1)="SUN OS"
    if Instr(strUA,"powerpc")>0 or Instr(strUA,"ppc")>0 then arrInfo(1)="PowerPC"
    if Instr(strUA,"macintosh")>0 then arrInfo(1)="Mac"
    if Instr(strUA,"mac osx")>0 then arrInfo(1)="MacOSX"
    if Instr(strUA,"freebsd")>0 then arrInfo(1)="FreeBSD"
    if Instr(strUA,"linux")>0 then arrInfo(1)="Linux"
    if Instr(strUA,"palmsource")>0 or Instr(strUA,"palmos")>0 then arrInfo(1)="PalmOS"
    if Instr(strUA,"wap ")>0 then arrInfo(1)="WAP"

 'arrInfo(0)=strUA 
 getBrowser=arrInfo
end function

'*************************************
'Computing random numbers
'*************************************
function randomStr(intLength)
    dim strSeed,seedLength,pos,str,i
    strSeed = "abcdefghijklmnopqrstuvwxyz1234567890"
    seedLength=len(strSeed)
    str=""
    Randomize
    for i=1 to intLength
     str=str+mid(strSeed,int(seedLength*rnd)+1,1)
    next
    randomStr=str
end function

'*************************************
'Automatically closed UBB
'*************************************
function closeUBB(strContent)
  dim arrTags,i,OpenPos,ClosePos,re,strMatchs,j,Match
    Set re=new RegExp
     =True
    =True
    arrTags=array("code","quote","list","color","align","font","size","b","i","u","html")
  for i=0 to ubound(arrTags)
   OpenPos=0
   ClosePos=0

   ="\["+arrTags(i)+"(=[^\[\]]+|)\]"
   Set strMatchs=(strContent)
   For Each Match in strMatchs
    OpenPos=OpenPos+1
   next
   ="\[/"+arrTags(i)+"\]"
   Set strMatchs=(strContent)
   For Each Match in strMatchs
    ClosePos=ClosePos+1
   next
   for j=1 to OpenPos-ClosePos
      strContent=strContent+"[/"+arrTags(i)+"]"
   next
  next
closeUBB=strContent
end function

'*************************************
'Automatically close HTML
'*************************************
function closeHTML(strContent)
  dim arrTags,i,OpenPos,ClosePos,re,strMatchs,j,Match
    Set re=new RegExp
     =True
    =True
    arrTags=array("p","div","span","table","ul","font","b","u","i","h1","h2","h3","h4","h5","h6")
  for i=0 to ubound(arrTags)
   OpenPos=0
   ClosePos=0

   ="\<"+arrTags(i)+"( [^\<\>]+|)\>"
   Set strMatchs=(strContent)
   For Each Match in strMatchs
    OpenPos=OpenPos+1
   next
   ="\</"+arrTags(i)+"\>"
   Set strMatchs=(strContent)
   For Each Match in strMatchs
    ClosePos=ClosePos+1
   next
   for j=1 to OpenPos-ClosePos
      strContent=strContent+"</"+arrTags(i)+">"
   next
  next
closeHTML=strContent
end function

'*************************************
'Read the file
'*************************************
Function LoadFromFile(ByVal File)
    Dim objStream
    Dim RText
    RText=array(0,"")
    On Error Resume Next
    Set objStream = ("")
    If Err Then 
        RText=array(,)
        LoadFromFile=RText
        
        exit function
    End If
    With objStream
        .Type = 2
        .Mode = 3
        .Open
        .Charset = "utf-8"
        .Position = 
        .LoadFromFile (File)
        If <>0 Then
           RText=array(,)
           LoadFromFile=RText
           
           exit function
        End If
        RText=array(0,.ReadText)
        .Close
    End With
    LoadFromFile=RText
    Set objStream = Nothing
End Function

'*************************************
'Save the file
'*************************************
Function SaveToFile(ByVal strBody,ByVal File)
    Dim objStream
    Dim RText
    RText=array(0,"")
    On Error Resume Next
    Set objStream = ("")
    If Err Then 
        RText=array(,)
        
        exit function
    End If
    With objStream
        .Type = 2
        .Open
        .Charset = "utf-8"
        .Position = 
        .WriteText = strBody
        .SaveToFile (File),2
        .Close
    End With
RText=array(0,"Save the file successfully!")
    SaveToFile=RText
    Set objStream = Nothing
End Function

'*************************************
'Domain addition modification operation
'*************************************
function DBQuest(table,DBArray,Action)
 dim AddCount,TempDB,i,v
 if Action<>"insert" or Action<>"update" then Action="insert"
 if Action="insert" then v=2 else v=3
 if not IsArray(DBArray) then
   DBQuest=-1
   exit function
 else
   Set TempDB=("")
   On Error Resume Next
    table,Conn,1,v
   if err then
    DBQuest=-2
    exit function
   end if
   if Action="insert" then 
   AddCount=UBound(DBArray,1)
   for i=0 to AddCount
    TempDB(DBArray(i)(0))=DBArray(i)(1)
   next
   
   
   set TempDB=nothing
   DBQuest=0
 end if
end Function

'*************************************
'Check whether the system components are installed
'*************************************
Function CheckObjInstalled(strClassString)
    On Error Resume Next
    Dim Temp
    Err = 0
    Dim TmpObj
    Set TmpObj = (strClassString)
    Temp = Err
    IF Temp = 0 OR Temp = -2147221477 Then
        CheckObjInstalled=true
    ElseIF Temp = 1 OR Temp = -2147221005 Then
        CheckObjInstalled=false
    End IF
    
    Set TmpObj = Nothing
    Err = 0
End Function

'*************************************
'Judge the server
'*************************************
Function getXMLDOM
    On Error Resume Next
    Dim Temp
    getXMLDOM=""
    Err = 0
    Dim TmpObj
    Set TmpObj = (getXMLDOM)
    Temp = Err
    IF Temp = 1 OR Temp = -2147221005 Then
        getXMLDOM=".5.0"
    End IF
    
    Set TmpObj = Nothing
    Err = 0
end function

'*************************************
'Judge the server
'*************************************
Function getXMLHTTP
    On Error Resume Next
    Dim Temp
    getXMLHTTP=""
    Err = 0
    Dim TmpObj
    Set TmpObj = (getXMLHTTP)
    Temp = Err
    IF Temp = 1 OR Temp = -2147221005 Then
        getXMLHTTP=".5.0"
    End IF
    
    Set TmpObj = Nothing
    Err = 0
end function

'*************************************
'Check whether the plugin is installed successfully
'*************************************
Function Checkplugins 
   Dim PlugS,Plug,PlugItem
   Checkplugins=-1
    PlugS=Split(function_Plugin,"$*$")
    For Each Plug In PlugS
      PlugItem = Split(Plug,"%|%")
      If Getplugins=PlugItem(0) Then 
        Checkplugins=PlugItem
        Exit Function
      End If
    Next
End Function 

'*************************************
'Show help information
'*************************************
sub showmsg(title,des,icon,showType)
 on error resume next
 
 set Conn=nothing
 
 session(CookieName&"_ShowMsg")=true
 session(CookieName&"_title")=title
 session(CookieName&"_des")=des
 session(CookieName&"_icon")=icon
'icon type
 'MessageIcon
 'ErrorIcon
 'WarningIcon
 'QuestionIcon
 if showType="plugins" then
   ("../../")
 else
   ("")
 end if
end sub

'*************************************
'Garbage keyword filtering
'*************************************
function filterSpam(str,path)
  on error resume next
     filterSpam = false
     dim spamXml,spamItem
     Set spamXml = (getXMLDOM)
       If Err Then  
           
           exit function
       end if
      = false  
     ((path))
     if =0 then
       For Each spamItem in ("//key")
               if InStr(Lcase(str),Lcase())<>0 then
                  filterSpam = true
                  exit function
               end if
       next
     end if
     set spamXml=nothing
end function

%>