我想往另一个程序的控件中写入数值,被写入的程序我是拿vb随便做了个窗体,里面放个Frame控件,Frame控件上放置了TextBox控件和DTPicker控件,往TextBox里面写入都正常,往DTPicker里面写入时没有反应,大家看看是怎么回事?帮忙改改!!!!!!
Option ExplicitPrivate Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long '取得一个窗体的标题(caption)文字,或者一个控件的内容(在vb里使用:使用vb窗体或控件的caption或text属性)
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 Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Const WM_SETTEXT = &HC
Private Const WM_SETFOCUS = &H7
Private Const DTM_SETSYSTEMTIME = &H1002
Private Const GDT_VALID = 0
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000
'private const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)
Private Const PROCESS_ALL_ACCESS& = &H1F0FFF
Private Const MEM_COMMIT = &H1000
Private Const PAGE_READWRITE = &H4
Private Const MEM_RELEASE = &H8000Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End TypePrivate Sub Command1_Click()    Dim objSYS As SYSTEMTIME
    objSYS.wYear = 2005
    objSYS.wMonth = 1
    objSYS.wDay = 1
    
    Dim hwdForm As Long
    Dim hwdCtl As Long
    Dim RetVal As Double
    Dim strClass As String
    Dim strCaption As String
    Dim i As Integer
    Dim ProcessID As Long
    Dim pHandle As Long ' 控件所在进程的句柄
    Dim pMyItemMemory As Long ' 内存区域的起始地址
    
    strClass = Space(255)
    strCaption = Space(255)    hwdForm = FindWindow(vbNullString, "Form1")
    'Call SetForegroundWindow(hwdForm)
    hwdCtl = GetWindow(hwdForm, GW_CHILD)
    Do While hwdCtl <> 0
        GetClassName hwdCtl, strClass, 255
        GetWindowText hwdCtl, strCaption, 255
        If InStr(strClass, "ThunderRT6Frame") > 0 And InStr(strCaption, "Frame1") > 0 Then
            hwdCtl = GetWindow(hwdCtl, GW_CHILD)
            While hwdCtl <> 0
                GetClassName hwdCtl, strClass, 255
                GetWindowText hwdCtl, strCaption, 255
                If InStr(strClass, "ThunderRT6TextBox") > 0 Then
                    RetVal = SendMessage(hwdCtl, WM_SETTEXT, 0, ByVal "文本框" & i)
                ElseIf InStr(strClass, "DTPicker20WndClass") > 0 Then
                    RetVal = GetWindowThreadProcessId(hwdCtl, ProcessID)
                    pHandle = OpenProcess(PROCESS_ALL_ACCESS, False, ProcessID)
                    pMyItemMemory = VirtualAllocEx(pHandle, 0, Len(objSYS), MEM_COMMIT, PAGE_READWRITE)
                    RetVal = WriteProcessMemory(pHandle, pMyItemMemory, objSYS, Len(objSYS), 0)
                    RetVal = SendMessage(hwdCtl, DTM_SETSYSTEMTIME, GDT_VALID, ByVal pMyItemMemory)
                    RetVal = VirtualFreeEx(pHandle, pMyItemMemory, 0, MEM_RELEASE)
                    RetVal = CloseHandle(pHandle)
                End If
                i = i + 1
                hwdCtl = GetWindow(hwdCtl, GW_HWNDNEXT)
            Wend
            Exit Do
        End If
        hwdCtl = GetWindow(hwdForm, GW_CHILD)
    Loop
End Sub

解决方案 »

  1.   

    你在申请内存的地方写错了,应该这样
    pMyItemMemory = VirtualAllocEx(pHandle, ByVal 0&, Len(objSYS), MEM_COMMIT, PAGE_READWRITE)因为声明时没加 ByVal ,所以默认为 ByRef。还有写内存时也是一样 ,需要加ByVal:
    RetVal = WriteProcessMemory(pHandle, ByVal pMyItemMemory, objSYS, Len(objSYS), 0) 
    这样就可以,其他地方没有错。结贴吧!