江湖急救！

求教300行左右用vb写的代码，附带基本的解释。

解决方案 »

  1.   

    不是毕业设计，再说毕业设计才要300行吗？就是一个作业，我是学得vc,帮我哥们弄300行vb写的。麻烦了。qq1036117669!内容简单点，附带主要语句的解释，300行代码左右，注释也可以算1行。
      

  2.   

    我送你1000行的
    'Example Name:Authenticating a User though the NT Challenge Process '------------------------------------------------------------------------------
    '
    ' Form Code
    '
    '------------------------------------------------------------------------------
    Option ExplicitPrivate Const SEC_E_OK = 0
    Private Const HEAP_ZERO_MEMORY = &H8
    Private Const SEC_WINNT_AUTH_IDENTITY_ANSI = &H1
    Private Const SECBUFFER_TOKEN = &H2
    Private Const SECURITY_NATIVE_DREP = &H10
    Private Const SECPKG_CRED_INBOUND = &H1
    Private Const SECPKG_CRED_OUTBOUND = &H2
    Private Const SEC_I_CONTINUE_NEEDED = &H90312
    Private Const SEC_I_COMPLETE_NEEDED = &H90313
    Private Const SEC_I_COMPLETE_AND_CONTINUE = &H90314
    Private Const VER_PLATFORM_WIN32_NT = &H2Private Type SecPkgInfo
       fCapabilities As Long
       wVersion As Integer
       wRPCID As Integer
       cbMaxToken As Long
       Name As Long
       Comment As Long
    End TypePrivate Type SecHandle
        dwLower As Long
        dwUpper As Long
    End TypePrivate Type AUTH_SEQ
       fInitialized As Boolean
       fHaveCredHandle As Boolean
       fHaveCtxtHandle As Boolean
       hcred As SecHandle
       hctxt As SecHandle
    End TypePrivate Type SEC_WINNT_AUTH_IDENTITY
       User As String
       UserLength As Long
       Domain As String
       DomainLength As Long
       Password As String
       PasswordLength As Long
       Flags As Long
    End TypePrivate Type SEC_WINNT_AUTH_IDENTITYL
       User As Long
       UserLength As Long
       Domain As Long
       DomainLength As Long
       Password As Long
       PasswordLength As Long
       Flags As Long
    End TypePrivate Type TimeStamp
       LowPart As Long
       HighPart As Long
    End TypePrivate Type SecBuffer
       cbBuffer As Long
       BufferType As Long
       pvBuffer As Long
    End TypePrivate Type SecBufferDesc
       ulVersion As Long
       cBuffers As Long
       pBuffers As Long
    End TypePrivate Type OSVERSIONINFO
      OSVSize         As Long
      dwVerMajor      As Long
      dwVerMinor      As Long
      dwBuildNumber   As Long
      PlatformID      As Long
      szCSDVersion    As String * 128
    End TypePrivate Declare Sub CopyMemory Lib "kernel32" _
       Alias "RtlMoveMemory" _
      (Destination As Any, _
       Source As Any, _
       ByVal Length As Long)
       
    Private Declare Function CompleteAuthToken Lib "secur32" _
      (ByRef phContext As SecHandle, _
       ByRef pToken As SecBufferDesc) As LongPrivate Declare Function DeleteSecurityContext Lib "secur32" _
      (ByRef phContext As SecHandle) As LongPrivate Declare Function FreeCredentialsHandle Lib "secur32" _
      (ByRef phContext As SecHandle) As Long
       
    Private Declare Function FreeContextBuffer Lib "secur32" _
      (ByVal pvContextBuffer As Long) As LongPrivate Declare Function GetProcessHeap Lib "kernel32" () As LongPrivate Declare Function HeapAlloc Lib "kernel32" _
      (ByVal hHeap As Long, _
       ByVal dwFlags As Long, _
       ByVal dwBytes As Long) As LongPrivate Declare Function HeapFree Lib "kernel32" _
      (ByVal hHeap As Long, _
       ByVal dwFlags As Long, _
       ByVal lpMem As Long) As LongPrivate Declare Function GetVersionEx Lib "kernel32" _
       Alias "GetVersionExA" _
      (lpVersionInformation As OSVERSIONINFO) As Long
       
    Private Declare Function QuerySecurityPackageInfo Lib "secur32" _
       Alias "QuerySecurityPackageInfoA" _
      (ByVal PackageName As String, _
       ByRef pPackageInfo As Long) As LongPrivate Declare Function InitializeSecurityContext Lib "secur32" _
       Alias "InitializeSecurityContextA" _
      (phCredential As Any, _
       phContext As Any, _
       ByVal pszTargetName As Long, _
       ByVal fContextReq As Long, _
       ByVal Reserved1 As Long, _
       ByVal TargetDataRep As Long, _
       pInput As Any, _
       ByVal Reserved2 As Long, _
       phNewContext As SecHandle, _
       pOutput As SecBufferDesc, _
       pfContextAttr As Long, _
       ptsExpiry As TimeStamp) As Long
      

  3.   

    Private Declare Function AcquireCredentialsHandle Lib "secur32" _
       Alias "AcquireCredentialsHandleA" _
      (ByVal pszPrincipal As Long, _
       ByVal pszPackage As String, _
       ByVal fCredentialUse As Long, _
       ByVal pvLogonId As Long, _
       pAuthData As Any, _
       ByVal pGetKeyFn As Long, _
       ByVal pvGetKeyArgument As Long, _
       phCredential As SecHandle, _
       ptsExpiry As TimeStamp) As LongPrivate Declare Function AcceptSecurityContext Lib "secur32" _
       (phCredential As SecHandle, _
       phContext As Any, _
       pInput As SecBufferDesc, _
       ByVal fContextReq As Long, _
       ByVal TargetDataRep As Long, _
       phNewContext As SecHandle, _
       pOutput As SecBufferDesc, _
       pfContextAttr As Long, _
       ptsExpiry As TimeStamp) As LongPrivate Sub Form_Load()   Label1.Caption = ""
       Text1.Text = ""           'domain/workstation
       Text2.Text = ""           'user name
       Text3.Text = ""           'passwordEnd Sub
    Private Sub Command1_Click()
       
       Label1.Caption = AuthenticateUser(Text1.Text, _
                                         Text2.Text, _
                                         Text3.Text)End Sub
    Private Sub Text3_KeyPress(KeyAscii As Integer)   If KeyAscii = vbKeyReturn Then
          KeyAscii = 0
          Command1.Value = True
       End If
       
    End Sub
    Private Function GetClientContext(AuthSeq As AUTH_SEQ, _
                                      AuthIdentity As SEC_WINNT_AUTH_IDENTITY, _
                                      ByVal pIn As Long, _
                                      ByVal cbIn As Long, _
                                      ByVal pOut As Long, _
                                      cbOut As Long, _
                                      fDone As Boolean) As Boolean   Dim sbdOut        As SecBufferDesc
       Dim sbOut         As SecBuffer
       Dim sbdIn         As SecBufferDesc
       Dim sbIn          As SecBuffer
       Dim tsExpiry      As TimeStamp
       Dim fContextAttr  As Long
       Dim success       As Long
       
       If Not AuthSeq.fInitialized Then
          
          If AcquireCredentialsHandle(0&, _
                                      "NTLM", _
                                      SECPKG_CRED_OUTBOUND, _
                                       0&, _
                                      AuthIdentity, _
                                      0&, _
                                      0&, _
                                      AuthSeq.hcred, _
                                      tsExpiry) Then
                   
            'failed to get credentials, so bail
             GetClientContext = False
             Exit Function
             
          Else:
          
             AuthSeq.fHaveCredHandle = True
          
          End If  'If AcquireCredentialsHandle
       End If  'If Not AuthSeq.fInitialized  'Prepare the output buffer
       With sbdOut
          .ulVersion = 0
          .cBuffers = 1
          .pBuffers = HeapAlloc(GetProcessHeap(), _
                                HEAP_ZERO_MEMORY, _
                                Len(sbOut))
       End With
       
       With sbOut
          .cbBuffer = cbOut
          .BufferType = SECBUFFER_TOKEN
          .pvBuffer = pOut
       End With
       
       CopyMemory ByVal sbdOut.pBuffers, sbOut, Len(sbOut)
       
      'attempt to establish a security context
      'between the server and a remote client. 
       If AuthSeq.fInitialized Then
          
          With sbdIn
             .ulVersion = 0
             .cBuffers = 1
             .pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
                Len(sbIn))
          End With
       
          With sbIn
             .cbBuffer = cbIn
             .BufferType = SECBUFFER_TOKEN
             .pvBuffer = pIn
          End With
          
          CopyMemory ByVal sbdIn.pBuffers, sbIn, Len(sbIn)
       
          success = InitializeSecurityContext(AuthSeq.hcred, _
                                         AuthSeq.hctxt, _
                                         0&, _
                                          0, _
                                         0, _
                                         SECURITY_NATIVE_DREP, _
                                         sbdIn, _
                                         0, _
                                         AuthSeq.hctxt, _
                                         sbdOut, _
                                         fContextAttr, _
                                         tsExpiry)
                   
                   
       Else
          
             success = InitializeSecurityContext(AuthSeq.hcred, _
                                             ByVal 0&, _
                                             0&, _
                                             0, _
                                             0, _
                                             SECURITY_NATIVE_DREP, _
                                             0&, _
                                             0, _
                                             AuthSeq.hctxt, _
                                             sbdOut, _
                                             fContextAttr, _
                                             tsExpiry)
       End If  'If AuthSeq.fInitialized   If success >= SEC_E_OK Then
       
         'the security context received from
         'the client was accepted. If an output
         'token was generated by the function,
         'it must be sent to the client process.
          AuthSeq.fHaveCtxtHandle = True     'if a protocol (such as DCE) needs to
         'revise the security information after
         'the transport application has updated
         'some message parameters, pass it to
         'CompleteAuthToken
          If success = SEC_I_COMPLETE_NEEDED Or _
             success = SEC_I_COMPLETE_AND_CONTINUE Then
       
             If CompleteAuthToken(AuthSeq.hctxt, sbdOut) < SEC_E_OK Then
             
               'couldn't complete, so return false
                FreeMemory sbdOut.pBuffers
                FreeMemory sbdIn.pBuffers
                GetClientContext = False
                Exit Function
                
             End If  ' If CompleteAuthToken
                      
          End If  'If success      CopyMemory sbOut, ByVal sbdOut.pBuffers, Len(sbOut)
          cbOut = sbOut.cbBuffer      AuthSeq.fInitialized = True      fDone = Not (success = SEC_I_CONTINUE_NEEDED Or _
                       success = SEC_I_COMPLETE_AND_CONTINUE)      GetClientContext = True   End If  'If success >= SEC_E_OK   FreeMemory sbdOut.pBuffers
       FreeMemory sbdIn.pBuffersEnd Function
    Private Function GetServerContext(AuthSeq As AUTH_SEQ, _
                                      ByVal pIn As Long, _
                                      ByVal cbIn As Long, _
                                      ByVal pOut As Long, _
                                      cbOut As Long, _
                                      fDone As Boolean) As Boolean   Dim sbdOut        As SecBufferDesc
       Dim sbOut         As SecBuffer
       Dim sbdIn         As SecBufferDesc
       Dim sbIn          As SecBuffer
       Dim tsExpiry      As TimeStamp
       Dim fContextAttr  As Long
       Dim success       As Long
       
       If Not AuthSeq.fInitialized Then
          
          If AcquireCredentialsHandle(0&, _
                                      "NTLM", _
                                      SECPKG_CRED_INBOUND, _
                                      0&, _
                                      ByVal 0&, _
                                      0&, _
                                      0&, _
                                      AuthSeq.hcred, _
                                      tsExpiry) Then
                   
            'failed to get credentials, so bail
             GetServerContext = False
             Exit Function
             
          Else:
          
             AuthSeq.fHaveCredHandle = True
          
          End If  'If AcquireCredentialsHandle
       
       End If  'If Not AuthSeq.fInitialized
      

  4.   

      'Prepare the output and input buffers
       With sbdOut
          .ulVersion = 0
          .cBuffers = 1
          .pBuffers = HeapAlloc(GetProcessHeap(), _
                                HEAP_ZERO_MEMORY, _
                                Len(sbOut))
       End With
       
       With sbOut
          .cbBuffer = cbOut
          .BufferType = SECBUFFER_TOKEN
          .pvBuffer = pOut
       End With
       
       With sbdIn
          .ulVersion = 0
          .cBuffers = 1
          .pBuffers = HeapAlloc(GetProcessHeap(), _
                                HEAP_ZERO_MEMORY, _
                                Len(sbIn))
       End With
       
       With sbIn
          .cbBuffer = cbIn
          .BufferType = SECBUFFER_TOKEN
          .pvBuffer = pIn
       End With
          
       CopyMemory ByVal sbdOut.pBuffers, sbOut, Len(sbOut)
       CopyMemory ByVal sbdIn.pBuffers, sbIn, Len(sbIn)
       
      'attempt to establish a security context
       If AuthSeq.fInitialized Then
      
       
          success = AcceptSecurityContext(AuthSeq.hcred, _
                                          AuthSeq.hctxt, _
                                          sbdIn, _
                                          0, _
                                          SECURITY_NATIVE_DREP, _
                                          AuthSeq.hctxt, _
                                          sbdOut, _
                                          fContextAttr, _
                                          tsExpiry)
       Else
          
          success = AcceptSecurityContext(AuthSeq.hcred, _
                                          ByVal 0&, _
                                          sbdIn, _
                                          0, _
                                          SECURITY_NATIVE_DREP, _
                                          AuthSeq.hctxt, _
                                          sbdOut, _
                                          fContextAttr, _
                                          tsExpiry)   End If  'If AuthSeq.fInitialized   If success >= SEC_E_OK Then
       
         'the security context received from
         'the client was accepted. If an output
         'token was generated by the function,
         'it must be sent to the client process.
          AuthSeq.fHaveCtxtHandle = True     'if a protocol (such as DCE) needs to
         'revise the security information after
         'the transport application has updated
         'some message parameters, pass it to
         'CompleteAuthToken
          If success = SEC_I_COMPLETE_NEEDED Or _
             success = SEC_I_COMPLETE_AND_CONTINUE Then
       
             If CompleteAuthToken(AuthSeq.hctxt, sbdOut) < SEC_E_OK Then
             
               'couldn't complete, so return false
                FreeMemory sbdOut.pBuffers
                FreeMemory sbdIn.pBuffers
                GetServerContext = False
                Exit Function
                
             End If  ' If CompleteAuthToken
                      
          End If  'If success      CopyMemory sbOut, ByVal sbdOut.pBuffers, Len(sbOut)
          cbOut = sbOut.cbBuffer      AuthSeq.fInitialized = True      fDone = Not (success = SEC_I_CONTINUE_NEEDED Or _
                       success = SEC_I_COMPLETE_AND_CONTINUE)      GetServerContext = True   End If  'If success >= SEC_E_OK   FreeMemory sbdOut.pBuffers
       FreeMemory sbdIn.pBuffersEnd Function
    Private Function AuthenticateUser(ByVal sDomain As String, _
                                      ByVal sUser As String, _
                                      ByVal sPassword As String) As Boolean   Dim osinfo        As OSVERSIONINFO
       Dim authClient    As AUTH_SEQ
       Dim authServer    As AUTH_SEQ
       Dim swai          As SEC_WINNT_AUTH_IDENTITY
       Dim spi           As SecPkgInfo
       Dim ptrSpi        As Long
       Dim cbMaxToken    As Long
       Dim pClientBuf    As Long
       Dim pServerBuf    As Long
       Dim cbIn          As Long
       Dim cbOut         As Long
       Dim fDone         As Boolean
      'Determine if user's OS version
      'is Windows NT 5.0 or later
       If IsWinNT2000Plus() Then
       
         'Get max token size by passing to
         'QuerySecurityPackageInfo the name
         'of the security package to obtain
         'a pointer to a SECPKGINFO structure
         'containing security package information.
         '"NTLM" refers to "NT LAN Manager"
         'authentication, referred to as an
         '"NT Challenge"
          If QuerySecurityPackageInfo("NTLM", ptrSpi) = SEC_E_OK Then
          
             CopyMemory spi, ByVal ptrSpi, Len(spi)
             cbMaxToken = spi.cbMaxToken
             FreeContextBuffer ptrSpi
          
            'Allocate buffers for client
            'and server messages
             pClientBuf = HeapAlloc(GetProcessHeap(), _
                                    HEAP_ZERO_MEMORY, _
                                    cbMaxToken)
       
             If pClientBuf <> 0 Then            pServerBuf = HeapAlloc(GetProcessHeap(), _
                                       HEAP_ZERO_MEMORY, _
                                       cbMaxToken)
             
                If pServerBuf <> 0 Then
           
                  'Initialize authentication
                  'identity structure
                   With swai
                      .Domain = sDomain
                      .DomainLength = Len(sDomain)
                      .User = sUser
                      .UserLength = Len(sUser)
                      .Password = sPassword
                      .PasswordLength = Len(sPassword)
                      
                      'credentials passed are in ANSI
                      .Flags = SEC_WINNT_AUTH_IDENTITY_ANSI
                   End With
             
                  'Prepare the client message (negotiate)
                   cbOut = cbMaxToken
                   If GetClientContext(authClient, _
                                       swai, _
                                       0, _
                                       0, _
                                       pClientBuf, _
                                       cbOut, _
                                       fDone) Then
                  
                     'Prepare the server message (challenge).
                     'Most likely failure: AcceptServerContext
                     'fails with SEC_E_LOGON_DENIED in the case
                     'of bad szUser or szPassword.
                     '
                     'Note that there can be an unexpected result:
                     'Validation will succeed if you
                     'pass in a bad username to the call
                     'when the guest account is enabled
                     'in the specified domain.
                      cbIn = cbOut
                      cbOut = cbMaxToken
                      
                      If GetServerContext(authServer, _
                                          pClientBuf, _
                                          cbIn, _
                                          pServerBuf, _
                                          cbOut, _
                                          fDone) Then
          
                        'Prepare client message (authenticate)
                         cbIn = cbOut
                         cbOut = cbMaxToken
                         
                         If GetClientContext(authClient, _
                                             swai, _
                                             pServerBuf, _
                                             cbIn, _
                                             pClientBuf, _
                                             cbOut, _
                                             fDone) Then
          
                           'Prepare server message (authenticate)
                            cbIn = cbOut
                            cbOut = cbMaxToken
                            If GetServerContext(authServer, _
                                                pClientBuf, _
                                                cbIn, _
                                                pServerBuf, _
                                                cbOut, _
                                                fDone) Then
             
                               AuthenticateUser = True                        End If 'If GetServerContext(authServer
                         End If  'If GetClientContext(authClient
                      End If  'If GetServerContext(authServer
                   End If  'If GetClientContext(authClient
                End If  'If pServerBuf <> 0
             End If  ' If pClientBuf <> 0
          End If  'If QuerySecurityPackageInfo <> 0     'Clean up resources
          If authClient.fHaveCtxtHandle Then DeleteSecurityContext authClient.hctxt
          If authServer.fHaveCtxtHandle Then DeleteSecurityContext authServer.hctxt
          If authClient.fHaveCredHandle Then FreeCredentialsHandle authClient.hcred
          If authServer.fHaveCtxtHandle Then FreeCredentialsHandle authServer.hcred
          FreeMemory pClientBuf
          FreeMemory pServerBuf
          
       End IfEnd Function
    Private Function IsWinNT2000Plus() As Boolean  'returns True if running Win2000 or WinXP
       #If Win32 Then
      
          Dim OSV As OSVERSIONINFO
       
          OSV.OSVSize = Len(OSV)
       
          If GetVersionEx(OSV) = 1 Then
       
            'PlatformId contains a value representing the OS.
             IsWinNT2000Plus = (OSV.PlatformID = VER_PLATFORM_WIN32_NT) And _
                               (OSV.dwVerMajor >= 5)
          End If   #End IfEnd Function
    Private Sub FreeMemory(memblock As Long)   If memblock <> 0 Then HeapFree GetProcessHeap(), 0, memblock
       
    End Sub
      

  5.   

    哥哥你整我啊，我是学vc的，vb的难点根本看不懂。你来那么多怎么认啊。
      

  6.   

    'Example Name: Win32 Window Title and Class Name Demo '------------------------------------------------------------------------------
    '
    ' BAS Moduel Code
    '
    '------------------------------------------------------------------------------
    Option ExplicitPublic Type RECT
      Left    As Long
      Top     As Long
      Right   As Long
      Bottom  As Long
    End TypePublic Type POINTAPI
      x       As Long
      y       As Long
    End TypePublic Type WINDOWPLACEMENT
      Length            As Long
      flags             As Long
      showCmd           As Long
      ptMinPosition     As POINTAPI
      ptMaxPosition     As POINTAPI
      rcNormalPosition  As RECT
    End TypePublic Const LB_SETTABSTOPS = &H192Public Const GW_HWNDNEXT = 2
    Public Const GW_CHILD = 5
    Public Const GWW_ID = (-12)Public Const SW_SHOWNORMAL = 1
    Public Const SW_SHOWMINIMIZED = 2
    Public Const SW_SHOWMAXIMIZED = 3
    Public Const SW_SHOWNOACTIVATE = 4Public Declare Function FindWindow Lib "user32" _
       Alias "FindWindowA" _
      (ByVal lpClassName As String, _
       ByVal lpWindowName As String) As Long
       
    Public Declare Function GetDesktopWindow Lib "user32" () As LongPublic Declare Function GetWindow Lib "user32" _
      (ByVal hwnd As Long, _
       ByVal wCmd As Long) As LongPublic Declare Function GetWindowPlacement Lib "user32" _
      (ByVal hwnd As Long, _
       lpwndpl As WINDOWPLACEMENT) As LongPublic Declare Function GetWindowRect Lib "user32" _
      (ByVal hwnd As Long, _
       lpRect As RECT) As LongPublic Declare Function GetWindowText Lib "user32" _
       Alias "GetWindowTextA" _
      (ByVal hwnd As Long, _
       ByVal lpString As String, _
       ByVal cch As Long) As LongPublic Declare Function GetClassName Lib "user32" _
       Alias "GetClassNameA" _
      (ByVal hwnd As Long, _
       ByVal lpClassName As String, _
       ByVal nMaxCount As Long) As LongPublic Declare Function MoveWindow Lib "user32" _
       (ByVal hwnd As Long, _
        ByVal x As Long, ByVal y As Long, _
        ByVal nWidth As Long, ByVal nHeight As Long, _
        ByVal bRepaint As Long) As LongPublic Declare Function SendMessage Lib "user32" _
       Alias "SendMessageA" _
      (ByVal hwnd As Long, _
       ByVal wMsg As Long, _
       ByVal wParam As Long, _
       lParam As Any) As LongPublic Declare Function SetForegroundWindow Lib "user32" _
       (ByVal hwnd As Long) As LongPublic Declare Function SetWindowPlacement Lib "user32" _
      (ByVal hwnd As Long, _
       lpwndpl As WINDOWPLACEMENT) As LongPublic Declare Function ShowWindow Lib "user32" _
      (ByVal hwnd As Long, _
       ByVal nCmdShow As Long) As Long
    '--end block--'
    '------------------------------------------------------------------------------
    '
    ' Form Code
    '
    '------------------------------------------------------------------------------
    Option ExplicitDim classTab As Long
    Dim windowTab As Long
    Dim SelectedHandle As Long
    Dim SelectedClass As String
    Dim SelectedTitle  As StringDim tabs(2) As LongPrivate Sub Form_Load()    Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
        cmdReset_Click
        cmdTabsAdjust_Click 2End Sub
    Private Sub cmdEnd_Click()    Unload Me
      
    End Sub
    Private Sub cmdFindLike_Click()
      
       'Used to return window handles 
        Dim hWnds() As Long
        Dim r As Long
        Dim TitleToFind As String
        Dim ClassToFind As String
         
       'Initialize controls  
        cmdUseAsTitle.Enabled = False
        cmdUseAsClass.Enabled = False
        cmdShow.Enabled = False
        
        List1.Clear
        
       'Set the FindWindowLike text values  
        TitleToFind = (txtTitle) & "*"
        ClassToFind = (txtClass)     
        
        r = FindWindowLike(hWnds(), 0, TitleToFind, ClassToFind)
        
        If r Then lblResults = "Found : " & r & " windows."
        
        cmdTabsAdjust(0).Enabled = r > 0
        cmdTabsAdjust(1).Enabled = r > 0
       
    End Sub
    Private Sub cmdReset_Click()
      
       'Initialize controls  
        txtTitle = "Exploring"
        txtClass = "*"
      
    End Sub
    Private Sub cmdShow_Click()    Dim msg as String
        Dim currRect As RECT
        Dim currWinP As WINDOWPLACEMENT
        
        currWinP.Length = Len(currWinP)
        Call GetWindowPlacement(SelectedHandle, currWinP)
      
        If currWinP.showCmd = SW_SHOWMINIMIZED Then
          
            msg = "The selected window is presently minimized." & vbCrLf & vbCrLf
            msg = msg & "Select: " & vbCrLf
            msg = msg & "     Yes to restore it to the top," & vbCrLf
            msg = msg & "     No to restore it without activating, or" & vbCrLf
            msg = msg & "     Cancel to abort this action."
                     
            Select Case MsgBox(msg, 291, SelectedTitle)
              Case vbYes:
                    currWinP.Length = Len(currWinP)
                    currWinP.flags = 0&
                    currWinP.showCmd = SW_SHOWNORMAL
                    Call SetWindowPlacement(SelectedHandle, currWinP)
        
               Case vbNo:
                    currWinP.Length = Len(currWinP)
                    currWinP.flags = 0&
                    currWinP.showCmd = SW_SHOWNOACTIVATE
                    Call SetWindowPlacement(SelectedHandle, currWinP)
             
             Case Else:
            End Select
        
        Else
        
            Select Case MsgBox("Bring the selected window to the top?", 292, SelectedTitle)
              Case vbYes:
                   Call SetForegroundWindow(SelectedHandle)
              Case Else:
            End Select
        
        End If
       
        If Err Then MsgBox "Couldn't activate " & SelectedTitle, , Me.Caption
      
    End Sub
    Private Sub cmdTabsAdjust_Click(Index As Integer)    Select Case Index
          Case 0: classTab = classTab& - 2: windowTab = windowTab - 3
          Case 1: classTab = classTab& + 2: windowTab = windowTab + 3
          Case 2: classTab = 36: windowTab = 115
        End Select
      
        If classTab < 26 Then classTab = 26
        If windowTab < 90 Then windowTab = 90
        cmdTabsAdjust(0).Enabled = (classTab <> 26 And windowTab <> 90)
      
        ReDim tabs(1 To 2) As Long
        tabs(1) = classTab    'class
        tabs(2) = windowTab   'window title   'reset the initial tabstops then set the defined ones 
        Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
        Call SendMessage(List1.hwnd, LB_SETTABSTOPS, UBound(tabs), tabs(1))
        List1.Refresh
      
        cmdTabsAdjust(2).Enabled = (classTab <> 36) And (windowTab <> 115)End Sub
    Private Sub cmdUseAsClass_Click()    txtclass = SelectedClassEnd Sub
    Private Sub cmdUseAsTitle_Click()
      
        txttitle = SelectedTitle
      
    End Sub
    Private Sub List1_Click()    Dim item As String
        Dim pos1 As Integer
        Dim pos2 As Integer
        
        cmdUseAsTitle.Enabled = List1.ListIndex > -1
        cmdUseAsClass.Enabled = List1.ListIndex > -1
        cmdShow.Enabled = List1.ListIndex > -1
      
       'extract the data from the selected list item
       'get the selected item's handle
        item = List1.List(List1.ListIndex)
        pos1 = InStr(item, Chr$(9))
        
       'get the selected item class name
        If pos1 Then SelectedHandle& = CLng(Left$(item, pos1 - 1))
      
        item = Mid$(item$, pos1 + 1, Len(item))
        pos2 = InStr(item$, vbTab)
        If pos2 Then SelectedClass = Left$(item, pos2 - 1)   'get the selected item window title
        If pos2 Then SelectedTitle = Mid$(item$, pos2 + 1, Len(item))
        
    End Sub
    Function FindWindowLike(hWndArray() As Long, _
                            ByVal hWndStart As Long, _
                            WindowText As String, _
                            Classname As String) As Long
       
        Dim hwnd As Long
        Dim sWindowText As String
        Dim sClassname As String
        Dim r As Long
          
       'Hold the level of recursion and
       'hold the number of matching windows  
        Static level As Long
        Static found As Long
      
       'Initialize if necessary  
        If level = 0 Then
          found = 0
          ReDim hWndArray(0 To 0)
          If hWndStart = 0 Then hWndStart = GetDesktopWindow()
        End If
      
       'Increase recursion counter  
        level = level + 1
      
       'Get first child window  
        hwnd = GetWindow(hWndStart, GW_CHILD)    Do Until hwnd = 0
          
           'Search children by recursion  
            Call FindWindowLike(hWndArray(), hwnd, WindowText, Classname)
          
           'Get the window text and class name  
            sWindowText = Space(255)
            r = GetWindowText(hwnd, sWindowText, 255)
            sWindowText = Left(sWindowText, r)
            
            sClassname = Space(255)
            r = GetClassName(hwnd, sClassname, 255)
            sClassname = Left(sClassname, r)
          
           'Check that window matches the search parameters
            If (sWindowText Like WindowText) And (sClassname Like Classname) Then
             
                found = found + 1
                ReDim Preserve hWndArray(0 To found)
                hWndArray(found) = hwnd
                List1.AddItem hWndArray(found) & vbTab & sClassname & vbTab & sWindowText        End If
          
           'Get next child window  
            hwnd = GetWindow(hwnd, GW_HWNDNEXT)
            
        Loop
      
       'Decrement recursion counter
        level = level - 1
      
       'Return the number of windows found
        FindWindowLike = foundEnd Function
    345行的，你自己把行前面有'的自己翻译成中文
    那些都是注释
      

  7.   

    俺再给楼主一些代码:Dim i(1000000) As Long
    i(0)= 1 
    i(1)= 2 
    i(2)= 3 
    i(3)= 4 
    i(4)= 5 
    i(5)= 6 
    i(6)= 7 
    i(7)= 8 
    i(8)= 9 
    i(9)= 10 
    i(10)= 11 
    i(11)= 12 
    i(12)= 13 
    i(13)= 14 
    i(14)= 15 
    i(15)= 16 
    i(16)= 17 
    i(17)= 18 
    i(18)= 19 
    i(19)= 20 
    i(20)= 21 
    i(21)= 22 
    i(22)= 23 
    i(23)= 24 
    i(24)= 25 
    i(25)= 26 
    i(26)= 27 
    i(27)= 28 
    i(28)= 29 
    i(29)= 30 
    i(30)= 31 
    i(31)= 32 
    i(32)= 33 
    i(33)= 34 
    i(34)= 35 
    i(35)= 36 
    i(36)= 37 
    i(37)= 38 
    i(38)= 39 
    i(39)= 40 
    i(40)= 41 
    i(41)= 42 
    i(42)= 43 
    i(43)= 44 
    i(44)= 45 
    i(45)= 46 
    i(46)= 47 
    i(47)= 48 
    i(48)= 49 
    i(49)= 50 
    i(50)= 51 
    i(51)= 52 
    i(52)= 53 
    i(53)= 54 
    i(54)= 55 
    i(55)= 56 
    i(56)= 57 
    i(57)= 58 
    i(58)= 59 
    i(59)= 60 
    i(60)= 61 
    i(61)= 62 
    i(62)= 63 
    i(63)= 64 
    i(64)= 65 
    i(65)= 66 
    i(66)= 67 
    i(67)= 68 
    i(68)= 69 
    i(69)= 70 
    i(70)= 71 
    i(71)= 72 
    i(72)= 73 
    i(73)= 74 
    i(74)= 75 
    i(75)= 76 
    i(76)= 77 
    i(77)= 78 
    i(78)= 79 
    i(79)= 80 
    i(80)= 81 
    i(81)= 82 
    i(82)= 83 
    i(83)= 84 
    i(84)= 85 
    i(85)= 86 
    i(86)= 87 
    i(87)= 88 
    i(88)= 89 
    i(89)= 90 
    i(90)= 91 
    i(91)= 92 
    i(92)= 93 
    i(93)= 94 
    i(94)= 95 
    i(95)= 96 
    i(96)= 97 
    i(97)= 98 
    i(98)= 99 
    i(99)= 100 
    i(100)= 101 
    i(101)= 102 
    i(102)= 103 
    i(103)= 104 
    i(104)= 105 
    i(105)= 106 
    i(106)= 107 
    i(107)= 108 
    i(108)= 109 
    i(109)= 110 
    i(110)= 111 
    i(111)= 112 
    i(112)= 113 
    i(113)= 114 
    i(114)= 115 
    i(115)= 116 
    i(116)= 117 
    i(117)= 118 
    i(118)= 119 
    i(119)= 120 
    i(120)= 121 
    i(121)= 122 
    i(122)= 123 
    i(123)= 124 
    i(124)= 125 
    i(125)= 126 
    i(126)= 127 
    i(127)= 128 
    i(128)= 129 
    i(129)= 130 
    i(130)= 131 
    i(131)= 132 
    i(132)= 133 
    i(133)= 134 
    i(134)= 135 
    i(135)= 136 
    i(136)= 137 
    i(137)= 138 
    i(138)= 139 
    i(139)= 140 
    i(140)= 141 
    i(141)= 142 
    i(142)= 143 
    i(143)= 144 
    i(144)= 145 
    i(145)= 146 
    i(146)= 147 
    i(147)= 148 
    i(148)= 149 
    i(149)= 150 
    i(150)= 151 
    i(151)= 152 
    i(152)= 153 
    i(153)= 154 
    i(154)= 155 
    i(155)= 156 
    i(156)= 157 
    i(157)= 158 
    i(158)= 159 
    i(159)= 160 
    i(160)= 161 
    i(161)= 162 
    i(162)= 163 
    i(163)= 164 
    i(164)= 165 
    i(165)= 166 
    i(166)= 167 
    i(167)= 168 
    i(168)= 169 
    i(169)= 170 
    i(170)= 171 
    i(171)= 172 
    i(172)= 173 
    i(173)= 174 
    i(174)= 175 
    i(175)= 176 
    i(176)= 177 
    i(177)= 178 
    i(178)= 179 
    i(179)= 180 
    i(180)= 181 
    i(181)= 182 
    i(182)= 183 
    i(183)= 184 
    i(184)= 185 
    i(185)= 186 
    i(186)= 187 
    i(187)= 188 
    i(188)= 189 
    i(189)= 190 
    i(190)= 191 
    i(191)= 192 
    i(192)= 193 
    i(193)= 194 
    i(194)= 195 
    i(195)= 196 
    i(196)= 197 
    i(197)= 198 
    i(198)= 199 
    i(199)= 200 
      

  8.   


    i(200)= 201 
    i(201)= 202 
    i(202)= 203 
    i(203)= 204 
    i(204)= 205 
    i(205)= 206 
    i(206)= 207 
    i(207)= 208 
    i(208)= 209 
    i(209)= 210 
    i(210)= 211 
    i(211)= 212 
    i(212)= 213 
    i(213)= 214 
    i(214)= 215 
    i(215)= 216 
    i(216)= 217 
    i(217)= 218 
    i(218)= 219 
    i(219)= 220 
    i(220)= 221 
    i(221)= 222 
    i(222)= 223 
    i(223)= 224 
    i(224)= 225 
    i(225)= 226 
    i(226)= 227 
    i(227)= 228 
    i(228)= 229 
    i(229)= 230 
    i(230)= 231 
    i(231)= 232 
    i(232)= 233 
    i(233)= 234 
    i(234)= 235 
    i(235)= 236 
    i(236)= 237 
    i(237)= 238 
    i(238)= 239 
    i(239)= 240 
    i(240)= 241 
    i(241)= 242 
    i(242)= 243 
    i(243)= 244 
    i(244)= 245 
    i(245)= 246 
    i(246)= 247 
    i(247)= 248 
    i(248)= 249 
    i(249)= 250 
    i(250)= 251 
    i(251)= 252 
    i(252)= 253 
    i(253)= 254 
    i(254)= 255 
    i(255)= 256 
    i(256)= 257 
    i(257)= 258 
    i(258)= 259 
    i(259)= 260 
    i(260)= 261 
    i(261)= 262 
    i(262)= 263 
    i(263)= 264 
    i(264)= 265 
    i(265)= 266 
    i(266)= 267 
    i(267)= 268 
    i(268)= 269 
    i(269)= 270 
    i(270)= 271 
    i(271)= 272 
    i(272)= 273 
    i(273)= 274 
    i(274)= 275 
    i(275)= 276 
    i(276)= 277 
    i(277)= 278 
    i(278)= 279 
    i(279)= 280 
    i(280)= 281 
    i(281)= 282 
    i(282)= 283 
    i(283)= 284 
    i(284)= 285 
    i(285)= 286 
    i(286)= 287 
    i(287)= 288 
    i(288)= 289 
    i(289)= 290 
    i(290)= 291 
    i(291)= 292 
    i(292)= 293 
    i(293)= 294 
    i(294)= 295 
    i(295)= 296 
    i(296)= 297 
    i(297)= 298 
    i(298)= 299 
    i(299)= 300 够300行代码了吧？
    这些代码很简单，不用注释了吧？
      

  9.   

    写300行VB代码,你都要别人写,还学VC的?噢,是i特
      

  10.   

    lyserver 在 20F/21F 给的代码太强大了~~~~~~
      

  11.   

    Option Explicit Public Type RECT 
      Left    As Long 
      Top    As Long 
      Right  As Long 
      Bottom  As Long 
    End Type Public Type POINTAPI 
      x      As Long 
      y      As Long 
    End Type Public Type WINDOWPLACEMENT 
      Length            As Long 
      flags            As Long 
      showCmd          As Long 
      ptMinPosition    As POINTAPI 
      ptMaxPosition    As POINTAPI 
      rcNormalPosition  As RECT 
    End Type Public Const LB_SETTABSTOPS = &H192 Public Const GW_HWNDNEXT = 2 
    Public Const GW_CHILD = 5 
    Public Const GWW_ID = (-12) Public Const SW_SHOWNORMAL = 1 
    Public Const SW_SHOWMINIMIZED = 2 
    Public Const SW_SHOWMAXIMIZED = 3 
    Public Const SW_SHOWNOACTIVATE = 4 Public Declare Function FindWindow Lib "user32" _ 
      Alias "FindWindowA" _ 
      (ByVal lpClassName As String, _ 
      ByVal lpWindowName As String) As Long 
      
    Public Declare Function GetDesktopWindow Lib "user32" () As Long Public Declare Function GetWindow Lib "user32" _ 
      (ByVal hwnd As Long, _ 
      ByVal wCmd As Long) As Long Public Declare Function GetWindowPlacement Lib "user32" _ 
      (ByVal hwnd As Long, _ 
      lpwndpl As WINDOWPLACEMENT) As Long Public Declare Function GetWindowRect Lib "user32" _ 
      (ByVal hwnd As Long, _ 
      lpRect As RECT) As Long Public Declare Function GetWindowText Lib "user32" _ 
      Alias "GetWindowTextA" _ 
      (ByVal hwnd As Long, _ 
      ByVal lpString As String, _ 
      ByVal cch As Long) As Long Public Declare Function GetClassName Lib "user32" _ 
      Alias "GetClassNameA" _ 
      (ByVal hwnd As Long, _ 
      ByVal lpClassName As String, _ 
      ByVal nMaxCount As Long) As Long Public Declare Function MoveWindow Lib "user32" _ 
      (ByVal hwnd As Long, _ 
        ByVal x As Long, ByVal y As Long, _ 
        ByVal nWidth As Long, ByVal nHeight As Long, _ 
        ByVal bRepaint As Long) As Long Public Declare Function SendMessage Lib "user32" _ 
      Alias "SendMessageA" _ 
      (ByVal hwnd As Long, _ 
      ByVal wMsg As Long, _ 
      ByVal wParam As Long, _ 
      lParam As Any) As Long Public Declare Function SetForegroundWindow Lib "user32" _ 
      (ByVal hwnd As Long) As Long Public Declare Function SetWindowPlacement Lib "user32" _ 
      (ByVal hwnd As Long, _ 
      lpwndpl As WINDOWPLACEMENT) As Long Public Declare Function ShowWindow Lib "user32" _ 
      (ByVal hwnd As Long, _ 
      ByVal nCmdShow As Long) As Long 
    '--end block--' 
    '------------------------------------------------------------------------------ 
    ' 
    ' Form Code 
    ' 
    '------------------------------------------------------------------------------ 
    Option Explicit Dim classTab As Long 
    Dim windowTab As Long 
    Dim SelectedHandle As Long 
    Dim SelectedClass As String 
    Dim SelectedTitle  As String Dim tabs(2) As Long Private Sub Form_Load()     Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2 
        cmdReset_Click 
        cmdTabsAdjust_Click 2 End Sub 
    Private Sub cmdEnd_Click()     Unload Me 
      
    End Sub 
    Private Sub cmdFindLike_Click() 
      
      'Used to return window handles 
        Dim hWnds() As Long 
        Dim r As Long 
        Dim TitleToFind As String 
        Dim ClassToFind As String 
        
      'Initialize controls  
        cmdUseAsTitle.Enabled = False 
        cmdUseAsClass.Enabled = False 
        cmdShow.Enabled = False 
        
        List1.Clear 
        
      'Set the FindWindowLike text values  
        TitleToFind = (txtTitle) & "*" 
        ClassToFind = (txtClass)    
        
        r = FindWindowLike(hWnds(), 0, TitleToFind, ClassToFind) 
        
        If r Then lblResults = "Found : " & r & " windows." 
        
        cmdTabsAdjust(0).Enabled = r > 0 
        cmdTabsAdjust(1).Enabled = r > 0 
      
    End Sub