我问一下，通过自己写的服务，怎样已用户的身份运行1个外部程序

Question

RT，直接运行这个程序可以，但是通过服务运行这个程序却提示内存溢出，该怎么解决呢？

Answer 1

用shell是不行的，比如你这个服务是以system用户启动的，那么你用shell或者shellexecute来运行任何程序，那个程序的用户也会是system而不是普通用户，我在前段时间一个程序中已解决了这个问题，代码不知还能找到否

Answer 2

Private Declare Function CreateToolhelp32Snapshot Lib "KERNEL32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "KERNEL32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "KERNEL32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcess Lib "KERNEL32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As LongPrivate Const TH32CS_SNAPHEAPLIST = &H1
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPTHREAD = &H4
Private Const TH32CS_SNAPMODULE = &H8
Private Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Private Const TH32CS_INHERIT = &H80000000Private Const PROCESS_QUERY_INFORMATION = &H400Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const TOKEN_ASSIGN_PRIMARY = &H1
Private Const TOKEN_DUPLICATE = (&H2)
Private Const TOKEN_IMPERSONATE = (&H4)
Private Const TOKEN_QUERY = (&H8)
Private Const TOKEN_QUERY_SOURCE = (&H10)
Private Const TOKEN_ADJUST_PRIVILEGES = (&H20)
Private Const TOKEN_ADJUST_GROUPS = (&H40)
Private Const TOKEN_ADJUST_DEFAULT = (&H80)
Private Const TOKEN_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or TOKEN_ASSIGN_PRIMARY Or _
TOKEN_DUPLICATE Or TOKEN_IMPERSONATE Or TOKEN_QUERY Or TOKEN_QUERY_SOURCE Or _
TOKEN_ADJUST_PRIVILEGES Or TOKEN_ADJUST_GROUPS Or TOKEN_ADJUST_DEFAULT)Private Type PROCESSENTRY32
       dwSize  As Long
       cntUsage  As Long
       th32ProcessID  As Long
       th32DefaultHeapID  As Long
       th32ModuleID  As Long
       cntThreads  As Long
       th32ParentProcessID  As Long
       pcPriClassBase  As Long
       dwFlags  As Long
       szExeFile  As String * 1024
End TypePublic Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End TypePublic Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type
Public Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type
Public Const NORMAL_PRIORITY_CLASS = &H20
Public Const STARTF_USESTDHANDLES = &H100
Public Const STARTF_USESHOWWINDOW = &H1
Public Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As LongPublic Declare Sub ZeroMemory Lib "KERNEL32" Alias "RtlMoveMemory" (dest As Any, ByVal numBytes As Long)
Private Declare Function CreateProcessAsUser Lib "advapi32.dll" _
        Alias "CreateProcessAsUserA" _
        (ByVal hToken As Long, _
        ByVal lpApplicationName As Long, _
        ByVal lpCommandLine As String, _
        ByVal lpProcessAttributes As Long, _
        ByVal lpThreadAttributes As Long, _
        ByVal bInheritHandles As Long, _
        ByVal dwCreationFlags As Long, _
        ByVal lpEnvironment As Long, _
        ByVal lpCurrentDirectory As String, _
        lpStartupInfo As STARTUPINFO, _
        lpProcessInformation As PROCESS_INFORMATION) As LongPublic Function GetTokenByName(hToken As Long, ByVal lpName As String) As Boolean
  If StrPtr(lpName) = 0 Then GetTokenByName = False: Exit Function
  Dim hProcessSnap As Long
  hProcessSnap = 0
  Dim bRet As Boolean
  bRet = False
  Dim pe32 As PROCESSENTRY32
  hProcessSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
  If hProcessSnap = -1 Then GetTokenByName = False: Exit Function
  pe32.dwSize = Len(pe32)
  If Process32First(hProcessSnap, pe32) Then
     Do
        pe32.szExeFile = Trim(pe32.szExeFile)
        If UCase(Kill0(pe32.szExeFile)) = UCase(lpName) Then
            Dim hProcess As Long
            hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, pe32.th32ProcessID)
            bRet = OpenProcessToken(hProcess, TOKEN_ALL_ACCESS, hToken)
            Call CloseHandle(hProcessSnap)
            GetTokenByName = bRet
            Exit Function
        End If
     Loop While Process32Next(hProcessSnap, pe32)
  Else
     bRet = False
  End If
  Call CloseHandle(hProcessSnap)
  GetTokenByName = bRet
  Exit Function
End FunctionPublic Function RunProcess(ByVal lpImage) As Boolean
  If StrPtr(lpImage) = 0 Then RunProcess = False: Exit Function
  Dim hToken As Long
  If Not GetTokenByName(hToken, "explorer.exe") Then
     RunProcess = False
     Exit Function
  End If
  Dim si As STARTUPINFO
  Dim pi As PROCESS_INFORMATION
  si.cb = Len(si)
  Dim strtmp As String
  strtmp = "winsta0\default"
  si.lpDesktop = StrPtr(strtmp)
  Dim bResult As Boolean
  bResult = CreateProcessAsUser(hToken, 0&, lpImage, _
         0&, 0&, 0&, NORMAL_PRIORITY_CLASS, _
         0&, vbNullString, si, pi)
  Call CloseHandle(hToken)
  RunProcess = bResult
End FunctionPrivate Function Kill0(s As String) As String
    Dim i As Integer
    i = InStr(1, s, Chr(0))
    If i = 0 Then
        Kill0 = s
    Else
        Kill0 = Left(s, i - 1)
    End If
End Function还好找到了，实现以当前登陆用户的身份来运行一个程序，楼主试试能用不。
把以上代码放在一个bas中，调用方式如下：private sub command1_click()
  dim r as boolean
  r=RunProcess("c:\myprogram.exe") '若成功r=true
end sub

Answer 3

把代码中的：
  strtmp = "winsta0\default"
  si.lpDesktop = StrPtr(strtmp)
改成：
  si.lpDesktop = "winsta0\default"
就行了，呵呵。