以在ASP環境下調用的運行CMD命令的VB組件

　　有時我們在管理服務器時為了安全起見會禁用Windows Scripting Host這樣能防止某些不法用戶利用WSH生成一個WebShell對服務器造成很大的安全隱患但如果我們又想禁用WSH又想使用自己的WebShell用於服務器的管理怎麼辦呢？這裡介紹了一種實現ASP中運行CMD並顯示結果的組件編程希望對大家能有所幫助
　　
　　首先我們新建一個ActiveDLL工程命名為ASPCMD新建的類命名為CMDShell在Project的Referenct中添加一個引用Microsoft Active Server Pages Object Library
　　
　　然後我們的思路是使用Window API ShellExecute調用cmdexe將運行的結果保存到一個臨時文本文件然後讀出這個文件的內容顯示出來
　　
　　以下是工程ASPCMD的類CMDShellcls的代碼
　　Option Explicit
　　Dim rp As Response
　　Dim rq As Request
　　Dim ap As Application
　　Dim sr As Server
　　Dim sn As Session
　　Private Declare Sub Sleep Lib kernel (ByVal dwMilliseconds As Long)
　　Private Declare Function ShellExecute Lib shelldll Alias ShellExecuteA (ByVal hWnd As Long ByVal lpOperation As String ByVal lpFile As String ByVal lpParameters As String ByVal lpDirectory As String ByVal nShowCmd As Long) As Long
　　
　　
　　Private Sub ShellEx(ByVal sLocation As String ByVal sPara As String Optional MaxedForm As Boolean = False)
　　On Error GoTo errhandle:
　　Dim lR As Long
　　Dim Style As Long
　　Dim hWnd As Long
　　If MaxedForm Then
　　Style = vbMaximizedFocus
　　Else
　　Style = vbNormalFocus
　　End If
　　
　　lR = ShellExecute(hWnd open sLocation sPara Style)
　　If (lR < ) Or (lR > ) Then
　　success
　　Else
　　rpWrite Error Occered when starting the program & sLocation
　　End If
　　errhandle:
　　rpWrite Error: & ErrDescription
　　End Sub
　　
　　Public Sub OnStartPage(ByVal mysc As ScriptingContext)
　　Set rp = myscResponse
　　Set rq = myscRequest
　　Set sr = myscServer
　　Set ap = myscApplication
　　Set sn = myscSession
　　End Sub
　　
　　Public Sub OnEndPage()
　　Set rp = Nothing
　　Set rq = Nothing
　　Set sr = Nothing
　　Set ap = Nothing
　　Set sn = Nothing
　　End Sub
　　
　　Private Function FileExists(Filename As String) As Boolean
　　Dim i　 As Integer
　　On Error Resume Next
　　i = Len(Dir$(Filename))
　　If Err Or i = Then FileExists = False Else FileExists = True
　　End Function
　　
　　Private Function IsOpen(Filename As String) As Boolean
　　Dim fFile As Integer
　　Dim msg As String
　　fFile = FreeFile()
　　On Error GoTo ErrOpen
　　Open Filename For Binary Lock Read Write As fFile
　　Close fFile
　　Exit Function
　　ErrOpen:
　　If ErrNumber <> Then
　　msg = Error # & Str(ErrNumber) & was generated by _
　　& ErrSource & Chr() & ErrDescription
　　Else
　　IsOpen = True
　　End If
　　End Function
　　
　　Public Sub Exec(ByVal strCmd As String)
　　On Error GoTo errhandle:
　　Dim myTimer As Integer
　　myTimer =
　　
　　Dim strOut As String
　　Dim strFname As String
　　//生成一個臨時文件
　　If Len(AppPath) = Then
　　strFname = AppPath & lhtmptxt
　　Else
　　strFname = AppPath & \lhtmptxt
　　End If
　　//如果在運行前文件已存在則刪除之
　　If FileExists(strFname) Then
　　Kill strFname
　　End If
　　
　　//運行行用戶的CMD命令並將結果輸出到臨時文件中
　　//注意cmdexe的/c參數是指運行完一個命令後馬上結束會話狀態等同於在windows的run中輸入的CMD命令
　　Dim strPara As String
　　strPara = /c & strCmd & > & strFname
　　ShellEx cmdexe strPara
　　//等待生成輸出文件
　　Do While Not FileExists(strFname)
　　Sleep
　　DoEvents
　　myTimer = myTimer +
　　If myTimer = Then
　　Exit Do
　　End If
　　Loop
　　myTimer =
　　//等待文件輸出完畢
　　Do While IsOpen(strFname)
　　Sleep
　　DoEvents
　　myTimer = myTimer +
　　If myTimer = Then
　　Exit Do
　　End If
　　Loop
　　
　　//顯示輸出文件的內容
　　Open strFname For Input As #
　　Do While Not EOF()
　　Line Input # strOut
　　rpWrite strOut & vbCrLf
　　Loop
　　Close #
　　Sleep
　　//刪除臨時文件
　　Kill strFname
　　Exit Sub
　　errhandle:
　　rpWrite error occured: & ErrDescription
　　End Sub
　　
　　生成ASPCMDdll使用regsvr aspcmddll注冊組件
　　
　　以下是調用該DLL的一個ASP程序例子
　　
　　<%@LANGUAGE=VBSCRIPT%>
　　<style type=text/css>
　　<!
　　singleborder {
　　border: px solid;
　　backgroundcolor: #;
　　fontfamily: Arial Helvetica sansserif;
　　color: #FFFFFF;
　　}
　　noborder {
　　border: px none;
　　backgroundcolor: #;
　　fontfamily: Arial Helvetica sansserif;
　　color: #FFFFFF;
　　}
　　body{backgroundcolor: #;SCROLLBARFACECOLOR: #; FONTSIZE: px; SCROLLBARHIGHLIGHTCOLOR: #; SCROLLBARSHADOWCOLOR: #; SCROLLBARDLIGHTCOLOR: #; SCROLLBARARROWCOLOR: #; SCROLLBARTRACKCOLOR: #;　SCROLLBARDARKSHADOWCOLOR: #
　　fontfamily: Fixedsys;　 fontsize: pt}
　　>
　　</style>
　　<form action= method=post>
　　<input name=cmd class=singleborder value=<%=requestform(cmd)%> size=>
　　<input type=submit class=singleborder value=EXECUTE>
　　</form>
　　<%
　　if requestform(cmd)<> then
　　set testme=servercreateobject(aspcmdcmdshell)
　　%>
　　<div class=noborder><%=requestForm(cmd)%></div><br>
　　<textarea cols= rows= class=noborder>
　　<%=testmeexec(requestform(cmd))%></textarea>
　　
　　<% set testme=nothing
　　end if
　　%>
　　
　　以下是運行Ipconfig /all的結果
　　
　　Windows IP Configuration
　　
　　Host Name : ibmwrk
　　Primary DNS Suffix　 :
　　Node Type : Broadcast
　　IP Routing Enabled : No
　　WINS Proxy Enabled : No
　　
　　Ethernet adapter 本地連接:
　　
　　Connectionspecific DNS Suffix　 :
　　Description : Intel(R) PRO/ VM Network Connection
　　Physical Address : BDDEB
　　DHCP Enabled : No
　　IP Address :
　　Subnet Mask :
　　Default Gateway :
　　DNS Servers :
　　
　　
　　
　　

From:http://tw.wingwit.com/Article/program/net/201311/11821.html