当前位置导航:炫浪网>>网络学院>>网页制作>>ASP教程

以在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调用cmd.exe,将运行的结果保存到一个临时文本文件,然后读出这个文件的内容显示出来。
  
  以下是工程ASPCMD的类CMDShell.cls的代码。
  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 "kernel32" (ByVal dwMilliseconds As Long)
  Private Declare Function ShellExecute Lib "shell32.dll" 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 < 0) Or (lR > 32) Then
  'success
  Else
  rp.Write "Error Occered when starting the program " & sLocation
  End If
  errhandle:
  rp.Write "Error:" & Err.Description
  End Sub
  
  Public Sub OnStartPage(ByVal mysc As ScriptingContext)
  Set rp = mysc.Response
  Set rq = mysc.Request
  Set sr = mysc.Server
  Set ap = mysc.Application
  Set sn = mysc.Session
  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 = 0 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 Err.Number <> 70 Then
  msg = "Error # " & Str(Err.Number) & " was generated by " _
  & Err.Source & Chr(13) & Err.Description
  Else
  IsOpen = True
  End If
  End Function
  
  Public Sub Exec1(ByVal strCmd As String)
  On Error GoTo errhandle:
  Dim myTimer As Integer
  myTimer = 0
  
  Dim strOut As String
  Dim strFname As String
  //生成一个临时文件
  If Len(App.Path) = 3 Then
  strFname = App.Path & "lhtmp.txt"
  Else
  strFname = App.Path & "\lhtmp.txt"
  End If
  //如果在运行前文件已存在则删除之
  If FileExists(strFname) Then
  Kill strFname
  End If
  
  //运行行用户的CMD命令,并将结果输出到临时文件中
  //注意cmd.exe的/c参数是指运行完一个命令后马上结束会话状态。等同于在windows的run中输入的CMD命令。
  Dim strPara As String
  strPara = "/c " & strCmd & ">" & strFname
  ShellEx "cmd.exe", strPara
  //等待生成输出文件
  Do While Not FileExists(strFname)
  Sleep 1000
  DoEvents
  myTimer = myTimer + 1
  If myTimer = 15 Then
  Exit Do
  End If
  Loop
  myTimer = 0
  //等待文件输出完毕
  Do While IsOpen(strFname)
  Sleep 1000
  DoEvents
  myTimer = myTimer + 1
  If myTimer = 15 Then
  Exit Do
  End If
  Loop
  
  //显示输出文件的内容
  Open strFname For Input As #1
  Do While Not EOF(1)
  Line Input #1, strOut
  rp.Write strOut & vbCrLf
  Loop
  Close #1
  Sleep 1000
  //删除临时文件
  Kill strFname
  Exit Sub
  errhandle:
  rp.Write "error occured:" & Err.Description
  End Sub
  
  生成ASPCMD.dll,使用regsvr32 aspcmd.dll注册组件。
  
  以下是调用该DLL的一个ASP程序例子:
  
  <%@LANGUAGE="VBSCRIPT"%>
  <style type="text/css">
  <!--
  .singleborder {
  border: 1px solid;
  background-color: #000000;
  font-family: Arial, Helvetica, sans-serif;
  color: #FFFFFF;
  }
  .noborder {
  border: 1px none;
  background-color: #000000;
  font-family: Arial, Helvetica, sans-serif;
  color: #FFFFFF;
  }
  body{background-color: #000000;SCROLLBAR-FACE-COLOR: #333333; FONT-SIZE: 12px; SCROLLBAR-HIGHLIGHT-COLOR: #000000; SCROLLBAR-SHADOW-COLOR: #000000; SCROLLBAR-3DLIGHT-COLOR: #000000; SCROLLBAR-ARROW-COLOR: #000000; SCROLLBAR-TRACK-COLOR: #000000; SCROLLBAR-DARKSHADOW-COLOR: #000000
  font-family: Fixedsys;  font-size: 9pt}
  -->
  </style>
  <form action="" method="post">
  <input name="cmd" class="singleborder" value="<%=request.form("cmd")%>" size=102>
  <input type="submit" class="singleborder" value="EXECUTE">
  </form>
  <%
  if request.form("cmd")<>"" then
  set testme=server.createobject("aspcmd.cmdshell")
  %>
  <div class="noborder"><%=request.Form("cmd")%></div><br>
  <textarea cols="120" rows="30" class="noborder">
  <%=testme.exec1(request.form("cmd"))%></textarea>
  
  <% set testme=nothing
  end if
  %>
  
  以下是运行Ipconfig /all的结果:
  
  Windows 2000 IP Configuration
  
  Host Name . . . . . . . . . . . . : ibm-wrk-02
  Primary DNS Suffix . . . . . . . :
  Node Type . . . . . . . . . . . . : Broadcast
  IP Routing Enabled. . . . . . . . : No
  WINS Proxy Enabled. . . . . . . . : No
  
  Ethernet adapter 本地连接:
  
  Connection-specific DNS Suffix . :
  Description . . . . . . . . . . . : Intel(R) PRO/100 VM Network Connection
  Physical Address. . . . . . . . . : 00-08-02-BD-D7-EB
  DHCP Enabled. . . . . . . . . . . : No
  IP Address. . . . . . . . . . . . : 192.168.0.4
  Subnet Mask . . . . . . . . . . . : 255.255.255.0
  Default Gateway . . . . . . . . . : 192.168.0.1
  DNS Servers . . . . . . . . . . . : 202.106.196.115
  
  
  
  
相关内容
赞助商链接