gui.bas

提供进程监视[包括启动参数] 进程检测[包括启动参数] 网络连接检测 SSDT检测 BHO检测 IE插件检测 自启动项检测 -------程序部分[使用彩字显示] 包

Attribute VB_Name = "gui"
Public Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Public Const BF_LEFT = &H1                          ' 左边缘
Public Const BF_TOP = &H2                           ' 上边缘
Public Const BF_RIGHT = &H4                         ' 右边缘
Public Const BF_BOTTOM = &H8                        ' 下边缘
Public Const BDR_SUNKENOUTER = &H2                  ' 外层凹
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
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 ptip As String
Public Type gpFrame
        FrCaption As String
        FrPic As String
End Type
Public Type ShowText
        text As String
        color As Long
End Type
Public barjs As Integer
Public baridx As Integer
Public pTextData(1 To 300) As ShowText
Public pTDI As Integer
Public Const IMAGE_ICON = 1
Public Const LR_LOADFROMFILE = &H10
Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Public Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hicon As Long) As Long
Public Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As String) As Long
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal x1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Public Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Public Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Public topshowS As String
Dim mlstr2 As Integer

Public Function rectframe(ByVal hwd As Long, ByVal left As Integer, ByVal top As Integer, ByVal buttom As Integer, ByVal right As Integer, ByVal color As Long, ByRef fpf As gpFrame) As Integer
hdc = GetDC(hwd)
Dim tmp As RECT
tmp.left = left
tmp.top = top
tmp.Bottom = buttom
tmp.right = right
hBrush = CreateSolidBrush(color)
FillRect hdc, tmp, hBrush
DeleteObject hBrush
hBrush = CreateSolidBrush(GetBkColor(hdc))
tmp.left = left + 1
tmp.top = top + 1
tmp.Bottom = buttom - 1
tmp.right = right - 1
FillRect hdc, tmp, hBrush
DeleteObject hBrush
'---------附加----
hj = CreatePen(2, 1, color)
SelectObject hdc, hj
MoveToEx hdc, left + 80, top + 40, 0
LineTo hdc, right - 50, top + 40
DeleteObject hj
'---------标题设置
Form1.FontBold = True
SetTextColor hdc, RGB(0, 0, 0)
Call TextOut(hdc, left + 80, top + 15, fpf.FrCaption, lstrlen(fpf.FrCaption))
Form1.FontBold = False
Call pDrawIcon(hwd, fpf.FrPic, left + 80 - 42, top + 10)
End Function
Function pDrawLine(hdc As Form, ByVal X As Integer, ByVal Y As Integer, ByVal wi As Integer, ByVal color As Long)
zhdc = hdc.hdc
oldc = hdc.FillColor
hdc.FillColor = color
MoveToEx zhdc, X, Y, 0
LineTo zhdc, X + wi, Y
hdc.FillColor = oldc
End Function

Function pDrawIcon(ByVal hwnd As Long, pFilePath As String, X As Integer, Y As Integer)
k = LoadImage(App.hInstance, App.path & "\ico1.ico", IMAGE_ICON, 32, 32, LR_LOADFROMFILE)
Call DrawIcon(GetDC(hwnd), X, Y, k)
End Function
Function pDrawText(ByVal hwnd As Long, X As Integer, Y As Integer)
Dim tmps() As String
Dim mlstr As Integer
hdc = GetDC(hwnd)
If pTDI < 1 Then Exit Function
If pTDI > 10 Then
hj = 10
Form1.VScroll1.Max = pTDI
Else
hj = pTDI

End If
ReDim tmps(1 To hj) As String
'MsgBox barjs
'MsgBox baridx
'MsgBox hj
Dim tmp2s As String * 256
For i = 1 To hj
    jk = i + baridx
    'If jk > pTDI Then jk = pTDI
    If jk < 1 Then jk = 1
    mlstr = Len(pTextData(jk).text)
    If mlstr > mlstr2 Then
       mlstr2 = mlstr
    End If
    
    Form1.hs1.Max = Int(mlstr2 - 70)
    tmp2s = pTextData(jk).text
    swi = Form1.hs1.value
    tmps(i) = Mid(tmp2s, swi + 1, 70)
