没有贴错区域的问题。

头几天我的一个朋友问到：可否使用asp调用服务器的应用程序？我想了一下，拿出了一个自以为可行的解决方法。就是建立一个ActiveX DLL (OleDLL)，当然建立这个DLL使用VB是最方便的，在asp中实例这个组件，然后通过组件向另一个窗体程序发送WM_COPYDATA消息，而另一个窗体负责根据消息启动相应的应用程序。为什么不直接启动呢？由于IUSER没有如此高的权限。这个组件调试是成功的（在VB中实例这个组件），但是在asp中，组件建立成功，但是组件调用SendMessage这个API时却总是返回失败（当然调用之前我已经把处理消息的窗体启动了），令人费解。

鄙人愚钝，猜想可能是由于组件为in_process（OleDll只能是in_process），权限不足以呼唤API，可是想想又未必如此，因为很多操作都是隐式的由API实现的，这个也不能例外。

本来这个问题似乎应该属于asp或者vb区，但是我想vc区的同志们对系统的了解可能更深刻些吧，所以把问题贴在这里，还望大家抽出时间帮忙分析，或提出其他解决方法。

在asp中呼叫组件的测试代码如下：

<%
Dim obj
Set obj = Server.CreateObject("MsgSender.RunApp")

Response.Write obj.SendAppRunMsg("Notepad.exe","c:\config.sys")
%>

我的组件源代码：

Option Explicit

' 定义需要的API历程。包括常量和API函数体。

Private Const WM_COPYDATA = &H4A

Private Declare Function FindWindow Lib "user32" Alias _
    "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName _
    As String) As Long

Private Declare Function SendMessage Lib "user32" Alias _
    "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal _
    wParam As Long, lParam As Any) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
         (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

' 定义WM_COPYDATA消息规定的消息结构类型

Private Type COPYDATASTRUCT
    dwData As Long
    cbData As Long
    lpData As Long
End Type


' 根据用户指定的命令名字和参数发送启动应用程序的消息

Public Function SendAppRunMsg(Cmd As String, Para As String) As Boolean

    Dim hWndTarget As Long
    Dim cds As COPYDATASTRUCT
    Dim buf(1 To 255) As Byte
    Dim strMsg As String
    
    hWndTarget = FindWindow(vbNullString, "Shell for ASP")
    If hWndTarget = 0 Then
        Debug.Print "Can not find window"
        SendAppRunMsg = False
        Exit Function
    End If
    
    strMsg = Cmd & Space(1) & Para
    
    Call CopyMemory(buf(1), ByVal strMsg, LenB(strMsg))
    
    cds.dwData = 0
    cds.cbData = LenB(strMsg)
    cds.lpData = VarPtr(buf(1))
    Call SendMessage(hWndTarget, WM_COPYDATA, App.hInstance, cds)
    
    SendAppRunMsg = True

End Function

我的接收消息的程序的代码：

.bas文件的内容

Option Explicit

Type COPYDATASTRUCT
        dwData As Long
        cbData As Long
        lpData As Long
End Type

Public Const GWL_WNDPROC = (-4)
Public Const WM_COPYDATA = &H4A
Global lpPrevWndProc As Long
Global gHW As Long

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
   (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Declare Function CallWindowProc Lib "user32" Alias _
   "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As _
   Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As _
   Long) As Long

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
   (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As _
   Long) As Long

Public Sub Hook()

    lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, _
    AddressOf WindowProc)
    Debug.Print lpPrevWndProc
    
End Sub

Public Sub Unhook()

    Dim temp As Long
    temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
    
End Sub

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, _
   ByVal wParam As Long, ByVal lParam As Long) As Long
   
    If uMsg = WM_COPYDATA Then
        Call mySub(lParam)
    End If
    WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, _
       lParam)

End Function

Sub mySub(lParam As Long)

    Dim cds As COPYDATASTRUCT
    Dim buf(1 To 255) As Byte
    Dim strMsg As String

    Call CopyMemory(cds, ByVal lParam, LenB(cds))
    Call CopyMemory(buf(1), ByVal cds.lpData, cds.cbData)
    strMsg = StrConv(buf, vbUnicode)
    strMsg = Left(strMsg, InStr(1, strMsg, Chr$(0)) - 1)
    
    Debug.Print "The message is: [" & strMsg & "]"
    Shell strMsg, vbNormalFocus
    
End Sub

.frm文件的内容

Option Explicit

Private Sub Form_Load()

    Me.Caption = "Shell for ASP"
    gHW = Me.hwnd
    Call Hook
    
End Sub

Private Sub Form_Unload(Cancel As Integer)

    Call Unhook
    
End Sub