Visual Basic Foro

Redireccionando las llamadas a las apis, para eso necesitas realizar un HOOK API, el problema aqui es SABER cual redireccionar... por ejemplo puedes realizar un hook al api send() y redireccionarla a un proceso o modulo cargado con anterioridad y asi modificar los datos...

http://docs.rtfm.us/IT/Uncategorised/apihooking.pdf

Dulces Lunas!¡.

.
@wolf_kof

Si es .NEt bajate la SDK para Windows Mobile... aun que me parece que en el .net 2010 ya viene por default, la SDK trae un emulador de PDA.

Dulces Lunas!¡.

.
No se yo tampoco ingles pero entiendo el ingles escrito ( Cuando me hablan, lo unico que se me ocurre decir es "La tuya"  ya que no entiendo ni "J" ), por otro lado se aprende mucho viendo codigos ajenos mirate estos:

• http://www.planet-source-code.com/vb/scripts/BrowseCategoryOrSearchResults.asp?lngWId=1&txtCriteria=Opengl
• http://nio.astronomy.cz/vb/opengl.html
• http://www.pauldahuach.com.ar/program_en.htm

Esta es la Libreria:

• http://home.pacific.net.hk/~edx/tlb.htm

tambien mirate este enlace

• http://translate.google.com.mx/

Dulces Lunas!¡.

.
Si para eso hay una propiedad llamada Render de la propiedad picture de los controles, con esa deberas redibujar a dicho hDC e el mismo ( Con un respaldo del original )


(Form/Objecto/Picture).picture.render


Dulces Lunas!¡.

.
Unos ejemplos...

Transpasar un Icono de una coleccion a otra


Option Explicit
Private Sub Form_Load()
AutoRedraw = True
Dim a                   As Cls_ImageList
Const Str_BMP           As String = "Angeles"         '   //  Aqui guardamos imagenes Grandes
Const Str_BMP2          As String = "AngelesMinis"    '   //  Nos servira solo para Redidibujar e mini
Dim lng_Index           As Long

    Set a = New Cls_ImageList
    With a
        If Not .ImageListCreate(Str_BMP, 128, 128) = 0 Then ' // Nos devuelve el Handle de la coleccion de imagenes.
            lng_Index = .ImageList_ADDLoadFromFile(Str_BMP, App.Path & "\img\a1.bmp", IMAGE_BITMAP)
            If Not .ImageListCreate(Str_BMP2, 32, 32) = 0 Then
                lng_Index = .ImageList_ADDLoadFromHandle(Str_BMP2, .ImageListGetHIcon(Str_BMP, lng_Index), IMAGE_ICON)
                .ImageListDraw Str_BMP, lng_Index, Me.hDC, 20, 50
                .ImageListDraw Str_BMP2, lng_Index, Me.hDC, 20, 50
            End If
        End If
    End With
    Set a = Nothing
   
Refresh
End Sub


Agregas Iconos desde Instancias de colecciones ajenas...


Option Explicit
Private Const MAX_PATH = 260
Private Const SHGFI_DISPLAYNAME = &H200         ' get display name
Private Const SHGFI_EXETYPE = &H2000           ' return exe type
Private Const SHGFI_LARGEICON = &H0           ' get large icon
Private Const SHGFI_SHELLICONSIZE = &H4         ' get shell size icon
Private Const SHGFI_SMALLICON = &H1           ' get small icon
Private Const SHGFI_ICON = &H100
Private Const SHGFI_SYSICONINDEX = &H4000        ' get system icondex
Private Const SHGFI_TYPENAME = &H400           ' get type name
Private Const ILD_BLEND50 = &H4
Private Const ILD_BLEND25 = &H2
Private Const ILD_TRANSPARENT = &H1
Private Const CLR_NONE = &HFFFFFFFF
Private Const CLR_DEFAULT = &HFF000000

Private Type SHFILEINFO
    hIcon As Long                       ' : icon
    iIcon As Long                       ' : icondex
    dwAttributes As Long                ' : SFGAO_ flags
    szDisplayName As String * MAX_PATH  ' : display name (or path)
    szTypeName As String * 80           ' : type name
