Mensajes

.
en lugar de alentarte a solo pedir te alentare a usa un manual, en este subforo hay muchas respuestas

Temibles Lunas!¡.
.

.
Esto ya se posteo miles de veces ojala te sirva e enlace.

Click Automatico y Aquí también

.

.

Código (vb) [Seleccionar] Expandir



On Error GoTo ErrDelFile:       '   //  por si realmente no s puede borrar
Dim Archivo As String
    If Not Dir(Archivo, vbArchive) = "" Then
        Archivo = "c:\archivo.x"
        SetAttr Archivo, vbNormal
        Kill Archivo
    End If
ErrDelFile:



prueba con eso.

Temibles lunas
.

[LeandroA]

.
En otras palabras a todo lo que se le haga SelectObject()

oo ya entonces si tenia que hacerlo haci (entonces mi deducción era cierta... pero me cai  ¬¬")

DeleteObject SelectObject(hdc, hPen)

ya lo tenia pero mmm medio vi algo raro y lo deje así (Por ello esta editado quien sabe cuantas veces el post de arriba xP)

SelectObject hdc, hPen
bla bla bla
DeleteObject hPen

Muchas gracias LeandroA.

Temibles Lunas!¡.
.

[Analisis y Diseo de Malware]

.
Esto deberias preguntarlo en Analisis y Diseo de Malware este foro dejalo a dudas explicitas sobre de vb6

Temibles Lunas!¡.
.

[Pegar en un formulario y agregar un TIMER]

.
Espero y te sirva esto que te hice:

Pegar en un formulario y agregar un TIMER

Código (vb) [Seleccionar] Expandir



Option Explicit

'   //  GetSystemMetrics
Const SM_CXSCREEN = 0 'X Size of screen
Const SM_CYSCREEN = 1 'Y Size of Screen
'   //  CreatePen
Const PS_DOT = 2
Const PS_SOLID = 0
'   //  Apis
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As Any) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type
Private Type POINTAPI
   x                   As Long
   y                   As Long
End Type
Private Type tLineas
   PuntoInicio         As POINTAPI
   PuntoFinal          As POINTAPI
End Type
Dim RegionWindows       As RECT
Dim hdcDestino          As Long

Private Sub Form_Load()
   Hide
   '   //  Región/Resolución de Pantalla
   With RegionWindows
       .Bottom = GetSystemMetrics(SM_CYSCREEN)
       .Left = 1
       .Right = GetSystemMetrics(SM_CXSCREEN)
       .Top = 1
   End With
   hdcDestino = GetDC(0)
   Timer1.Interval = 100
   Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
Dim Linea               As tLineas
Dim hPen                As Long
   '   //  Dibujamos lineas al Azar
       '   //  Calculamos el Punto de Inicio
   Linea.PuntoInicio.x = NumeroAleatorio(RegionWindows.Left, RegionWindows.Right)
   Linea.PuntoInicio.y = NumeroAleatorio(RegionWindows.Top, RegionWindows.Bottom)
       '   //  Calculamos el Punto Final
   Linea.PuntoFinal.x = NumeroAleatorio(RegionWindows.Left, RegionWindows.Right)
   Linea.PuntoFinal.y = NumeroAleatorio(RegionWindows.Top, RegionWindows.Bottom)
   '   //  Dibujamos la Linea
   '   //  Dibujamos los puntos    Inicio y Final en color rojo
       '   //  Color de la Linea
       hPen = CreatePen(PS_SOLID, 1, vbRed)
       SelectObject hdcDestino, hPen
       Ellipse hdcDestino, Linea.PuntoInicio.x - 2, Linea.PuntoInicio.y - 2, Linea.PuntoInicio.x + 2, Linea.PuntoInicio.y + 2
       Ellipse hdcDestino, Linea.PuntoFinal.x - 2, Linea.PuntoFinal.y - 2, Linea.PuntoFinal.x + 2, Linea.PuntoFinal.y + 2
       DeleteObject hPen
       '   //  Color de la Linea
       hPen = CreatePen(PS_SOLID, 1, (RGB(NumeroAleatorio(0, 255), NumeroAleatorio(0, 255), NumeroAleatorio(0, 255))))
       SelectObject hdcDestino, hPen
       '   //  Iniciamos una nueva Linea (Punto de Inicio)
       MoveToEx hdcDestino, Linea.PuntoInicio.x, Linea.PuntoInicio.y, ByVal 0&
       '   //  Finalizamos la Linea (Punto Final)
       LineTo hdcDestino, Linea.PuntoFinal.x, Linea.PuntoFinal.y
       DeleteObject hPen
