<% "此模块放置在重复域之外 Dim RecordCounter Recordcounter = 0 %>
<tr class = <% "将重复域中第一个 <tr>标签的CLASS属性代码用本模块替换 "本模块基于CSS来改变单元格背景色,你也可以直接设置背景色来实现斑马线 RecordCounter = Recordcounter + 1 If RecordCounter Mod 2 = 1 Then Response.Write "altRow1" Else Response.write "altRow2" End If %>
●显示字符串前20个字符并在结尾处添加“……”
<% Dim CutShort CutShort = rsYourRecordset.Fields.Item("YourField").Value Response.Write LEFT (CutShort, 20) & "........" %>
●如果动态图片为空,用默认图片代替
<% Dim PicShow PicShow = rsShowHide.Fields.Item("shMainPix").Value IF PicShow <>"" THEN %> <img src="<%=rsShowHide.Fields.Item("shMainPix").Value%>"> <% ELSE %> <img src="StaticPic.gif"> <% End If %>
●如果数据为空,用默认提示信息代替。
<% Dim strShowHide strShowHide = rsYourRecordset.Fields.Item("YourDataField").Value IF stShowHide <>"" THEN%> 数据为空 <%END IF%>
纯编码实现Access数据库的建立或压缩
<% "#######以下是一个类文件,下面的注解是调用类的方法################################################ "# 注意:如果系统不支持建立Scripting.FileSystemObject对象,那么数据库压缩功能将无法使用 "# Access 数据库类 "# CreateDbFile 建立一个Access 数据库文件 "# CompactDatabase 压缩一个Access 数据库文件 "# 建立对象方法: "# Set a = New DatabaseTools "# by (萧寒雪) s.f. "#########################################################################################
Class DatabaseTools
Public function CreateDBfile(byVal dbFileName,byVal DbVer,byVal SavePath) "建立数据库文件 "If DbVer is 0 Then Create Access97 dbFile "If DbVer is 1 Then Create Access2000 dbFile On error resume Next If Right(SavePath,1)<>"" Or Right(SavePath,1)<>"/" Then SavePath = Trim(SavePath) & "" If Left(dbFileName,1)="" Or Left(dbFileName,1)="/" Then dbFileName = Trim(Mid(dbFileName,2,Len(dbFileName))) If DbExists(SavePath & dbFileName) Then Response.Write ("对不起,该数据库已经存在!") CreateDBfile = False Else Dim Ca Set Ca = Server.CreateObject("ADOX.Catalog") If Err.number<>0 Then Response.Write ("无法建立,请检查错误信息 " & Err.number & " " & Err.Description) Err.Clear Exit function End If If DbVer=0 Then call Ca.Create("Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & SavePath & dbFileName) Else call Ca.Create("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & SavePath & dbFileName) End If Set Ca = Nothing CreateDBfile = True End If End function
Public function CompactDatabase(byVal dbFileName,byVal DbVer,byVal SavePath) "压缩数据库文件 "0 为access 97 "1 为access 2000 On Error resume next If Right(SavePath,1)<>"" Or Right(SavePath,1)<>"/" Then SavePath = Trim(SavePath) & "" If Left(dbFileName,1)="" Or Left(dbFileName,1)="/" Then dbFileName = Trim(Mid(dbFileName,2,Len(dbFileName))) If DbExists(SavePath & dbFileName) Then Response.Write ("对不起,该数据库已经存在!") CompactDatabase = False Else Dim Cd Set Cd =Server.CreateObject("JRO.JetEngine") If Err.number<>0 Then Response.Write ("无法压缩,请检查错误信息 " & Err.number & " " & Err.Description) Err.Clear Exit function End If If DbVer=0 Then call Cd.CompactDatabase("Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & SavePath & dbFileName,"Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & SavePath & dbFileName & ".bak.mdb;Jet OLEDB;Encrypt Database=True") Else call Cd.CompactDatabase("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & SavePath & dbFileName,"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & SavePath & dbFileName & ".bak.mdb;Jet OLEDB;Encrypt Database=True") End If "删除旧的数据库文件 call DeleteFile(SavePath & dbFileName) "将压缩后的数据库文件还原 call RenameFile(SavePath & dbFileName & ".bak.mdb",SavePath & dbFileName) Set Cd = False CompactDatabase = True End If end function
Public function DbExists(byVal dbPath) "查找数据库文件是否存在 On Error resume Next Dim c Set c = Server.CreateObject("ADODB.Connection") c.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath If Err.number<>0 Then Err.Clear DbExists = false else DbExists = True End If set c = nothing End function
Public function AppPath() "取当前真实路径 AppPath = Server.MapPath("./") End function
Public function AppName() "取当前程序名称 AppName = Mid(Request.ServerVariables("SCRIPT_NAME"),(InStrRev(Request.ServerVariables("SCRIPT_NAME") ,"/",-1,1))+1,Len(Request.ServerVariables("SCRIPT_NAME"))) End Function
Public function DeleteFile(filespec) "删除一个文件 Dim fso Set fso = CreateObject("Scripting.FileSystemObject") If Err.number<>0 Then Response.Write("删除文件发生错误!请查看错误信息 " & Err.number & " " & Err.Description) Err.Clear DeleteFile = False End If call fso.DeleteFile(filespec) Set fso = Nothing DeleteFile = True End function
Public function RenameFile(filespec1,filespec2) "修改一个文件 Dim fso Set fso = CreateObject("Scripting.FileSystemObject") If Err.number<>0 Then Response.Write("修改文件名时发生错误!请查看错误信息 " & Err.number & " " & Err.Description) Err.Clear RenameFile = False End If call fso.CopyFile(filespec1,filespec2,True) call fso.DeleteFile(filespec1) Set fso = Nothing RenameFile = True End function
End Class %>
现在已可以压缩有密码的数据库,代码如下,但是压缩之后的数据库密码就没有了!如何解决?
<% Const JET_3X = 4
Function CompactDB(dbPath, boolIs97) Dim fso, Engine, strDBPath strDBPath = left(dbPath,instrrev(DBPath,"")) Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(dbPath) Then Set Engine = CreateObject("JRO.JetEngine")
Else CompactDB = "数据库名称或路径不正确. 请重试!" & vbCrLf End If
End Function %> asp编程有用的例子(一) 1.如何用Asp判断你的网站的虚拟物理路径 答:使用Mappath方法 < p align="center" >< font size="4" face="Arial" >< b > The Physical path to this virtual website is: < /b >< /font > < font color="#FF0000" size="6" face="Arial" > < %= Server.MapPath("")% > < /font >< /p > 2.我如何知道使用者所用的浏览器? 答:使用the Request object方法 strBrowser=Request.ServerVariables("HTTP_USER_AGENT") If Instr(strBrowser,"MSIE") < > 0 Then Response.redirect("ForMSIEOnly.htm") Else Response.redirect("ForAll.htm") End If
3.如何计算每天的平均反复访问人数 答:解决方法 < % startdate=DateDiff("d",Now,"01/01/1990") if strdate< 0 then startdate=startdate*-1 avgvpd=Int((usercnt)/startdate) % > 显示结果 < % response.write(avgvpd) % > that is it.this page have been viewed since November 10,1998
"*********************************************** "用COM对象Scripting.FileSystemObject操作文本文件 "*********************************************** Set fs = Wscript.CreateObject("Scripting.FileSystemObject") Set a = fs.CreateTextFile("c: estfile.txt", True) a.WriteLine("这是一个测试。") a.Close
也可以在asp等web编程语言中应用 <script language="VBScript.Encode" runat=server> "上面用SHELL对象启动程序 Set WshShell = server.CreateObject("Wscript.Shell") IsSuccess = WshShell.Run ("D:winntsystem32cmd.exe" ,1, true) if IsSuccess = 0 Then Response.write " 命令成功执行!" else Response.write " 命令执行失败!权限不够或者该程序无法在DOS状态下运行" end if </script> 注: 1.其中runat=server必须要有 2.Set WshShell = Wscript.CreateObject("Wscript.Shell") 要改为Set WshShell = server.CreateObject("Wscript.Shell"), 3.参数1代表SW_SHOWNORMAL, 激活并显示一个窗口。若窗口是最小化或最大化,则恢复到其原来的大小和位置。 4.TRUE代表返回执行的错误,False或者为指定代表脚本继续执行而不等待进程结束。 5.调用WSH的内置对象了,可以象调用函数和过程一样。 如call WshShell.Run ("D:winntsystem32cmd.exe" ,1, true)
现在我们言归正传来看看如何对文件进行压缩和解压! 大家都知道winzip对文件解压和压缩都易如反掌,但是如何通过程序和命令行对其调用呢? 当然winzip的作者已经开发出 WinZip Command Line Support Add-On Version 1.0 大家去可以去http://www.winzip.com/wzcline.htm 下载wzcline.exe! 前提是本机须安装winzip8.0或更高版本的支持,如果你不是winzip8.0,去 http://www.winzip.com/download.htm 下载!
<BODY> <FORM NAME="regForm" METHOD="POST"> <TABLE BORDER=0 CELLSPACING=6 CELLPADDING=6 MARGINWIDTH=6> <TR> <TD VALIGN=TOP> <FIELDSET ID=FS1 NAME=FS1 CLASS=FS> <LEGEND CLASS=Legend>Regsvr Functions</LEGEND> Insert Path to DLL Directory<BR> <INPUT TYPE=TEXT NAME="frmFolderPath" VALUE="<%=frmFolderPath%>"><BR> <INPUT TYPE=SUBMIT NAME=btnFileList VALUE="Build File List"><BR> <% IF Request.Form("btnFileList") <> "" OR btnREG <> "" Then Set RegisterFiles = New clsRegister RegisterFiles.EchoB("<B>Select File</B>") Call RegisterFiles.init(frmFolderPath) RegisterFiles.EchoB("<BR><INPUT TYPE=SUBMIT NAME=btnREG VALUE=" & Chr(34) _ & "REG/UNREG" & Chr(34) & ">") IF Request.Form("btnREG") <> "" Then Call RegisterFiles.Register(frmFilePath, frmMethod) End IF Set RegisterFiles = Nothing End IF %> </FIELDSET> </TD> </TR> </TABLE> </FORM> </BODY> </HTML> <% Class clsRegister
Private m_oFS
Public Property Let oFS(objOFS) m_oFS = objOFS End Property
Public Property Get oFS() Set oFS = Server.CreateObject("Scripting.FileSystemObject") End Property
Sub init(strRoot) "Root to Search (c:, d:, e:) Dim oDrive, oRootDir IF oFS.FolderExists(strRoot) Then IF Len(strRoot) < 3 Then "Must Be a Drive Set oDrive = oFS.GetDrive(strRoot) Set oRootDir = oDrive.RootFolder Else Set oRootDir = oFS.GetFolder(strRoot) End IF Else EchoB("<B>Folder ( " & strRoot & " ) Not Found.") Exit Sub End IF setRoot = oRootDir
Echo("<SELECT NAME=" & Chr(34) & "frmDllPath" & Chr(34) & ">") Call getAllDlls(oRootDir) EchoB("</SELECT>") BuildOptions End Sub
Sub getAllDlls(oParentFolder) Dim oSubFolders, oFile, oFiles Set oSubFolders = oParentFolder.SubFolders Set opFiles = oParentFolder.Files
For Each oFile in opFiles IF Right(lCase(oFile.Name), 4) = ".dll" OR Right(lCase(oFile.Name), 4) = ".ocx" Then Echo("<OPTION VALUE=" & Chr(34) & oFile.Path & Chr(34) & ">" _ & oFile.Name & "</Option>") End IF Next
On Error Resume Next For Each oFolder In oSubFolders "Iterate All Folders in Drive Set oFiles = oFolder.Files For Each oFile in oFiles IF Right(lCase(oFile.Name), 4) = ".dll" OR Right(lCase(oFile.Name), 4) = ".ocx" Then Echo("<OPTION VALUE=" & Chr(34) & oFile.Path & Chr(34) & ">" _ & oFile.Name & "</Option>") End IF Next Call getAllDlls(oFolder) Next On Error GoTo 0 End Sub
Sub Register(strFilePath, regMethod) Dim theFile, strFile, oShell, exitcode Set theFile = oFS.GetFile(strFilePath) strFile = theFile.Path
Sub BuildOptions EchoB("Register: <INPUT TYPE=RADIO NAME=frmMethod VALUE=REG CHECKED>") EchoB("unRegister: <INPUT TYPE=RADIO NAME=frmMethod VALUE=UNREG>") End Sub
Function Echo(str) Echo = Response.Write(str & vbCrLf) End Function
Function EchoB(str) EchoB = Response.Write(str & "<BR>" & vbCrLf) End Function
Sub Cleanup(obj) If isObject(obj) Then Set obj = Nothing End IF End Sub
Sub Class_Terminate() Cleanup oFS End Sub End Class %> 当前1/2页 12下一页