vb.net 用GetDIBits获取屏幕颜色 5000次后失效

[weixin_38053335]

先贴代码:
Imports System.Runtime.InteropServices
Public Class form1
    Public Structure PointAPI
        Dim x As Integer
        Dim y As Integer
    End Structure
    Public Function ConvertString(
        ByVal value As String,
        ByVal fromBase As Integer,
        ByVal toBase As Integer) As String
        Dim n As Integer = Convert.ToInt32(value, fromBase)
        Return Convert.ToString(n, toBase)
    End Function
    Public P As PointAPI
    Public Declare Auto Function FindWindow Lib "user32.dll" _
        Alias "FindWindow" (ByVal lpClassName As String,
                            ByVal lpWindowName As String) As Integer
    Declare Ansi Function GetCursorPos Lib "user32" (ByRef lpPoint As PointAPI) As Integer
    Public Declare Function WindowFromPoint Lib "user32" (x As Integer, y As Integer) As Integer
    'Public Declare Auto Function GetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Integer) As Integer
    Public Declare Function ScreenToClient Lib "user32" Alias "ScreenToClient" (ByVal hwnd As Integer, ByRef lpPoint As PointAPI) As Integer
    Declare Function GetPixel Lib "gdi32" Alias "GetPixel" (ByVal hdc As Integer, ByVal x As Integer, ByVal y As Integer) As Integer
    Public Declare Function ReleaseDC Lib "user32" (hWnd As Integer, hDC As Integer) As Integer
    Public Declare Auto Function DeleteDC Lib "gdi32.dll" (ByRef hdc As IntPtr) As Boolean
    Public Declare Auto Function DeleteObject Lib "gdi32.dll" (ByRef hobject As IntPtr) As Boolean


    'Public Declare Function timeGetTime Lib "winmm.dll" () As Integer
    Public Declare Function GetPhysicalCursorPos Lib "user32" (ByRef lpPoint As PointAPI) As Integer
    Public Declare Function SetPhysicalCursorPos Lib "user32" (ByVal x As Integer, ByVal y As Integer) As Integer
    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As System.Text.StringBuilder) As Integer
    Public lparam As New System.Text.StringBuilder
    Const WM_GETTEXT = &HD
    Const WM_KEYDOWN = &H100
    Const WM_KEYUP = &H101
    Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Integer, ByVal lpString As String, ByVal cch As Integer) As Integer
    Public Declare Function SetCursorPos Lib "user32" (ByVal x As Integer, ByVal y As Integer) As Integer

    Public Declare Function timeGetTime Lib "winmm.dll" () As Integer
    Public Declare Function GetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Integer) As Integer
    Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As String) As Integer
    Private Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Integer) As Integer
    Private Declare Function GetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hdc As Integer, ByVal nIndex As Integer) As Integer
    Private Declare Function CreateCompatibleBitmap Lib "GDI32" (ByVal hDC As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer) As Integer
    Private Declare Function SelectObject Lib "GDI32" (ByVal hDC As Integer, ByVal hObject As Integer) As Integer
    Private Declare Function BitBlt Lib "GDI32" (ByVal deshDC As Integer, ByVal desX As Integer, ByVal desY As Integer, ByVal desW As Integer, ByVal desH As Integer, ByVal srchDC As Integer, ByVal srcX As Integer, ByVal srcY As Integer,
ByVal op As Integer) As Integer
    Const SRCCOPY = &HCC0020    ' (DWORD) dest = source
    Const SRCINVERT = &H660046  ' (DWORD) dest = source XOR dest
    Public Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal xSrc As Integer, ByVal ySrc As Integer,
ByVal nSrcWidth As Integer, ByVal nSrcHeight As Integer, ByVal dwRop As Integer) As Integer
    Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Integer, ByVal hBitmap As Integer, ByVal nStartScan As Integer, ByVal nNumScans As Integer, ByVal lpBits As Integer, ByRef lpBI As BITMAPINFO, ByVal wUsage As Integer)
As Integer
    Private Declare Function CreateDIBSection Lib "GDI32" (ByVal hdc As Integer, ByRef pbmi As BITMAPINFO, ByVal iUsage As Integer, ByRef ppvBits As Integer, ByVal hSection As Integer, ByVal dwOffset As Integer) As Integer
    Private Declare Function SetDIBits Lib "GDI32.dll" (ByVal hDC As Integer, ByVal hBitmap As Integer, ByVal nStartScan As Integer, ByVal nNumScans As Integer, ByRef lpBits As Integer, ByRef lpBI As BITMAPINFO, ByVal wUsage As Integer)