End Type

Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long

Private Sub Form_Load()
AutoRedraw = True
Dim a                   As Cls_ImageList
Const Str_BMP           As String = "System"         '   //  Aqui guardamos imagenes Grandes
Const Str_BMP2          As String = "SystemMinis"    '   //  Nos servira solo para Redidibujar e mini
Dim lng_Index           As Long
Dim lng_sys_himl        As Long
Dim SHINFO              As SHFILEINFO
 
    Set a = New Cls_ImageList
    With a
   
        If Not .ImageListCreate(Str_BMP, 128, 128) = 0 Then ' // Nos devuelve el Handle de la coleccion de imagenes.
            lng_sys_himl = SHGetFileInfo("c:\", 0, SHINFO, LenB(SHINFO), SHGFI_ICON Or SHGFI_LARGEICON)
            If Not lng_sys_himl = 0 Then
                lng_Index = .ImageList_ADDLoadFromHandle(Str_BMP, SHINFO.hIcon, IMAGE_ICON)
            End If
            If Not .ImageListCreate(Str_BMP2, 32, 32) = 0 Then
                lng_Index = .ImageList_ADDLoadFromHandle(Str_BMP2, .ImageListGetHIcon(Str_BMP, lng_Index), IMAGE_ICON)
                .ImageListDraw Str_BMP, lng_Index, Me.hDC, 20, 50
                .ImageListDraw Str_BMP2, lng_Index, Me.hDC, 20, 50
            End If
        End If
       
    End With
    Set a = Nothing
 
Refresh
End Sub


Temibles Lunas!¡.

.
http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=25:20-clsimagelist&catid=15:catmoduloscls&Itemid=24

Este Modulo de Clase es solo una pequeña sustitucion al ImageList, no tiene gran cosa y no se parece en lo absoluto a los de Cobein, ya que este solo esta diseñado para que trabaje con iconos, aun que puede cargar BMP, Cursores e Iconos obviamente.

1.0 Cls_ImageList
1.2 Cls_ImageList
1.3 Cls_ImageList

2.0 Cls_ImageList


'   /////////////////////////////////////////////////////////////
'   //                  ImageList.Cls   2.0                    //
'   // *    ADD Events                                         //
'   // *    ADD Convert Icons To Picture                       //
'   // *    Fix Swap                                           //
'   // *    Fix Duplicate                                      //
'   /////////////////////////////////////////////////////////////


EDITO: --> Subi Nuevamente el Archivo ya que era una version Anterior.

Edito: ---> Agrego solo un ejemplo Basico...


Private Sub Form_Load()
AutoRedraw = True
Dim a                   As Cls_ImageList
Const Str_BMP           As String = "Angeles"         '   //  Aqui guardamos imagenes Grandes
Const Str_BMP2          As String = "AngelesMinis"    '   //  Nos servira solo para Redidibujar e mini
Dim lng_Index           As Long

    Set a = New Cls_ImageList
    With a

        If Not .ImageListCreate(Str_BMP, 512, 512) = 0 Then ' // Nos devuelve el Handle de la coleccion de imagenes.
            lng_Index = .ImageList_ADDLoadFromFile(Str_BMP, App.Path & "\img\a1.bmp", IMAGE_BITMAP)
            If .ImageListDuplicate(Str_BMP, Str_BMP2) Then
                .ImageListDraw Str_BMP2, lng_Index, Me.hDC, 20, 50
                If .ImageListSetSize(Str_BMP, 32, 32) Then
                    .ImageListDraw Str_BMP, lng_Index, Me.hDC, 20, 50
                End If
                .ImageListDestroy Str_BMP2 ' // Eliminamos la Coleccion de imagenes
                .ImageListDraw Str_BMP2, lng_Index, Me.hDC, 20, 50 ' // esta linea ya no pictara nada ya que la coleccion ya esta destruida.
            End If
        End If
       
    End With
    Set a = Nothing
   
Refresh
End Sub



Temibles Lunas!¡.
.

.
Este UC lo vengo haciendo en pocos ratos que tengo, esta realizado con las APIS GDI, aun no esta optimisado, pero ya esta funcional,

Importante: La programacion de los eventos como MouseDown estan bajo los mensajes de windows, ya que si se ponen bajo los eventos del UC salen errores como "Expresion demasiado compleja"

* ListView colorido.
* Seleccion con Click + Control
* ScrollGhost (Funciona al mantener pulsado el mouse sobre alguna de las 4 regiones disponibles)
* QuickSort como motor de Ordenacion.
* tengo weba de escribir las demas Funciones... asi que veanlo...
*- Seleccion con Shift aun no agregado.
*-Aun no tiene soporte para iconos (despues lo agrego).

http://infrangelux.sytes.net/Blog/index.php?option=com_content&view=article&id=22:src-uc-listviewex&catid=13:controlesdeusuario&Itemid=21

algunas imagenes...





Temibles Lunas!¡.

.
El Codigo es Expansible... de forma muy facil
.
El siguiente codigo me costo un Ojo de la cara... es para convertir cualquier Numero a Texto Plano. lo hice por Hobby mas que por nesesidad, espero le saquen provecho!¡.

Como maximo mumero que puede leer son es: 999999999999999999999999999999

Novecientos noventa y nueve Octillónes novecientos noventa y nueve Sextillónes novecientos noventa y nueve Quintillónes novecientos noventa y nueve Cuatrillónes novecientos noventa y nueve Trillones novecientos noventa y nueve Billones novecientos noventa y nueve Mil novecientos noventa y nueve Millones novecientos noventa y nueve Mil novecientos noventa y nueve

Billon          10^12       <--( 5 ).
Trillon         10^18       <--( 4 ).
Cuatrillón      10^24       <--( 3 ).
Quintillón      10^30       <--( 2 ).
Sextillón       10^36       <--( 1 ).
Octillón        10^42       <--( 0 ).
<--Obviamente Los siguientes numeros no los tomaremos en cuenta-->
Gúgol           10^100      <--(-1 ).
Googolplex      10^10^Gúgol <--(-2 ).


http://infrangelux.sytes.net/Blog/index.php?option=com_content&view=article&id=8:arrtnum2string&catid=2:catprocmanager&Itemid=8


'
'   /////////////////////////////////////////////////////////////
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandecido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////
 
Public Function Number2String(ByVal VInNumber As String) As String
'   //  Meximo  --> 999999999999999999999999999999 ' sección Octillón...
'   //  Billon          10^12       <--( 5 ).
'   //  Trillon         10^18       <--( 4 ).
'   //  Cuatrillón      10^24       <--( 3 ).
'   //  Quintillón      10^30       <--( 2 ).
'   //  Sextillón       10^36       <--( 1 ).
'   //  Octillón        10^42       <--( 0 ).
'   //  <--Obviamente Los siguientes numeros no los tomaremos en cuenta-->
'   //  Gúgol           10^100      <--(-1 ).
'   //  Googolplex      10^10^Gúgol <--(-2 ).
Dim Str_Temp                            As String
Dim Byt_Index                           As Byte
Dim Byt_Digito                          As Byte
Dim Byt_Centena                         As Byte
Dim Byt_Decena                          As Byte
Dim Byt_Unidad                          As Byte
Dim Str_Leyenda                         As String
Dim lng_LenStr                          As Long
Const clng_MaxLen = &H1E

    lng_LenStr = Len(VInNumber)
    If lng_LenStr > clng_MaxLen Or lng_LenStr = 0 Then Exit Function
    Str_Temp = String$(clng_MaxLen, "0")
    Mid(Str_Temp, clng_MaxLen - lng_LenStr + 1) = Mid$(VInNumber, 1, lng_LenStr)
 
    For Byt_Index = 1 To clng_MaxLen / 3

        Byt_Centena = CByte(Mid$(Str_Temp, Byt_Index * 3 - 2, 1))
        Byt_Decena = CByte(Mid$(Str_Temp, Byt_Index * 3 - 1, 1))
        Byt_Unidad = CByte(Mid$(Str_Temp, Byt_Index * 3, 1))

        Select Case Byt_Index
            Case 1
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Octillón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Octillónes "
                End If
            Case 2
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Sextillón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Sextillónes "
                End If
            Case 3
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Quintillón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Quintillónes "
                End If
            Case 4
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Cuatrillón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Cuatrillónes "
                End If
            Case 5
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Trillon "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Trillones "
                End If
            Case 6
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Billón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Billones "
                End If
            Case 7
                If Byt_Centena + Byt_Decena + Byt_Unidad >= 1 And Val(Mid$(Str_Temp, 21, 3)) = 0 Then
                    Str_Leyenda = "Mil Millones "
                ElseIf Byt_Centena + Byt_Decena + Byt_Unidad >= 1 Then
                    Str_Leyenda = "Mil "
                End If
            Case 8
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Millón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Millones "
                End If
            Case 9
                If Byt_Centena + Byt_Decena + Byt_Unidad >= 1 Then Str_Leyenda = "Mil "
            Case 10
                If Byt_Centena + Byt_Decena + Byt_Unidad >= 1 Then Str_Leyenda = ""
        End Select
        Number2String = Number2String + Centena(Byt_Unidad, Byt_Decena, Byt_Centena) + Decena(Byt_Unidad, Byt_Decena) + Unidad(Byt_Unidad, Byt_Decena) + Str_Leyenda
        Str_Leyenda = ""
    Next

End Function

Private Function Centena(ByVal Byt_Uni As Byte, ByVal Byt_Decimal As Byte, ByVal Byt_Centena As Byte) As String
    Select Case Byt_Centena
        Case 1: If Byt_Decimal + Byt_Uni = 0 Then Centena = "cien " Else Centena = "ciento "
        Case 2: Centena = "doscientos "
        Case 3: Centena = "trescientos "
        Case 4: Centena = "cuatrocientos "
        Case 5: Centena = "quinientos "
        Case 6: Centena = "seiscientos "
        Case 7: Centena = "setecientos "
        Case 8: Centena = "ochocientos "
        Case 9: Centena = "novecientos "
    End Select
End Function

Private Function Decena(ByVal Byt_Uni As Byte, ByVal Byt_Decimal As Byte) As String
    Select Case Byt_Decimal
        Case 1
            Select Case Byt_Uni
                Case 0: Decena = "diez "
                Case 1: Decena = "once "
                Case 2: Decena = "doce "
                Case 3: Decena = "trece "
                Case 4: Decena = "catorce "
                Case 5: Decena = "quince "
                Case 6 To 9: Decena = "dieci "
            End Select
        Case 2
            If Byt_Uni = 0 Then
                Decena = "veinte "
            ElseIf Byt_Uni > 0 Then
                Decena = "veinti "
            End If
        Case 3: Decena = "treinta "
        Case 4: Decena = "cuarenta "
        Case 5: Decena = "cincuenta "
        Case 6: Decena = "sesenta "
        Case 7: Decena = "setenta "
        Case 8: Decena = "ochenta "
        Case 9: Decena = "noventa "
    End Select
    If Byt_Uni > 0 And Byt_Decimal > 2 Then Decena = Decena + "y "
End Function

Private Function Unidad(ByVal Byt_Uni As Byte, ByVal Byt_Decimal As Byte) As String
    If Byt_Decimal <> 1 Then
        Select Case Byt_Uni
            Case 1: Unidad = "un "
            Case 2: Unidad = "dos "
            Case 3: Unidad = "tres "
            Case 4: Unidad = "cuatro "
            Case 5: Unidad = "cinco "
        End Select
    End If
    Select Case Byt_Uni
            Case 6: Unidad = "seis "
            Case 7: Unidad = "siete "
            Case 8: Unidad = "ocho "
            Case 9: Unidad = "nueve "
    End Select
End Function


Dulce Infierno Lunar!¡.