没有贴错区域的问题 - 参与有分

[tief]

没有贴错区域的问题。

头几天我的一个朋友问到：可否使用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

[FranklinBHU]

水平有限啦，只能参与了。

[flounder]

太长了

[火烧云-]

天

[Bardo]

现在代码无法取出，（邮箱中的被删除了（EastDay.com(东方网)））
还有一个偷工的方法：用Active Excute Control（http://dochoa.webhostme.com可下载！）不过这样做很不安全！！！！

[tief]

To: Bardo(巴顿)

要是做一个内存文件倒是很简单，我一般就是用VC的。不过CGI应用是否可以访问共享页还是个问题，因为可能还会遇见权限或其它不可预知的问题。请老兄仔细看一下上面的描述，我用的就是在服务器运行一个不间歇程序的方法，然后通过组件与其通信。如果老兄说的方法的确可以解决（千万要经过测试），就post出来关键的部分:)

当初我也是信誓旦旦的说我的方法一定可行，不过~~~~一经试验，还是挂了:(

[masterz]

建议你看看CreateProcessWithLogonW（） 函数。也许可以解决问题

[lithe]

关注

[Bardo]

回复人： masterz() ( ) 信誉：100 2002-2-26 21:01:24 得分:0

建议你看看CreateProcessWithLogonW（） 函数。也许可以解决问题

NT 中可以，2000Server不行！

[masterz]

Bardo(巴顿) :CreateProcessWithLogonW是NT不支持的函数，NT中怎么会可以？
Requirements
Windows NT/2000 or later: Requires Windows 2000 or later.
Windows 95/98/Me: Unsupported.

[tief]

我现在想给分，不过怕问题被埋没，大家还是给点思路拉

[hoco]

学习！

[Qiushen]

没学过这东东

[Bardo]

masterz() ( ) 我确实搞错了！

[tief]

我再up一下，不要着急，分一定送的，不够我再加!!!

[cmpp]

http://www.csdn.net/expert/topic/544/544226.xml

[bgtjing]

up

[tief]

up

[wintenko]

up

[40Star]

上升

[admireO]

gz