VB使用ADO数据库可以分为有源数据库和无源数据库，即是否使用了DSN数据源，如下例：
1、在连接数据库前首先要在VB菜单中“工程”-“引用”从中选择 microsoft activeX Data objects 2.6 library和 microsoft activeX Data objects recordset 2.6两个组件，这是在连接数据前所必做的工作。
2、接下来定义ADO的连接对象，如下所示：
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
第一种方法采用的是无源的数据库连接方法
conn.ConnectionString = "Driver={sql server};server=JSZX3-11;uid=sa;pwd=;database=wzc"
conn.ConnectionTimeout = 30
conn.Open
rs.Open "select 用户名,密码 from login where 用户名='" & Trim(Combo1.Text) & "' And 密码='" & Trim(Text1.Text) & "'", conn, adOpenStatic, adLockReadOnly, adCmdText
If rs.EOF = True And rs.BOF Then
m = MsgBox("请重新登录", vbExclamation)
Text1.Text = ""
Text1.SetFocus
Else
Form1.Hide
End If
rs.Close
这是第二种方法连接数据库的方法，这一种方法是采用有源的方法与数据库连接的方法，代码如下所示：
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.ConnectionString = "DSN=login;uid=sa;pwd=;"
conn.ConnectionTimeout = 30
conn.Open
rs.Open "select 用户名 from login", conn, adOpenStatic, adLockReadOnly, adCmdText
Dim i As String
For t = 0 To Val(rs.RecordCount) - 1
i = Trim(rs.Fields("用户名").Value)
rs.MoveNext
Combo1.AddItem i
Next t
rs.Close

Tags: vb

Asp代码：

Request.ServerVariables("HTTP_REFERER")

Javascript代码：

document.referrer

Tags: asp javascript

IIS6的安全性提高了很多，为了防止扩展名欺骗带来的安全性问题，限制了扩展名MIME类型

如果需要提供更多的扩展名支持有两种办法

1、直接在MIME设置下添加指定的类型文件支持；

2、可以配置IIS支持任何扩展名类型的文件，在MIME中添加一个新类型，扩展名为“ * ”，MIME 类型填写“application/octet-stream”

Tags: iis6

Function URLDecode(enStr)
dim deStr
dim c,i,v
deStr=""
for i=1 to len(enStr)
c=Mid(enStr,i,1)
if c="%" then
v=eval("&h"+Mid(enStr,i+1,2))
if v<128 then
deStr=deStr&chr(v)
i=i+2
else
if isvalidhex(mid(enstr,i,3)) then
if isvalidhex(mid(enstr,i+3,3)) then
v=eval("&h"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2))
deStr=deStr&chr(v)
i=i+5
else
v=eval("&h"+Mid(enStr,i+1,2)+cstr(hex(asc(Mid(enStr,i+3,1)))))
deStr=deStr&chr(v)
i=i+3
end if
else
destr=destr&c
end if
end if
else
if c="+" then
deStr=deStr&" "
else
deStr=deStr&c
end if
end if
next
URLDecode=deStr
end function

function isvalidhex(str)
isvalidhex=true
str=ucase(str)
if len(str)<>3 then isvalidhex=false:exit function
if left(str,1)<>"%" then isvalidhex=false:exit function
c=mid(str,2,1)
if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
c=mid(str,3,1)
if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
end function

<%
a=Server.UrlEncode("田志刚")
response.write(""&a&"")
%>
<%
a=Urldecode("%CC%EF%D6%BE%B8%D5")
response.write(""&a&"")
%>

Tags: asp

我在遥望,市场之上

有多少东西在自由的上涨

昨天已忘,掏干了钱囊

我要和你重逢在借钱的路上

查看更多...

Tags: 歪唱歌词

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

Tags: asp

function getBrowser(strUA)
 dim arrInfo,strType,temp1,temp2
 strType=""
 strUA=LCase(strUA)
 arrInfo=Array("Unkown","Unkown")
 '浏览器判断
    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
 
 '操作系统判断
    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

Tags: asp