Next i
For i = 1 To hj
    SetTextColor hdc, pTextData(i + baridx).color
    Call TextOut(hdc, X, i * 15 + Y, tmps(i), lstrlen(tmps(i)))
Next i
SetTextColor hdc, RGB(0, 0, 0)
'---
DrawFF Form1.hwnd, 0, 0, 80, Form1.Width / 15, RGB(44, 125, 200)
ptip = "执行: 处理完成"
Form1.Label1.Caption = ptip

End Function
Function pDrawString(ByVal hwnd As Long, X As Integer, Y As Integer, ByVal pString As String, color As Long)
hdc = GetDC(hwnd)
    SetTextColor hdc, color
    Call TextOut(hdc, X, Y, pString, lstrlen(pString))
    SetTextColor hdc, RGB(0, 0, 0)
End Function
Function DrawFF(ByVal hwnd As Long, ByVal left As Integer, ByVal top As Integer, ByVal buttom As Integer, ByVal right As Integer, ByVal color As Long) As Integer
hdc = GetDC(hwnd)
'------------------
Dim tmp As RECT
tmp.left = left
tmp.top = top
tmp.Bottom = buttom
tmp.right = right
'------------------
hBrush = CreateSolidBrush(color)
FillRect hdc, tmp, hBrush
DeleteObject hBrush
'-------------------
tmp.left = left
asd = buttom
tmp.top = asd
tmp.Bottom = asd - 1
tmp.right = right
hBrush = CreateSolidBrush(RGB(0, 67, 124))
FillRect hdc, tmp, hBrush
DeleteObject hBrush
'Form1.mbg.Picture = LoadPicture(App.path & "\bg.bmp")
'-------------------
End Function

Public Sub AddTextData(ByVal text As String, ByVal color As Long)
pTDI = pTDI + 1
If pdti > 300 Then Exit Sub
Dim tmps As ShowText
tmps.color = color
tmps.text = text
pTextData(pTDI) = tmps
End Sub

Public Sub ClsTextData()
pTDI = 0
End Sub

Public Function pList(ByVal hwd As Long, ByVal left As Integer, ByVal top As Integer, ByVal he As Integer, ByVal wi As Integer, color As Long)
hdc = GetDC(hwd)
Dim tmp As RECT
tmp.left = left
tmp.top = top
buttom = he
tmp.Bottom = buttom
rights = wi
tmp.right = rights
hBrush = CreateSolidBrush(color)
FillRect hdc, tmp, hBrush
DeleteObject hBrush
hBrush = CreateSolidBrush(GetBkColor(hdc))
tmp.left = left + 1
tmp.top = top + 1
tmp.Bottom = buttom - 1
tmp.right = rights - 1
FillRect hdc, tmp, hBrush
DeleteObject hBrush
End Function

Public Function pListE(ByVal hwd As Long, ByVal left As Integer, ByVal top As Integer, ByVal he As Integer, ByVal wi As Integer, color As Long, ByVal fcolor As Long)
hdc = GetDC(hwd)
Dim tmp As RECT
tmp.left = left
tmp.top = top
buttom = he
tmp.Bottom = buttom
rights = wi
tmp.right = rights
hBrush = CreateSolidBrush(fcolor)
FillRect hdc, tmp, hBrush
DeleteObject hBrush
tmp.left = left + 1
tmp.top = top + 1
buttom = he
tmp.Bottom = buttom - 1
rights = wi
tmp.right = rights - 1
hBrush = CreateSolidBrush(color)
FillRect hdc, tmp, hBrush
DeleteObject hBrush
End Function
Public Function pDList(ByVal hwd As Form, ByVal left As Integer, ByVal top As Integer, ByVal he As Integer, ByVal wi As Integer, color As Long, ByVal fcolor As Long)
hdc = hwd.hdc
Dim tmp As RECT
tmp.left = left
tmp.top = top
buttom = top + he
tmp.Bottom = buttom
rights = left + wi
tmp.right = rights
hBrush = CreateSolidBrush(fcolor)
FillRect hdc, tmp, hBrush
DeleteObject hBrush
tmp.left = left + 1
tmp.top = top + 1
tmp.Bottom = buttom - 1
tmp.right = rights - 1
hBrush = CreateSolidBrush(color)
FillRect hdc, tmp, hBrush
DeleteObject hBrush
End Function