切换到宽版
  • 1677阅读
  • 1回复

【开源】反绿坝软件V1.0.16 [复制链接]

上一主题 下一主题
离线Lucifer
 

只看楼主 倒序阅读 楼主  发表于: 2009-06-14
下面公布源代码:
只有一个窗体,Form1.frm,用记事本打开输入:VERSION 5.00
Begin VB.Form Form1
Caption = \"反绿坝软件 - NeoAtlantis\"
ClientHeight= 5325
ClientLeft = 60
ClientTop = 450
ClientWidth = 5835
Icon= \"Form1.frx\":0000
LinkTopic = \"Form1\"
MaxButton = 0 'False
ScaleHeight = 5325
ScaleWidth = 5835
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame2
Caption = \"清理绿坝\"
Height = 1695
Left= 120
TabIndex= 5
Top = 3000
Width = 5655
Begin VB.CommandButton cmdClear
Caption = \"开始清理\"
Height = 375
Left= 4440
TabIndex= 6
Top = 1200
Width = 1095
End
Begin VB.Label Label2
Caption = \"单击下面的按钮,开始清理。您不需要将上面列表中的内容全部选定,本程序会自己决定如何处理。\"
Height = 375
Left= 120
TabIndex= 8
Top = 840
Width = 5415
End
Begin VB.Label Label1
Caption = $\"Form1.frx\":014A
Height = 615
Left= 120
TabIndex= 7
Top = 240
Width = 5415
End
End
Begin VB.ListBox lstDFile
Height = 1740
Left= 120
Style = 1 'Checkbox
TabIndex= 2
Top = 1200
Width = 5535
End
Begin VB.Frame Frame1
Caption = \"检测系统是否安装“绿坝”\"
Height = 975
Left= 120
TabIndex= 1
Top = 120
Width = 5535
Begin VB.Label lblResult
ForeColor = &H00008000&
Height = 420
Left= 120
TabIndex= 4
Top = 480
Width = 5250
End
Begin VB.Label lblState
Caption = \"正在检测中...\"
Height = 255
Left= 120
TabIndex= 3
Top = 240
Width = 3255
End
End
Begin VB.CommandButton Command1
Caption = \"退出\"
Height = 375
Left= 120
TabIndex= 0
Top = 4800
Width = 975
End
Begin VB.Timer Timer1
Interval= 100
Left= 1200
Top = 4800
End
End
Attribute VB_Name = \"Form1\"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function CreateToolhelp32Snapshot Lib \"kernel32\" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib \"kernel32\" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib \"kernel32\" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib \"kernel32\" (ByVal hObject As Long) As Long
Private Declare Function OpenProcess Lib \"kernel32\" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long