End Sub
Public Function NumeroAleatorio(MinNum As Long, MaxNum As Long) As Long
Dim Tmp                                 As Long
   If MaxNum < MinNum Then: Tmp = MaxNum: MaxNum = MinNum: MinNum = Tmp
   Randomize: NumeroAleatorio = CLng((MinNum - MaxNum + 1) * Rnd + MaxNum)
End Function



Temibles Lunas!¡.
.

[f RetDel > 0 Then]

.
Sigue estando mal xP

El archivo Source JAMAS LO CIERRAS
La logica de si existe y borrar esta mal xS, mas enconcreto la linea If RetDel > 0 Then

Aqui esta algo que hice (Aun que ya te lo había enseñado pongo):

Código (vb) [Seleccionar] Expandir



'
' ////////////////////////////////////////////////////////////////
' // Autores: BlackZeroX ( Ortega Avila Miguel Angel )          //
' //          The Swash  ( Idea Principal )                     //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Código siempre y cuando         //
' // no se eliminen los créditos originales de este código      //
' // No importando que sea modificado/editado o engrandecido    //
' // o achicado, si es en base a este código                    //
' // |-> Si usas el codigo para algun fin da los Creditos       //
' //       repectivos asi seguiremos liberando Source           //
' ////////////////////////////////////////////////////////////////

Option Explicit
'   //  Globales
Const INVALID_HANDLE_VALUE = -1
'   //  Para Archivos y similares
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100
'   //  Tratadod de Archivos
Const FILE_BEGIN = 0
Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
Const CREATE_NEW = 1
Const OPEN_EXISTING = 3
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000

'   //  Declaracion de Apis
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreateFileA Lib "kernel32" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function DeleteFileA Lib "kernel32" (ByVal lpFileName As String) As Long
Private Declare Function PathFileExistsA Lib "shlwapi.dll" (ByVal pszPath As String) As Long
Private Declare Function GetFileAttributesA Lib "kernel32" (ByVal lpFileName As String) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long

Public Function XCopyFile(ByVal strSource As String, ByVal strDest As String, Optional ByVal ReplaceFile As Boolean = False, Optional CopyAttributes As Boolean = True) As Long
Dim FileDestAttributes          As Long
    If GetFileAttributesA(strSource) And FILE_ATTRIBUTE_ARCHIVE Then
        FileDestAttributes = GetFileAttributesA(strDest)
        If ReplaceFile And (Not FileDestAttributes = INVALID_HANDLE_VALUE) Then
            If FileDestAttributes And FILE_ATTRIBUTE_ARCHIVE Then
                SetFileAttributes strDest, FILE_ATTRIBUTE_NORMAL  '   //  Por si las Moscas xP
                FileDestAttributes = DeleteFileA(strDest)
            End If
            If Not FileDestAttributes > 0 And ReplaceFile Then Exit Function
        End If
        XCopyFile = XWriteFileByte(strDest, XReadFileByte(strSource), , ReplaceFile, True)
        If XCopyFile And CopyAttributes Then SetFileAttributes strDest, GetFileAttributesA(strSource)
    End If
End Function

Public Function XReadFile(strSource As String, Optional ByteIni As Long = 1, Optional LenBuffer As Long = -1) As String
On Error Resume Next
   XReadFile = StrConv(XReadFileByte(strSource, ByteIni, LenBuffer), vbUnicode)
