vb 有内存溢出

[zenmirco]

只要是执行下面这段代码 内存就会不停的增加，我应该怎么调整下才能够不让内存溢出呢？

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long

Private Sub Form_Load()
 Me.BorderStyle = 0
 Me.Caption = ""
 Me.WindowState = 2
End Sub

Private Sub Timer1_Timer()
If FindWindow("TFormLogin", vbNullString) <> 0 Then
Timer2.Enabled = True
Timer1.Enabled = False
End If
End Sub

Private Sub Timer2_Timer()
If FindProcess("BJMain.exe") = 0 Then
Timer2.Enabled = False
Unload Form6
End If
End Sub
Private Sub form6_unload()
Timer1.Enabled = False
Timer2.Enabled = False
   Set Form6 = Nothing
End Sub

[东方之珠]

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long

Private Sub Form_Load()
 Me.BorderStyle = 0
 Me.Caption = ""
 Me.WindowState = 2
End Sub

Private Sub Command1_Click()
    If FindWindow("TFormLogin", vbNullString) <> 0 Then
       call Command2_Click
    End If
End Sub

Private Sub Command2_Click()
    If FindProcess("BJMain.exe") = 0 Then
       call form6_unload
    End If
End Sub
Private Sub form6_unload()
    Set Form6 = Nothing
End Sub

[zenmirco]

引用 1 楼 chenjl1031 的回复:

Visual Basic code?123456789101112131415161718192021222324Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) A……

你这样把定时器改成command 我怎么能让系统自动判断窗体及进程存不存在呢？

[东方之珠]

通过枚举进程可以找到指定进程： 标准模块：

Option Explicit
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function NtQuerySystemInformation Lib "NTDLL.DLL" (ByVal dwInfoType As Long, lpStructure As Any, ByVal dwSize As Long, dwReserved As Long) As Long

Public Type LARGE_INTEGER
    LowPart As Long
    HighPart As Long
End Type
Public Type IO_COUNTERS
    ReadOperationCount As LARGE_INTEGER
    WriteOperationCount As LARGE_INTEGER
    OtherOperationCount As LARGE_INTEGER
    ReadTransferCount As LARGE_INTEGER
    WriteTransferCount As LARGE_INTEGER
    OtherTransferCount As LARGE_INTEGER
End Type
Public Type VM_COUNTERS
    PeakVirtualSize As Long
    VirtualSize As Long
    PageFaultCount As Long
    PeakWorkingSetSize As Long
    WorkingSetSize As Long
    QuotaPeakPagedPoolUsage As Long
    QuotaPagedPoolUsage As Long
    QuotaPeakNonPagedPoolUsage As Long
    QuotaNonPagedPoolUsage As Long
    PagefileUsage As Long
    PeakPagefileUsage As Long
End Type
Public Type CLIENT_ID
    UniqueProcess As Long
    UniqueThread As Long
End Type

Public Type SYSTEM_THREAD_INFORMATION
    KernelTime As LARGE_INTEGER
    UserTime As LARGE_INTEGER
    CreateTime As LARGE_INTEGER
    WaitTime As Long
    StartAddress As Long 'pointer
    ClientId As CLIENT_ID
    Priority As Long
    BasePriority As Long
    ContextSwitchCount As Long
    State As Long 'THREAD_STATE
    WaitReason As Long 'KWAIT_REASON
End Type


Public Type UNICODE_STRING
    Length As Integer
    MaximumLength As Integer
    buffer As Long
End Type

Public Type SYSTEM_PROCESS_INFORMATION
    NextEntryDelta As Long
    ThreadCount As Long
    Reserved1(5) As Long
    CreateTime As LARGE_INTEGER
    UserTime As LARGE_INTEGER
    KernelTime As LARGE_INTEGER
    ProcessName As UNICODE_STRING
    BasePriority As Long
    ProcessID As Long
    InheritedFromProcessId As Long
    HandleCount As Long
    Reserved2(1) As Long
    VmCounters As VM_COUNTERS
    IoCounters As IO_COUNTERS
    Threads(0) As SYSTEM_THREAD_INFORMATION
End Type

Public Const SystemProcessesAndThreadsInformation = 5

Public Function Li2Double(X As LARGE_INTEGER) As Double
        Li2Double = CDbl(X.HighPart) * 4294967296# + CDbl(X.LowPart)
End Function

Form1窗体模块：

Option Explicit

Private Sub Command1_Click()
    Dim Process As SYSTEM_PROCESS_INFORMATION '进程结构
    Dim buf() As Byte '接受信息BYTE
    Dim buffer As Long '缓冲区长度
    Dim NextProcess As Long '下个进程偏移量
    Dim ProcessName As String '进程名
    
    buffer = LenB(Process)
    ReDim buf(buffer)
    
    Do While NtQuerySystemInformation(SystemProcessesAndThreadsInformation, buf(0), buffer, 0)
        buffer = buffer * 2
        ReDim buf(buffer)
    Loop
    '执行成功后
    CopyMemory Process, buf(0), LenB(Process) '复制BYTE数据到进程结构
    
    Do While Process.NextEntryDelta <> 0 '如果存在下个链表
        NextProcess = Process.NextEntryDelta + NextProcess '下个进程地址
        CopyMemory Process, buf(NextProcess), LenB(Process) '复制BYTE数据到进程结构
        
        ProcessName = Space(Process.ProcessName.Length / 2) '缓冲区
        CopyMemory ByVal StrPtr(ProcessName), ByVal Process.ProcessName.buffer, Process.ProcessName.Length '还原字符串
        List1.AddItem Process.ProcessID & vbTab & ProcessName & vbTab & Li2Double(Process.UserTime)
    Loop
End Sub

Private Sub Command2_Click()
    Dim i As Long
    For i = 0 To List1.ListCount - 1
        If InStr(1, List1.List(i), "BJMain.exe") > 0 Then
           Set Form6 = Nothing: Exit For
        End If
    Next
End Sub

[zenmirco]

看起来不是很明白。为什么不用定时器，如果不用定时器的话，怎么能一直监控窗体和进程存不存在呢？？

[东方之珠]

进程可以一次枚举完毕，如果要用定时器的话，可以在Command1中进程刷新，在DO循环中查找,Command2不再需要了。