Private Declare Function TerminateProcess Lib \"kernel32\" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long


Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 1024
End Type

Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Dim pid As Long
Dim pName As String
Public sEndProess As String
Private Function IsEndProc(ByVal pName As String) As Boolean
IsEndProc = (InStr(1, LCase(sEndProess), LCase(\"|\" & pName & \"|\")) <> 0)
End Function

Private Sub cmdClear_Click()
On Error Resume Next
cmdClear.Enabled = False
With lstDFile
While .ListCount <> 0
DoEvents
desfile = .List(0)
.RemoveItem 0
If Dir(desfile) <> \"\" Then
On Error Resume Next
Kill desfile
If Dir(desfile) <> \"\" Then
.AddItem .ListCount
Call ClearTask
Kill desfile
End If
End If
Wend
End With
End Sub

Private Sub Command1_Click()
End
End Sub


Private Sub Form_Load()
Dim df1, sysdir, wddir As String
Dim fn, fpn As String
df1 = LocalPath(\"files.txt\")
If Dir(df1) = \"\" Then
MsgBox \"程序找不到目标文件,退出。\", vbCritical, \"错误\"
End
End If
sysdir = GetSysDir()
wddir = Mid(sysdir, 1, Len(sysdir) - 9)
With lstDFile
.Clear
Open df1 For Input As #1
While Not EOF(1)
DoEvents
Line Input #1, fn
fn = LCase(Trim(fn))
If Not fn = \"\" Then
fn = Replace(fn, \"%systemroot%\", wddir)
.AddItem fn
fpn = fn
While InStr(1, fpn, \"\\") <> 0
DoEvents
fpn = Mid(fpn, 2)
Wend
If Right(fpn, 3) = \"exe\" Then sEndProess = sEndProess & \"|\" & fpn
End If
Wend
Close #1
'*************************************************
'检测是否安装绿坝
'*************************************************
Dim fa, fb, percent, color As Long
Dim res As String
fa = .ListCount - 1: fb = 0
For i = 0 To fa
If Dir(.List(i)) <> \"\" Then
fb = fb + 1
.Selected(i) = True
End If
Next i
percent = Int(fb / (fa + 1) * 10000) / 100
res = \"应有绿坝2.0文件\" & fa + 1 & \"个,现在您的计算机里有\" & fb & \"个,占 \" & percent & \"% 。\"
If percent >= 80 Then
res = res & \"您很可能已经安装!\"
color = vbRed
ElseIf percent >= 50 Then
res = res & \"有绿坝残留文件。建议执行程序。\"
color = vbYellow
Else
res = res & \"基本没有问题。\"
color = &H8000&
End If
lblState.Caption = \"检测完毕。\"
lblResult.ForeColor = color
lblResult.Caption = res
End With

End Sub

Private Sub ClearTask()
Dim col As Long
Dim h As String

Dim my As PROCESSENTRY32
Dim l As Long
Dim l1 As Long
Dim flag As Boolean
Dim mName As String
Dim i As Integer

l = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If l Then
my.dwSize = 1060
If (Process32First(l, my)) Then '遍历第一个进程
Do
DoEvents
i = InStr(1, my.szExeFile, Chr(0))
mName = LCase(Left(my.szExeFile, i - 1))
If IsEndProc(mName) Then
pid = my.th32ProcessID
pName = mName
Dim mProcID As Long
mProcID = OpenProcess(1&, -1&, pid)
TerminateProcess mProcID, 0&
'Shell \"ntsd -c q -p \" & pid, vbHide
flag = True
DoEvents
Else
flag = False
End If
Loop Until (Process32Next(l, my) < 1) '遍历所有进程直到返回值为False
End If
l1 = CloseHandle(l)
End If
End Sub
然后保存,作为工程1.vbp的窗体导入。
另外需要模块Module1.bas:Attribute VB_Name = \"Module1\"
Public Declare Function GetSystemDirectory Lib \"kernel32\" Alias \"GetSystemDirectoryA\" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'Const MAX_PATH = 260
Public Function LocalPath(ByVal filename As String) As String
Dim a As String
a = App.Path
If Right(a, 1) <> \"\\" Then a = a & \"\\"
a = a & filename
LocalPath = a
End Function
Public Function GetSysDir()
Dim b As String
Dim p As Integer
b = Space(260)
p = GetSystemDirectory(b, Len(b))
GetSysDir = Left(b, p)
End Function同样如法炮制。
最后,在工程目录下添加files.txt,内容如下:%SystemRoot%\system32\RunAfterSetup.exe
%SystemRoot%\system32\sys.dat
%SystemRoot%\system32\poppo.dll
%SystemRoot%\system32\sysEx.dat
%SystemRoot%\system32\appface.dll
%SystemRoot%\system32\xabout.dat
%SystemRoot%\system32\x100.dat
%SystemRoot%\system32\x200.dat
%SystemRoot%\system32\x300.dat
%SystemRoot%\system32\x400.dat
%SystemRoot%\system32\xnet2_lang.ini
%SystemRoot%\system32\bnrfil.dat
%SystemRoot%\system32\bsnlst.dat
%SystemRoot%\system32\csnews.dat
%SystemRoot%\system32\gdwfil.dat
%SystemRoot%\system32\TrustUrl.dat
%SystemRoot%\system32\wfileu.dat
%SystemRoot%\system32\xwordh.dat
%SystemRoot%\system32\xwordl.dat
%SystemRoot%\system32\xwordm.dat
%SystemRoot%\system32\auctfil.dat
%SystemRoot%\system32\chtfil.dat
%SystemRoot%\system32\cultfil.dat
%SystemRoot%\system32\entfil.dat
%SystemRoot%\system32\finfil.dat
%SystemRoot%\system32\fmfil.dat
%SystemRoot%\system32\fshrfil.dat
%SystemRoot%\system32\gblfil.dat
%SystemRoot%\system32\gnfil.dat
%SystemRoot%\system32\hatfil.dat
%SystemRoot%\system32\iawfil.dat
%SystemRoot%\system32\imgfil.dat
%SystemRoot%\system32\jbfil.dat
%SystemRoot%\system32\lgwfil.dat
%SystemRoot%\system32\movfil.dat
%SystemRoot%\system32\mp3fil.dat
%SystemRoot%\system32\nvgamfil.dat
%SystemRoot%\system32\perfil.dat
%SystemRoot%\system32\picsfil.dat
%SystemRoot%\system32\pkmon.dat
%SystemRoot%\system32\popfil.dat
%SystemRoot%\system32\psyfil.dat
%SystemRoot%\system32\sporfil.dat
%SystemRoot%\system32\swfil.dat
%SystemRoot%\system32\tafil.dat
%SystemRoot%\system32\tapfil.dat
%SystemRoot%\system32\vgamfil.dat
%SystemRoot%\system32\viofil.dat
%SystemRoot%\system32\wrestfil.dat
%SystemRoot%\system32\wzfil.dat
%SystemRoot%\system32\adwfil.dat
%SystemRoot%\system32\1.urf
%SystemRoot%\system32\2.urf
%SystemRoot%\system32\3.urf
%SystemRoot%\system32\4.urf
%SystemRoot%\system32\5.urf
%SystemRoot%\system32\6.urf
%SystemRoot%\system32\7.urf
%SystemRoot%\system32\goldlock.exe
%SystemRoot%\system32\filtport.dat
%SystemRoot%\system32\x100.jpg
%SystemRoot%\system32\x200.jpg
%SystemRoot%\system32\x300.jpg
%SystemRoot%\system32\x400.jpg
%SystemRoot%\system32\x500.jpg
%SystemRoot%\system32\win2kspi.reg
%SystemRoot%\system32\winxpSpi.reg
%SystemRoot%\system32\Win98Spi.reg
%SystemRoot%\system32\adwapp.dat
%SystemRoot%\system32\XFimage.xml
%SystemRoot%\system32\FImage.dll
%SystemRoot%\system32\Xtool.dll
%SystemRoot%\system32\Xcv.dll
%SystemRoot%\system32\xcore.dll
%SystemRoot%\system32\x600.jpg
%SystemRoot%\system32\wfile.dat
%SystemRoot%\system32\winvista.reg
%SystemRoot%\system32\IPGate.dll
%SystemRoot%\system32\gn.exe
%SystemRoot%\system32\looklog.exe
%SystemRoot%\system32\lookpic.exe
%SystemRoot%\system32\xconfigs.dat
%SystemRoot%\system32\XNet2.exe
%SystemRoot%\system32\XDaemon.exe
%SystemRoot%\system32\kwdata.exe
%SystemRoot%\system32\Update.exe
%SystemRoot%\logdesktop.ini
%SystemRoot%\snapdesktop.ini
%SystemRoot%\helpkw.chm
%SystemRoot%\HNCLIBFalunWord.lib
%SystemRoot%\image.dat
%SystemRoot%\image1.dat
%SystemRoot%\CardLib.dll
%SystemRoot%\cximage.dll
%SystemRoot%\dbfilter.dll
%SystemRoot%\Surfgd.dll
%SystemRoot%\dbServ.dll
%SystemRoot%\CImage.dll
%SystemRoot%\Handler.dll
%SystemRoot%\HASrv.dll
%SystemRoot%\HncEng.exe
%SystemRoot%\HncEngPS.dll
%SystemRoot%\InjLib32.dll
%SystemRoot%\MPSvcDll.dll
%SystemRoot%\MPSvcPS.dll
%SystemRoot%\SentenceObj.dll
%SystemRoot%\MPSvcC.exe
%SystemRoot%\vnew.bmp
%SystemRoot%\xstring.s2g
%SystemRoot%\kwselectinfopp.dll
%SystemRoot%\kwimage.dll
离线Lucifer

只看该作者 沙发  发表于: 2009-06-14
这样,编译工程,就得到了这个软件。但是缺少form1.frx,里面包含图标。
快速回复
限100 字节
如果您在写长篇帖子又不马上发表,建议存为草稿
 
上一个 下一个