'进行多媒体对象检测
 '提取媒体文件,清理播放器
 Function CheckMedia(Content)
  Dim oregExp,oRegExp1,oMatch,Matches,oMatch1,Matches1
  Dim sFiles1,sFiles2,sFile
  sFiles="swf,mp3,rm,ram,rmvb,mp4,wma,wav,avi"
  Set oregExp = New Regexp
  oRegExp.IgnoreCase = True
  oRegExp.Global = True
  Set oregExp1 = New Regexp
  oRegExp1.IgnoreCase = True
  oRegExp1.Global = True

  '媒体文件
  oRegExp.pattern ="<object.+?>"
  Set Matches=oRegExp.Execute(Content)
  For Each oMatch In Matches
   oRegExp1.pattern="http://([\w-]+\.)+[\w-]+(/[\w- ./?%&=]*)?"
   Set Matches1=oRegExp.Execute(oMatch.Value)
   For Each oMathch1 In Matches1
    '只取媒体文件
    sFile=Split(oMathch1.value,".")
    If InStr(sFiles1,sFile(UBound(sFile)))>0 Then
     strFiles2="<a href=""" &  oMathch1.value & """ target=""_blank"">" & oMathch1.value & "</a><br>"
    End If
   Next
  Next
  '清空
  oRegExp.pattern ="<object.+?/object>"
  Content=oRegExp1.replace(Content,"")
  oRegExp.pattern ="<em.+?>"
  Set Matches=oRegExp.Execute(Content)
  For Each oMatch In Matches
   oRegExp1.pattern="http://([\w-]+\.)+[\w-]+(/[\w- ./?%&=]*)?"
   Set Matches1=oRegExp.Execute(oMatch.Value)
   For Each oMathch1 In Matches1
    '只取媒体文件
    sFile=Split(oMathch1.value,".")
    If InStr(sFiles1,sFile(UBound(sFile)))>0 Then
     strFiles2="<a href=""" &  oMathch1.value & """ target=""_blank"">" & oMathch1.value & "</a><br>"
    End If
   Next
  Next
  oRegExp.pattern ="<em.+?/em>"
  Content=oRegExp1.replace(Content,"")
  Set oregExp1=othing
  Set oregExp2=othing
 End Function

Tags: asp

Function BuildFile(ByVal sFile, ByVal sContent)
  On Error Resume Next
  Dim oFSO, oStream
 ' Response.Write sFile
 ' Response.Write sContent
 ' Response.end
  If CacheConfig(24) = "1" Then
   '如果选用ADODB.Steam 则强制转换成Unicode
   If Right(LCase(sFile),4) <> ".xml" Then
    sContent = AnsiToUnicode(sContent)
   End if
   Set oStream = Server.CreateObject(CacheCompont(2))
   With oStream
    .Type = 2
    .Mode = 3
    .open
    '.Charset = "utf-8"
    .Charset = "gb2312"
    .Position = oStream.size
    .WriteText = sContent
    .SaveToFile sFile, 2
    .Close
   End With
   Set oStream = Nothing
  Else
   Set oFSO = Server.CreateObject(CacheCompont(1))
   Set oStream = oFSO.CreateTextFile(sFile,True)
   oStream.Write sContent
   oStream.Close
   '增加对特殊字符的保护，强制将内容转换成Unicode
   If Err.Number<>0 Then
    sContent = AnsiToUnicode(sContent)
    Set oStream = Server.CreateObject(CacheCompont(2))
    With oStream
     .Type = 2
     .Mode = 3
     .open
     '.Charset = "utf-8"
     .Charset = "gb2312"
     .Position = oStream.size
     .WriteText = sContent
     .SaveToFile sFile, 2
     .Close
    End With
    Err.Clear
   End If
   Set oStream = Nothing
   Set oFSO = Nothing
  End If
 End Function

Tags: asp

Function IsValidEmail(email)
  Dim names, name, i, c
  IsValidEmail = True
  names = Split(email, "@")
  If UBound(names) <> 1 Then
     IsValidEmail = False
     Exit Function
  End If
  For Each name In names
     If Len(name) <= 0 Then
    IsValidEmail = False
    Exit Function
     End If
     For i = 1 To Len(name)
    c = LCase(Mid(name, i, 1))
    If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then
      IsValidEmail = False
      Exit Function
    End If
     Next
     If Left(name, 1) = "." or Right(name, 1) = "." Then
     IsValidEmail = False
     Exit Function
     End If
  Next
  If InStr(names(1), ".") <= 0 Then
     IsValidEmail = False
     Exit Function
  End If
  i = Len(names(1)) - InStrRev(names(1), ".")
  If i <> 2 And i <> 3 Then
     IsValidEmail = False
     Exit Function
  End If
  If InStr(email, "..") > 0 Then
     IsValidEmail = False
  End If
 End Function

Tags: asp

Function CheckScript(Content)
  Dim oregExp,oMatch,spamCount
  Set oregExp = New Regexp
  oRegExp.IgnoreCase = True
  oRegExp.Global = True
  oRegExp.pattern ="<script.+?/script>"
  Content=oRegExp.replace(Content,"")
  Set oregExp=Nothing
 End Function

Tags: asp

Sub RedirectBy301(ByVal strURL)
 Response.Clear
 Response.Status="301 Moved Permanently"
 Response.AddHeader "Location",strURL
 Response.End
End Sub

Tags: asp 301转向