API高手，我想你们啊！！

Question

可以呀,给你一个例子:
把主窗体命名为FrmMain,然后再添加一个About窗体FrmAbout,在FrmMain中添加一个
Command按钮和一个label以下是模块的代码:Option ExplicitPublic Declare Function GetProp Lib "User32" _
    Alias "GetPropA" _
   (ByVal hWnd As Long, ByVal lpString As String) As Long
    
Public 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 LongPrivate Declare Function SetProp Lib "User32" _
   Alias "SetPropA" _
  (ByVal hWnd As Long, ByVal lpString As String, _
   ByVal hData As Long) As Long
   
Private Declare Function SetWindowLong Lib "User32" _
   Alias "SetWindowLongA" _
  (ByVal hWnd As Long, ByVal nIndex As Long, _
   ByVal wNewWord As Long) As Long
   
Private Declare Function GetWindowLong Lib "User32" _
   Alias "GetWindowLongA" _
  (ByVal hWnd As Long, ByVal nIndex As Long) As Long
   
Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (Destination As Any, Source As Any, ByVal Length As Long)Private Const GWL_WNDPROC  As Long = (-4)
Public Function HookFunc(ByVal hWnd As Long, ByVal msg As Long, _
                        ByVal wp As Long, ByVal lp As Long) As Long
   
  'this MUST be dimmed as the object passed!!!
   Dim obj As FrmMain
   Dim foo As Long
   
   foo = GetProp(hWnd, "ObjectPointer")
   
  'Ignore "impossible" bogus case
   If (foo <> 0) Then
   
      CopyMemory obj, foo, 4
      On Error Resume Next
      HookFunc = obj.WindowProc(hWnd, msg, wp, lp)
      
      If (Err) Then
         UnhookWindow hWnd
         Debug.Print "Unhook on Error, #"; CStr(Err.Number)
         Debug.Print "  Desc: "; Err.Description
         Debug.Print "  Message, hWnd: &h"; Hex(hWnd), _
                             "Msg: &h"; Hex(msg), "Params:"; wp; lp
      End If     'Make sure we don't get any foo->Release() calls
      foo = 0
      CopyMemory obj, foo, 4
   End IfEnd FunctionPublic Sub HookWindow(hWnd As Long, thing As Object)   Dim foo As Long   CopyMemory foo, thing, 4   Call SetProp(hWnd, "ObjectPointer", foo)
   Call SetProp(hWnd, "OldWindowProc", GetWindowLong(hWnd, GWL_WNDPROC))
   Call SetWindowLong(hWnd, GWL_WNDPROC, AddressOf HookFunc)
   
End SubPublic Sub UnhookWindow(hWnd As Long)
   
   Dim foo As Long   foo = GetProp(hWnd, "OldWindowProc")
   
   If (foo <> 0) Then
      Call SetWindowLong(hWnd, GWL_WNDPROC, foo)
   End If
   
End SubPublic Function InvokeWindowProc(hWnd As Long, msg As Long, _
                                 wp As Long, lp As Long) As Long   InvokeWindowProc = CallWindowProc(GetProp(hWnd, "OldWindowProc"), _
                                     hWnd, msg, wp, lp)
   
End Function以下是窗体FrmMain的代码:Option ExplicitPrivate Const MF_STRING = &H0
Private Const WM_SYSCOMMAND = &H112
Private Const MF_SEPARATOR = &H800'required: ID number for About command
'to be added to the system menu. This
'number must be less than '61440 int
'(&HF000 long)
Private Const ID_ABOUT = 1000Private Declare Function GetSystemMenu Lib "User32" _
   (ByVal hWnd As Long, ByVal bRevert As Long) As Long
    
Private Declare Function AppendMenu Lib "User32" _
    Alias "AppendMenuA" _
   (ByVal hMenu As Long, ByVal wFlags As Long, _
    ByVal wIDNewItem As Long, ByVal lpNewItem As String) As Long
Private Sub Command1_Click()   Unload Me
   
End Sub
Private Sub Form_Load()   Dim r As Long
   Dim hMenu As Long  'Add an "About" command to the system menu
   hMenu = GetSystemMenu(Me.hWnd, False)
   r = AppendMenu(hMenu, MF_SEPARATOR, 0, 0&)
   r = AppendMenu(hMenu, MF_STRING, ID_ABOUT, "&About this Demo...")
   
  'if OK, then subclass the form to
  'catch this menuitem selection
   If r = 1 Then
   
      Label1.Caption = "Select About... from the system menu."
      Call HookWindow(Me.hWnd, Me)
   
   Else
      Label1.Caption = "About... was not added to the menu."
   End If
    
End Sub
Friend Function WindowProc(hWnd As Long, msg As Long, wp As Long, lp As Long) As Long   Select Case msg
   
      Case WM_SYSCOMMAND
      
         If wp = ID_ABOUT Then
            
           'show the about form
            frmAbout.Show vbModal
            WindowProc = 1
            Exit Function
         
         End If      Case Else
      
   End Select
   
  ' Pass along to default window procedure.
   WindowProc = CallWindowProc(GetProp(hWnd, "OldWindowProc"), hWnd, msg, wp, lp)
   
End Function
Private Sub Form_Unload(Cancel As Integer)   Call UnhookWindow(Me.hWnd)End Sub

Answer 1

以上代码是通过系统消息来修改系统菜单
在VB6+win2k下通过,其中有copymemory的运用.
另外你可以去下载一个我写的WIN32API中文浏览器,有很多api的例子FoxAPI下载地址:
http://www.csdn.net/cnshare/soft/10/10879.shtmhttp://www.skycn.com/down.php?id=7503http://software.tom.com/download.asp?id=7616http://www.softsender.com/soft/foxapi.htmhttp://download.51soft.com/html/f/foxapizwlq.htm

Answer 2

谢谢！不过请看以下代码：
Dim intSrc AS Integer
Dim intDest AS IntegerintSrc=1
CopyMemory VarPtr(intDest),VarPtr(intSrc),4这段代码在win9x下运行后，intDest=1,然而在win2k下...不行啊，intDest仍然为0!

Answer 3

sorry,代码应为：CopyMemory VarPtr(intDest),VarPtr(intSrc),LenB(intSrc)

Answer 4

只要在前面加上byval就可以了 即:
CopyMemory ByVal VarPtr(intDest), ByVal VarPtr(intSrc), LenB(intSrc)

Answer 5

对，我想起来了，CopyMemory的参数声明为AS Any，应该用Byval关键字的。是小生一时迷糊了，谢谢。