WindowKiller

Project1.vbp

Type=Exe Form=frmMain.frm Reference=*/G{00020430-0000-0000-C000-000000000046}#2.0#0#C:/WINDOWS/system32/stdole2.tlb#OLE Automation Object={3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0; richtx32.ocx Module=modPub; modPub.bas IconForm="frmMain" Startup="frmMain" HelpFile="" Title="WindowKiller" ExeName32="WindowKiller.exe" Command32="" Name="WindowKiller" HelpContextID="0" CompatibleMode="0" MajorVer=1 MinorVer=0 RevisionVer=0 AutoIncrementVer=0 ServerSupportFiles=0 VersionCompanyName="fnst" CompilationType=0 OptimizationType=0 FavorPentiumPro(tm)=0 CodeViewDebugInfo=0 NoAliasing=0 BoundsCheck=0 OverflowCheck=0 FlPointCheck=0 FDIVCheck=0 UnroundedFP=0 StartMode=0 Unattended=0 Retained=0 ThreadPerObject=0 MaxNumberOfThreads=1   

 

frmMain.frm

VERSION 5.00 Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "richtx32.ocx" Begin VB.Form frmMain BorderStyle = 1 'Fixed Single Caption = "WindowKiller" ClientHeight = 5325 ClientLeft = 45 ClientTop = 330 ClientWidth = 4125 Icon = "frmMain.frx":0000 KeyPreview = -1 'True LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 5325 ScaleWidth = 4125 Begin VB.Timer tmrRecover Enabled = 0 'False Interval = 200 Left = 3120 Top = 1320 End Begin VB.Timer trmGetCaption Enabled = 0 'False Interval = 100 Left = 2640 Top = 1320 End Begin RichTextLib.RichTextBox Text2 Height = 3495 Left = 0 TabIndex = 5 Top = 1800 Width = 4095 _ExtentX = 7223 _ExtentY = 6165 _Version = 393217 ScrollBars = 3 AutoVerbMenu = -1 'True TextRTF = $"frmMain.frx":030A End Begin VB.CommandButton Command3 Caption = "Caption History" Height = 255 Left = 0 TabIndex = 4 Top = 1440 Width = 1575 End Begin VB.CommandButton Command2 Caption = "Run" Height = 330 Left = 2280 TabIndex = 3 Top = 960 Width = 1455 End Begin RichTextLib.RichTextBox RichTextBox1 Height = 285 Left = 720 TabIndex = 1 Top = 600 Width = 3015 _ExtentX = 5318 _ExtentY = 503 _Version = 393217 MultiLine = 0 'False AutoVerbMenu = -1 'True TextRTF = $"frmMain.frx":03A2 End Begin VB.CommandButton Command1 Caption = "Apply" Height = 330 Left = 720 TabIndex = 2 Top = 960 Width = 1455 End Begin VB.TextBox Text1 Height = 285 Left = 720 TabIndex = 0 Text = "100" Top = 240 Width = 3015 End Begin VB.Timer tmrKillWindow Interval = 100 Left = 2160 Top = 1320 End Begin VB.Image imgBake Height = 480 Left = 3720 Picture = "frmMain.frx":0444 Top = 1320 Visible = 0 'False Width = 480 End Begin VB.Image Image1 BorderStyle = 1 'Fixed Single Height = 420 Left = 120 MouseIcon = "frmMain.frx":074E MousePointer = 99 'Custom Picture = "frmMain.frx":0A58 Stretch = -1 'True Top = 840 Width = 465 End Begin VB.Label Label3 AutoSize = -1 'True Caption = "Caption:" Height = 195 Left = 120 TabIndex = 8 Top = 600 Width = 585 End Begin VB.Label Label2 AutoSize = -1 'True Caption = "Interval:" Height = 195 Left = 120 TabIndex = 7 Top = 240 Width = 570 End Begin VB.Label Label1 AutoSize = -1 'True Height = 195 Left = 3720 TabIndex = 6 Top = 645 Width = 45 End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim strKeyCaption As String Dim lngKillTimes As Long Dim isRun As Boolean Dim isShowDown As Boolean Dim strAppPath As String Dim blnColor As Boolean Dim lngColorChan As Long Dim isLocked As Boolean Private Sub Form_Load() SetWindowPos hWnd, -1, 0, 0, 0, 0, 3 Me.Move Screen.Width - Me.Width - 100, Screen.Height - Me.Height - 550 Image1.MousePointer = 0 isShowDown = False isLocked = True strAppPath = App.Path If Right(strAppPath, 1) <> "/" Then strAppPath = strAppPath & "/" Text2.Text = fileStr(strAppPath & "caption.txt") If Text2.Text <> "" Then RichTextBox1.Text = getLastKeyWord(Text2.Text) Call Command1_Click Call Command2_Click Call Command3_Click End Sub Private Function getLastKeyWord(str1$) As String Dim v, i% v = Split(str1, vbCrLf) For i = UBound(v) To 0 Step -1 If v(i) <> "" Then getLastKeyWord = v(i) Exit For End If Next End Function Private Sub Form_Unload(Cancel As Integer) Text2.SaveFile strAppPath & "caption.txt", rtfText End End Sub Private Sub Command1_Click() tmrRecover.Enabled = False lngColorChan = 0 RichTextBox1.BackColor = vbWhite Label1.Caption = IIf(lngKillTimes = 0, "", lngKillTimes) tmrKillWindow.Interval = Val(Text1.Text) strKeyCaption = RichTextBox1.Text If Right(Text2.Text, Len(strKeyCaption)) <> strKeyCaption Then Text2.Text = Replace(Text2.Text, strKeyCaption & vbCrLf, "") If Right(Text2.Text, 2) <> vbCrLf And Text2.Text <> "" Then Text2.Text = Text2.Text & vbCrLf Text2.Text = Text2.Text & strKeyCaption Text2.SaveFile strAppPath & "caption.txt", rtfText End If ' If InStr(Text2.Text, strKeyCaption) = 0 Then ' If Right(Text2.Text, 2) <> vbCrLf And Text2.Text <> "" Then Text2.Text = Text2.Text & vbCrLf ' Text2.Text = Text2.Text & strKeyCaption ' Text2.SaveFile strAppPath & "caption.txt", rtfText ' End If End Sub Private Sub Command2_Click() isRun = Not isRun tmrKillWindow.Enabled = isRun Command2.Caption = IIf(isRun, "Stop", "Run") Me.Caption = IIf(isRun, "WindowKiller - Running", "WindowKiller") End Sub Private Sub Command3_Click() isShowDown = Not isShowDown If isShowDown Then Me.Height = Command3.Top + Command3.Height + 400 Else Me.Height = Text2.Top + Text2.Height + 400 End If Me.Move Screen.Width - Me.Width - 100, Screen.Height - Me.Height - 550 End Sub Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Image1.MousePointer = 99 trmGetCaption.Enabled = True Set Image1.Picture = Nothing End Sub Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) Image1.MousePointer = 0 trmGetCaption.Enabled = False Set Image1.Picture = imgBake.Picture End Sub Private Sub RichTextBox1_Change() If isLocked = True Then isLocked = False Exit Sub End If tmrRecover.Enabled = True lngColorChan = 0 End Sub Private Sub Text2_DblClick() Dim nLine As Long, nCol As Long Dim ptPos As POINTAPI Dim v Call SendMessage(Text2.hWnd, EM_GETSEL, 0, ptPos) nLine = SendMessage(Text2.hWnd, EM_LINEFROMCHAR, ptPos.x, ByVal 0&) v = Split(Text2.Text, vbCrLf) RichTextBox1.Text = v(nLine) End Sub Private Sub tmrKillWindow_Timer() If strKeyCaption <> "" Then Call closePage(strKeyCaption) End Sub Private Sub tmrRecover_Timer() blnColor = Not blnColor RichTextBox1.BackColor = IIf(blnColor, vbWhite, &HFFC0C0) lngColorChan = lngColorChan + 1 Label1.Caption = Int((25 - lngColorChan) / 5) + 1 & " s" If lngColorChan >= 25 Then tmrRecover.Enabled = False lngColorChan = 0 isLocked = True RichTextBox1.BackColor = vbWhite RichTextBox1.Text = strKeyCaption Label1.Caption = IIf(lngKillTimes = 0, "", lngKillTimes) End If End Sub Private Sub trmGetCaption_Timer() On Error Resume Next Dim tPoint As POINTAPI Dim hWin As Long Dim Rtn As Long Dim strControl As String * 255 Dim Txt(64000) As Byte Static lngLastHwnd& GetCursorPos tPoint 'ｻﾃｵｱﾇｰﾊ・ｻﾖﾃ hWin = WindowFromPoint(tPoint.x, tPoint.y) 'ｻﾃｴｰｿﾚﾃ﨣・ If lngLastHwnd = hWin Then Exit Sub Else lngLastHwnd = hWin SendMessage hWin, &HD, 64000, Txt(0) 'ｻﾃｴｰｿﾚｱ・・ﾒｲｿﾉﾊｹﾓﾃ API ｺｯﾊ:GetWindowText,ｵｫﾐｧｹ軏ｻｼﾑ) RichTextBox1.Text = StrConv(Txt, vbUnicode) End Sub Public Sub closePage(strKey As String) Dim hWnd, l As Long Dim strCaption As String Do hWnd = FindWindowEx(0, hWnd, vbNullString, vbNullString) l = GetWindowTextLength(hWnd) strCaption = Space(l) GetWindowText hWnd, strCaption, l + 1 If strCaption <> "" Then If InStr(strCaption, strKey) > 0 Then PostMessage hWnd, WM_CLOSE, 0, 0 lngKillTimes = lngKillTimes + 1 Label1.Caption = lngKillTimes End If End If Loop Until hWnd = 0 End Sub Private Function fileStr(ByVal strFileName As String) As String On Error GoTo Err1 Open strFileName For Input As #1 fileStr = StrConv(InputB$(LOF(1), #1), vbUnicode) Close #1 Exit Function Err1: MsgBox "load ""caption.txt"" error", vbExclamation End Function Private Function writeToFile(ByVal strFileName$, ByVal strContent$, Optional isCover As Boolean = True) As Boolean On Error GoTo Err1 Dim fileHandl% fileHandl = FreeFile If isCover Then Open strFileName For Output As #fileHandl Else Open strFileName For Append As #fileHandl End If Print #fileHandl, strContent Close #fileHandl writeToFile = True Exit Function Err1: writeToFile = False End Function

 

modPub.bas

Attribute VB_Name = "modPub" Option Explicit Public Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) 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 GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long Public Declare Function PostMessage Lib "User32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Declare Function SetWindowPos& Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) Public Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) 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 WindowFromPoint Lib "User32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long Public Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Public Declare Sub RtlMoveMemory Lib "KERNEL32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long) Public Const EM_GETLINE = &HC4 Public Const EM_LINELENGTH = &HC1 Public Const EM_LINEINDEX = &HBB Public Const EM_GETSEL = &HB0 Public Const EM_LINEFROMCHAR = &HC9 Public Const WM_SETTEXT = &HC Public Const WM_CLOSE = &H10 Public Type POINTAPI x As Long y As Long End Type Public tPoint As POINTAPI