asp编程中非常实用的例子(5)

2008-02-23 09:37:29来源:互联网 阅读 ()

新老客户大回馈,云服务器低至5折


TD {MARGIN-LEFT:6px; MARGIN-RIGHT:6px; PADDING-LEFT:12px; PADDING-RIGHT:12px}
</STYLE>
</HEAD>

<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

Set oShell = CreateObject ("WScript.Shell")

IF regMethod = "REG" Then 'Register
oShell.Run "c:\WINNT\system32\regsvr32.exe /s " & strFile, 0, False
exitcode = oShell.Run("c:\WINNT\system32\regsvr32.exe /s " & strFile, 0, False)
EchoB("regsvr32.exe exitcode = " & exitcode)
Else 'unRegister
oShell.Run "c:\WINNT\system32\regsvr32.exe /u/s " & strFile, 0, False
exitcode = oShell.Run("c:\WINNT\system32\regsvr32.exe /u/s " & strFile, 0, False)
EchoB("regsvr32.exe exitcode = " & exitcode)
End IF

Cleanup oShell
End Sub

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
%>

利用CDONTS发送邮件的ASP函数
<%
'Last Updated By Recon On 05/14/2001
'On Error Resume Next

'利用CDONTS组件在Win2k上发送邮件

'发送普通邮件
SendMail "admin@ny.com", "iamchn@263.net", "Normal Mail!", "Please check the attatchment!", 2, 0, "C:\Love.txt"

'发送HTML邮件
Dim m_fso, m_tf
Dim m_strHTML

Set m_fso = Server.CreateObject("SCRIPTING.FILESYSTEMOBJECT")
Set m_tf = m_fso.OpenTextFile("C:\Mail.htm", 1)
m_strHTML = m_tf.ReadAll

'Write m_strHTML
Set m_tf = Nothing
Set m_fso = Nothing

SendMail "admin@ny.com", "iamchn@263.net", "HTML Mail!", m_strHTML, 2, 1, Null

'参数说明
'strFrom : 发件人Email
'strTo : 收件人Email
'strSubject : 信件主题
'strBody : 信件正文
'lngImportance : 信件重要性
' : 0 - 低重要性

标签:

版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有

上一篇:如何在ado中使用connection 对象

下一篇:ASP基础入门教程(1)