As Integer
    Public Structure RGBTRIPLE
        Public rgbBlue As Byte
        Public rgbGreen As Byte
        Public rgbRed As Byte
    End Structure
    Public Structure BITMAPINFOHEADER
        Public biSize As Integer
        Public biWidth As Integer
        Public biHeight As Integer
        Public biPlanes As Short
        Public biBitCount As Short
        Public biCompression As Integer
        Public biSizeImage As Integer
        Public biXPelsPerMeter As Integer
        Public biYPelsPerMeter As Integer
        Public biClrUsed As Integer
        Public biClrImportant As Integer
    End Structure
    Public Structure BITMAPINFO
        Public bmiHeader As BITMAPINFOHEADER
        Public bmColors() As RGBTRIPLE
    End Structure
    Public Const DIB_RGB_COLORS As Integer = 0
    Public Structure BitBlt_RECT
        Dim x1 As Integer
        Dim y1 As Integer
        Dim x2 As Integer
        Dim y2 As Integer
    End Structure
    Public BR As New BitBlt_RECT
    Public CR, CB, CG As Integer
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Dim going_on As Boolean = True
        Me.SetDesktopLocation(968, 30)
        Show()
        Dim t As Integer
        t = 0
        Do While going_on
            t += 1
            With BR
                .x1 = P.x
                .y1 = P.y
                .x2 = P.x + 1
                .y2 = P.y + 1
            End With
            GetDIBits_maping()
            GetPhysicalCursorPos(P)
            TextBox12.Text = " x =" + Str(P.x)
            TextBox13.Text = " y =" + Str(P.y)
            TextBox3.Text = "R =" + Str(CR)
            TextBox4.Text = "G =" + Str(CG)
            TextBox5.Text = "B =" + Str(CB)
            TextBox8.Text = TextBox8.Text + ",t=" + Trim(Str(t))
            Application.DoEvents()
        Loop
    End Sub
    Private Sub GetDIBits_maping()
        Dim hdc, hdcMem, hbmp, hBmpPrev, NewBMP2 As Integer
        Dim start_coo_x, start_coo_y, W, H As Integer
        Dim textureImg(10) As Byte
        start_coo_x = BR.x1 : start_coo_y = BR.y1
        W = BR.x2 - BR.x1 : H = BR.y2 - BR.y1
        Dim bi24BitInfo As New BITMAPINFO
        With bi24BitInfo.bmiHeader
            .biSize = 40 'System.Runtime.InteropServices.Marshal.SizeOf(GetType(BITMAPINFO))
            .biBitCount = 24
            .biCompression = 0 ' BI_RGB
            .biPlanes = 1
            .biWidth = W
            .biHeight = H
            .biXPelsPerMeter = 0
            .biYPelsPerMeter = 0
            .biSizeImage = W * H * 3
            .biClrUsed = 0
            .biClrImportant = 0
        End With
        Dim r As Integer
        hdc = GetDC(0)
        TextBox7.Text = "hdc(0) =" + Str(hdc)
        hdcMem = CreateCompatibleDC(hdc)
        hbmp = CreateCompatibleBitmap(hdc, W, H)
        hBmpPrev = SelectObject(hdcMem, hbmp)
        r = BitBlt(hdcMem, 0, 0, W, H, hdc, start_coo_x, start_coo_y, &HCC0020)
        TextBox8.Text = " R=" + Trim(Str(r))
        NewBMP2 = SelectObject(hdcMem, hBmpPrev)
        Dim gch As GCHandle
        gch = GCHandle.Alloc(textureImg, GCHandleType.Pinned)
        r = GetDIBits(hdc, NewBMP2, 0, H, gch.AddrOfPinnedObject, bi24BitInfo, 0)
        CB = textureImg(0)
        CG = textureImg(1)
        CR = textureImg(2)
        gch.Free()
        DeleteObject(hbmp)
        DeleteDC(hdcMem)
        DeleteObject(hBmpPrev)  '不知道是否有必要delete,有没有这句话没差别
        DeleteObject(NewBMP2)  '不知道是否有必要delete,有没有这句话没差别
        DeleteDC(r)                    '不知道是否有必要delete,有没有这句话没差别

        ReleaseDC(0, hdc)
        GC.Collect()
    End Sub

    Private Sub form1_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
        End
    End Sub
End Class
该程序运行5000次左右没问题.超过5000次,hdc = GetDC(0)就很少能取到了,取到的颜色也都是零了.
运行中,占用的内存一直在增加,开始运行到运行5000次大约能增加20MB.不清楚是否有内存泄露.
我的运行环境: I7 4790,内存12G,没有独立显卡,64位win10 最新版本, DELL商务机
本人姓菜名鸟,请前辈帮忙看看我的问题出在哪里!   非常感谢!!!