End Function
Public Function XReadFileByte(strSource As String, Optional ByteIni As Long = 1, Optional LenBuffer As Long = 0) As Byte()
Dim hFile           As Long
Dim vBuffer()       As Byte
Dim LFilesize       As Long
Dim vReadBytes      As Long
Dim ResPointerFile  As Long

   If GetFileAttributesA(strSource) And FILE_ATTRIBUTE_ARCHIVE Then
       hFile = CreateFileA(strSource, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
       If Not hFile = INVALID_HANDLE_VALUE Then
           ResPointerFile = 1
           If ByteIni > 1 Then
               ResPointerFile = SetFilePointer(hFile, ByteIni - 1, 0, FILE_BEGIN)
           End If
           If ResPointerFile Then
               LFilesize = GetFileSize(hFile, 0)
               If LenBuffer > 0 And LenBuffer < LFilesize Then
                   LFilesize = LFilesize - ByteIni + 1
                   If LenBuffer + ByteIni < LFilesize Then
                       LFilesize = LenBuffer
                   End If
               End If
               ReDim vBuffer(LFilesize)
               If ReadFile(hFile, vBuffer(LBound(vBuffer)), UBound(vBuffer), vReadBytes, ByVal 0&) Then
                   XReadFileByte = vBuffer
               End If
           End If
           Call CloseHandle(hFile)
       End If
   End If
End Function
Public Function XWriteFile(srtSource As String, vDataWrite As String, Optional ByteIni As Long = 1, Optional RemplaceData As Boolean = False, Optional CreateFile As Boolean = True) As Long
On Error Resume Next
Dim vArray()        As Byte
   vArray = StrConv(vDataWrite, vbFromUnicode)
   ReDim Preserve vArray(UBound(vArray) + 1)
   XWriteFile = XWriteFileByte(srtSource, vArray, ByteIni, RemplaceData, CreateFile)
End Function
Public Function XWriteFileByte(srtSource As String, vDataWrite() As Byte, Optional ByteIni As Long = 1, Optional RemplaceData As Boolean = False, Optional CreateFile As Boolean = True) As Long
Dim hFile           As Long
Dim LDataSize       As Long
Dim vWriteBytes     As Long
Dim FileSize        As Long

   If Not ((Not vDataWrite) = -1) Then
       LDataSize = UBound(vDataWrite) - LBound(vDataWrite)
       If LDataSize >= 0 And ByteIni > 0 Then
           If CreateFile And (PathFileExistsA(srtSource) = False) Then
               hFile = CreateFileA(srtSource, GENERIC_WRITE, FILE_SHARE_WRITE, ByVal 0&, CREATE_NEW, 0, 0)
           ElseIf GetFileAttributesA(srtSource) And FILE_ATTRIBUTE_ARCHIVE And (RemplaceData Or ByteIni > 0) Then
               hFile = CreateFileA(srtSource, GENERIC_WRITE, FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
           Else
               hFile = INVALID_HANDLE_VALUE
           End If
           If Not hFile = INVALID_HANDLE_VALUE Then
           FileSize = GetFileSize(hFile, ByVal 0&)
               If ByteIni >= FileSize Then
                   ByteIni = FileSize + 1
               End If
               If ByteIni > 1 Then
                   SetFilePointer hFile, ByteIni - 1, 0, FILE_BEGIN
               End If
               XWriteFileByte = WriteFile(hFile, vDataWrite(LBound(vDataWrite)), UBound(vDataWrite), vWriteBytes, ByVal 0&)
               Call CloseHandle(hFile)
           End If
       End If
   End If
End Function




Forma de uso:

Código (Vb) [Seleccionar] Expandir



Sub main()
Dim Datos               As String
Dim ResXCopy            As Boolean
Const StrFile1          As String = "c:\archivox.txt"
Const StrFile2          As String = "c:\archivoY.txt"
Const MSG               As String = "Hola"
   ResXCopy = XCopyFile(StrFile1, StrFile2, True, True)      '   //  Copiamos, reemplazamos y pegamos atributos al destino
   Debug.Print "Copy " & IIf(ResXCopy, "Ok", "Fail")   '   //  Presentamos
   Datos = XReadFile(StrFile1)                         '   //  leemos todo el archivo
   Debug.Print "ReadALlFile " & Datos
   Datos = XReadFile(StrFile1, , 5)                    '   //  leemos Solo los 5 primeros bytes
   Debug.Print "ReadALlFile " & Datos
   Datos = XReadFile(StrFile1, 7)                      '   //  leemos desde la posicion numero 7
   Debug.Print "ReadALlFile " & Datos
   Datos = XReadFile(StrFile1, 7, 2)                   '   //  leemos dos datos
   Debug.Print "ReadALlFile " & Datos
   If XWriteFile(StrFile2, MSG, 5, , True) Then Debug.Print "WriteFileOk"
End Sub



Ojo en la funciones Read el ultimo caracter es un byte 0 o caracter NUll (se debe a que use un array desde Index 0 xP y no desde 1, uan que el XCopyFile trabaja bien, sin agregar nada)

P.D.: Estoy trabajando en un modulo de clase para mejorarlo (cuando lo termine lo posteo), mientras el código de arriba funciona para lo que se desea.

Temible Lunas!¡.
.

mira mi post de HexAndString

copea y mete en un podulo despues mete este codigo:

Código (vb) [Seleccionar] Expandir



Sub main()
Dim Datos       As String
Dim ff          As Integer
Const Ruta      As String = "c:\archivox.txt"
   ff = FreeFile
   Open Ruta For Binary As ff
       Datos = Space(LOF(ff) )
       Get ff, , Datos
   Close ff
   MsgBox Datos
   MsgBox HexAndString(Datos, StringToHex)
End Sub



Dulces Lunas!¡.

:http://www.virustotal.com/analisis/697e756e37c60a3f077883ec8da0f21aec6f6f63773facfd4ca7ef0e639de21d-1263471785

Saludos

Vovi a compilar aquí dejo el proyecto que use y su exe compilado que subí, esta limpio la heurística ni salta por ningún motivo, por otra parte indague mas y ya vi eso que mencionas xP, para a otra reviso ejemplos y cosas DESPUÉS de crear y ANTES de postearlo, pero aun asi esta cosa me salio de asi desde cero y lo de duro a no por mi no hay problema mi consciencia esta limpia.

Descargar EXE y Source del mismo

El reporte de este EXE.

http://www.virustotal.com/analisis/70c2588764f5f6f579aa60d0e2443e0b566d265840d75a3a02926dcfa82bdbb8-1263769885

Dulces Lunas!¡.

[youtube=425,350]http://www.youtube.com/watch?v=IP55jTZiea0&NR=1[/youtube]

[youtube=425,350]http://www.youtube.com/watch?v=MTkGPfMRXtc[/youtube]

[youtube=425,350]http://www.youtube.com/watch?v=UUeMgZrLO8s[/youtube]

[youtube=425,350]http://www.youtube.com/watch?v=v8pppXFMKCA[/youtube]

Documentales ( jejejeje )

[youtube=425,350]http://www.youtube.com/watch?v=gWSCBBMYMSg[/youtube]

Peliculas

[youtube=425,350]http://www.youtube.com/watch?v=vAa9_AMnsy0[/youtube]

[youtube=425,350]http://www.youtube.com/watch?v=xqGk33RAZA8[/youtube]

'//
[youtube=425,350]http://www.youtube.com/watch?v=jfShkumjeq8[/youtube]

[youtube=425,350]http://www.youtube.com/watch?v=KYF8hOPm_qM[/youtube]

[youtube=425,350]http://www.youtube.com/watch?v=lcI4hWwPadc[/youtube]