modeditmessages.bas

Windows超级黑客得到windows运行程序的信息,很经典的

Attribute VB_Name = "modEditMessages"
Option Explicit

' Note: because of the vast complexity of sending messages around the place,
' I have used private copies of sendmessage and postmessage in here.
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function SSendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
' The extra S stands for special- used only for string manipulation.
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

' For EM_GETSEL
Private Declare Function RefSendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByRef wParam As Long, ByRef lParam As Long) As Long

Public Sub SendEditMessage(ByRef Textout As TextBox, ByVal Message As Long, ByVal wParam As Variant, ByVal lParam As Variant, ByVal hWnd As Long)

' Oh, don't worry, there's only HOW MANY STUPID MESSAGES?!?!?!?

Dim Temp As String
Dim Result As Long
Dim wTemp As Long
Dim lTemp As Long
Dim TempRect As RECT

Select Case Message
  ' Start with the easy ones.
  ' EM_Undo, and WM_Undo
  Case Is = EM_UNDO
    Result = SendMessage(hWnd, EM_UNDO, &H0, &H0)
    If Result <> 0 Then Temp = "True" Else Temp = "False"
  Case Is = WM_UNDO
    Result = SendMessage(hWnd, WM_UNDO, &H0, &H0)
    If Result <> 0 Then Temp = "True" Else Temp = "False"
  
  ' Next can come more easy ones.
  ' WM_COPY, CUT, and PASTE
  Case Is = WM_COPY
    Result = SendMessage(hWnd, WM_COPY, &H0, &H0)
    Temp = "True - " & Trim(Str(Result)) & " characters copied."
  Case Is = WM_CUT
    Result = SendMessage(hWnd, WM_CUT, &H0, &H0)
    Temp = "True"
  Case Is = WM_PASTE
    Result = SendMessage(hWnd, WM_PASTE, &H0, &H0)
    Temp = "True"
  
  ' Hopefully this next batch won't be too hard either.
  ' EM_GET and EM_SET PASSWORDCHAR
  Case Is = EM_GETPASSWORDCHAR
    Result = SendMessage(hWnd, EM_GETPASSWORDCHAR, &H0, &H0)
    If Result <> 0 Then
      Temp = Trim(Str(Result)) & "  - """ & Chr$(Result) & """"
    Else
      Temp = Trim(Str(Result)) & "  - No password character"
    End If
  Case Is = EM_SETPASSWORDCHAR
    If Not IsNumeric(wParam) Then
      Temp = "Error in wParam"
    Else
      Result = SendMessage(hWnd, EM_SETPASSWORDCHAR, CLng(CByte(wParam)), &H0)
      If Val(wParam) = 0 Then
        Temp = "Password Character set to nothing."
      Else
        Temp = "Password Character set to """ & Chr$(wParam) & """."
      End If
    End If
  
  ' A few more easy ones - the limit stuph. As Setlimtext and straight limtext are the same...
  Case Is = EM_SETLIMITTEXT
  'Case Is = EM_LIMITTEXT
    If Not IsNumeric(wParam) Then
      Temp = "Error in wParam"
    Else
      Result = SendMessage(hWnd, EM_SETLIMITTEXT, CLng(wParam), &H0)
      If Val(wParam) = 0 Then
        Temp = "Max text length limit removed."
      Else
        Temp = "Max text length limit set to " & Trim(Str(wParam)) & "."
      End If
    End If
  Case Is = EM_GETLIMITTEXT
    Result = SendMessage(hWnd, EM_GETLIMITTEXT, &H0, &H0)
    If Result = 0 Then
      Temp = "There is no limit to the amount of text placed in the edit control."
    Else
      Temp = "There is a limit of " & Trim(Str(Result)) & " characters for this edit control."
    End If
  
  ' Now I'll just have to plow through them all. Of course, I start with the easy ones...
  Case Is = EM_CANUNDO
    Result = SendMessage(hWnd, EM_CANUNDO, &H0, &H0)
    If Result = 0 Then
      Temp = "0 - Cannot undo"
    Else
      Temp = "1 - Undo data exists"
    End If
  
  Case Is = EM_SETTABSTOPS
    Temp = "Cannot implement this yet due to technical troubles"
  
  Case Is = EM_GETMODIFY
    Result = SendMessage(hWnd, EM_GETMODIFY, &H0, &H0)
    If Result = 0 Then
      Temp = "False - Not modified"
    Else
      Temp = "True - Modified"
    End If
  Case Is = EM_SETMODIFY
    If Not IsNumeric(wParam) Then
      Temp = "Error in wParam"
    Else
      Result = SendMessage(hWnd, EM_SETMODIFY, CLng(Abs(CBool(wParam))), &H0)
      If Val(wParam) = 0 Then
        Temp = "Modify bit cleared"
      Else
        Temp = "Modify bit set"
      End If
    End If

  Case Is = EM_SETREADONLY
    If Not IsNumeric(wParam) Then
      Temp = "Error in wParam"
    Else
      Result = SendMessage(hWnd, EM_SETREADONLY, CLng(Abs(CBool(wParam))), &H0)
      If Val(wParam) = 0 Then
        Temp = "Read-only bit cleared"
      Else
        Temp = "Read-only bit set"
      End If
    End If
  
  Case Is = EM_GETTHUMB
    Result = SendMessage(hWnd, EM_GETTHUMB, &H0, &H0)
    Temp = "Thumb is at position " & Trim(Str(Result)) & ". If you can get this value to be other than 0, TELL ME!"
  
  Case Is = EM_EMPTYUNDOBUFFER
    Result = SendMessage(hWnd, EM_EMPTYUNDOBUFFER, &H0, &H0)
    Temp = "Undo buffer is emptied."
  
  ' Finally, a slightly technical hitch ={
  Case Is = EM_GETLINE
    If Not IsNumeric(wParam) Or wParam < 0 Then
      Temp = "Error in wParam"
    Else
      'CopyMemory TempByte(1), ByVal "512"
      'Temp = TempByte(1) & TempByte(2) & Space$(510)
      'Result = SSendMessage(hWnd, EM_GETLINE, wParam, Temp)
      Temp = "Due to technical difficulties, this function is not working."
    End If
  
  Case Is = EM_GETLINECOUNT
    Result = SendMessage(hWnd, EM_GETLINECOUNT, &H0, &H0)
    Temp = Trim(Str(Result))
  
  Case Is = EM_SETHANDLE
    Temp = "Due to technical difficulties, this function is not working."
  
  Case Is = EM_GETHANDLE
    Result = SendMessage(hWnd, EM_GETHANDLE, &H0, &H0)
    Temp = Trim(Str(Result))
  
  Case Is = EM_GETFIRSTVISIBLELINE
    Result = SendMessage(hWnd, EM_GETFIRSTVISIBLELINE, &H0, &H0)
    Temp = Trim(Str(Result)) & ": character number for single line edit classes, line number for multiline edit classes."
  
  Case Is = EM_REPLACESEL
    Result = SSendMessage(hWnd, EM_REPLACESEL, Val(wParam), lParam)
    Temp = "Selection replaced by " & lParam
    
  Case Is = EM_GETSEL
    Result = RefSendMessage(hWnd, EM_GETSEL, wTemp, lTemp)
    Temp = "Start: " & Trim(Str(wTemp)) & "  End: " & Trim(Str(lTemp))
  
  Case Is = EM_GETRECT
    Result = SendMessage(hWnd, EM_GETRECT, &H0, TempRect)
    Temp = "Left: " & Trim(Str(TempRect.Left)) & "  Top: " & Trim(Str(TempRect.Top)) & "  Right: " & Trim(Str(TempRect.Right)) & "  Bottom: " & Trim(Str(TempRect.Bottom))
  
  Case Is = EM_SCROLL
    If wParam < 0 Or wParam > 4 Then
      Temp = "Error in wParam"
    Else
      Result = SendMessage(hWnd, EM_SCROLL, wParam, &H0)
      Temp = "Return Value: " & Trim(Str(Result))
    End If
  
  Case Is = EM_LINESCROLL
    Result = SendMessage(hWnd, EM_LINESCROLL, wParam, lParam)
    Temp = "Return Value: " & Trim(Str(Result))
  
  Case Is = EM_LINEINDEX
    If Not IsNumeric(wParam) Then
      Temp = "Error in wParam."
    Else
      Result = SendMessage(hWnd, EM_LINEINDEX, wParam, &H0)
      If Result = -1 Then
        Temp = "Error"
      Else
        Temp = "Character offset is " & Trim(Str(Result)) & " for first character in line " & Trim(Str(wParam)) & "."
      End If
    End If
  
  Case Is = EM_LINELENGTH
    If Not IsNumeric(wParam) Then
      Temp = "Error in wParam."
    Else
      Result = SendMessage(hWnd, EM_LINELENGTH, wParam, &H0)
      If Result = -1 Then
        Temp = "Error"
      Else
        Temp = Trim(Str(wParam))
      End If
    End If
  
  Case Is = EM_LINEFROMCHAR
    If Not IsNumeric(wParam) Then
      Temp = "Error in wParam."
    Else
      Result = SendMessage(hWnd, EM_LINEFROMCHAR, wParam, &H0)
      If Result = -1 Then
        Temp = "Error"
      Else
        Temp = Trim(Str(wParam))
      End If
    End If
    
  Case Is = EM_SETMARGINS
    Temp = "Not implemented due to technical difficulties."
  
  Case Is = EM_GETMARGINS
    Result = SendMessage(hWnd, EM_GETMARGINS, &H0, &H0)
    Temp = "Left Margin: " & Trim(Str(LoWord(Result))) & "  Right Margin: " & Trim(Str(HiWord(Result)))
  
  Case Is = EM_SETSEL
    If Not IsNumeric(wParam) Then
      Temp = "Error in wParam."
    ElseIf Not IsNumeric(lParam) Then
      Temp = "Error in lParam."
    Else
      Result = SendMessage(hWnd, EM_SETSEL, wParam, lParam)
      Temp = Trim(Str(wParam))
    End If
    
  Case Is = EM_POSFROMCHAR
    Dim PointStruct As POINTAPI
    If Not IsNumeric(lParam) Then
      Temp = "Error in lParam."
    Else
      Result = SendMessage(hWnd, EM_POSFROMCHAR, ByVal VarPtr(PointStruct), lParam)
      Temp = Trim(Str(PointStruct.X)) & ", " & Trim(Str(PointStruct.Y))
    End If
    
  Case Is = EM_SCROLLCARET
    SendMessage hWnd, EM_SCROLLCARET, &H0, &H0
    Temp = "Done"
  
  Case Is = EM_FMTLINES
    If Not IsNumeric(lParam) Then
      Temp = "Error in lParam."
    Else
      Result = SendMessage(hWnd, EM_FMTLINES, wParam, &H0)
      Temp = "Done"
    End If
  
  Case Is = EM_CHARFROMPOS
    If Not IsNumeric(wParam) Then
      Temp = "Error in wParam."
    ElseIf Not IsNumeric(lParam) Then
      Temp = "Error in lParam."
    Else
      Result = SendMessage(hWnd, EM_CHARFROMPOS, wParam, lParam)
      Temp = Trim(Str(Result))
    End If
  
  Case Is = EM_SETRECT
    On Error Resume Next
    If InStr(wParam, ", ") < 1 Then
      Temp = "Error in wParam."
    ElseIf InStr(wParam, ", ") < 1 Then
      Temp = "Error in lParam."
    Else
      TempRect.Left = Val(Left(wParam, InStr(wParam, ",") - 1))
      TempRect.Top = Val(Mid(wParam, InStr(wParam, ",") + 2))
      TempRect.Right = Val(Left(lParam, InStr(lParam, ",") - 1))
      TempRect.Bottom = Val(Mid(lParam, InStr(lParam, ",") + 2))
      Result = SendMessage(hWnd, EM_SETRECT, &H0, TempRect)
      Temp = Trim(Str(Result))
    End If
  
  Case Is = EM_SETRECTNP
    On Error Resume Next
    If InStr(wParam, ", ") < 1 Then
      Temp = "Error in wParam."
    ElseIf InStr(wParam, ", ") < 1 Then
      Temp = "Error in lParam."
    Else
      TempRect.Left = Val(Left(wParam, InStr(wParam, ",") - 1))
      TempRect.Top = Val(Mid(wParam, InStr(wParam, ",") - 2))
      TempRect.Right = Val(Left(lParam, InStr(lParam, ",") - 1))
      TempRect.Bottom = Val(Mid(wParam, InStr(lParam, ",") - 2))
      Result = SendMessage(hWnd, EM_SETRECTNP, &H0, TempRect)
      Temp = Trim(Str(Result))
    End If
  
  Case Is = WM_COMMAND
    Result = SendMessage(hWnd, WM_COMMAND, CLng(wParam), CLng(lParam))
    Temp = Result
  
  Case Is = WM_GETTEXT
    Dim TempString As String
    TempString = Space$(1024)
    Result = SSendMessage(hWnd, WM_GETTEXT, Len(TempString), TempString)
    Temp = FixApi(TempString)
  
  ' Ok. Now that I have come to the last one, which is an important one, I am pleased.
  ' I have only had to cancel 2 or 3 messages due to slight technical problems.
  ' This one, which has a little problem, will probably defeat me, though.
  ' But now that I know about sending strings along DLL's, we'll see what happens.
  Case Is = WM_SETTEXT
    Result = SSendMessage(hWnd, WM_SETTEXT, &H0, lParam)
    Temp = Trim(Str(Result))

End Select

Textout.Text = Temp

End Sub

Public Function CombineWord(ByVal LoWord As Integer, ByVal HiWord As Integer) As Long
CopyMemory CombineWord, LoWord, 2
CopyMemory ByVal (VarPtr(CombineWord) + 2), HiWord, 2
End Function