elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Únete al Grupo Steam elhacker.NET


  Mostrar Mensajes
Páginas: 1 2 3 4 5 6 7 8 [9] 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 ... 74
81  Programación / Programación Visual Basic / Re: Problemas para leer un RSS (Microsoft.XMLDOM) en: 9 Junio 2011, 03:37 am
Buenisimo raul, parece que funciona bien, por lo de los signos raros no importa lo ago la combercion de UTF-8 a unicode.

Saludos y muchas gracias
82  Programación / Programación Visual Basic / Problemas para leer un RSS (Microsoft.XMLDOM) en: 8 Junio 2011, 21:07 pm
Hola tengo problemas para leer un rss, estoy usando Microsoft.XMLDOM, el problema es cuando trato de leer el documento ("Load"), lo que es extraño para mí es que con Firefox o Internet Explorer se muestra correctamente.

el problema es con este rss http://www.taringa.net/rss/home/ultimos-posts/

al parecer es por la primera linea
Código:
<?xml version="1.0" encoding="UTF-8"?>

si yo descargo el documento en disco y pongo
Código:
<?xml version="1.0" encoding="ISO-8859-1"?>
lee el documento correctamente.

Código:
Option Explicit
'Private Doc As DOMDocument
Private Doc As Object

Private Sub Form_Load()
    Dim sURL As String
    
    'This fail
    sURL = "http://www.taringa.net/rss/home/ultimos-posts/"
    
    'This ok if Doc.validateOnParse = False
    'sURL = "http://ezrss.it/feed/"
    
    
    'This ok
    'sURL = "http://d.yimg.com/ar.rss.news.yahoo.com/rss/insolitas"
    
    'Set Doc = New DOMDocument
    Set Doc = CreateObject("Msxml2.DOMDocument.3.0") 'or "Microsoft.XMLDOM"
    
    Doc.resolveExternals = False
    Doc.async = False
    Doc.validateOnParse = False

 
    If Doc.Load(sURL) Then
        Debug.Print Doc.xml
    Else
        Debug.Print Doc.parseError
    End If
End Sub
83  Programación / Programación Visual Basic / Re: Conversión de fecha (PubDate) en: 7 Junio 2011, 03:23 am
Hola gracias, por lo que creo la Z es lo mismo que tu nick Zero osea  0, segui buscando y encontre otros formatos mas asi que reize la funcion, la funcion que vos hisiste tiene un problema al obtener la fecha utilizando mid() ya que si esta en el formato norteamericano ponen el año primero.

Código:
Option Explicit
 
Private Type TIME_ZONE_INFORMATION
   Bias                             As Long
   Reserved(0 To 169)               As Byte
End Type
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
 
Private Sub Form_Load()

    Debug.Print PubDateToVBDate("Sun, 05 Jun 2011 07:57:15 PDT")
    Debug.Print PubDateToVBDate("Sun, 05 Jun 2011 22:06:29 GMT")
    Debug.Print PubDateToVBDate("Mon, 06 Jun 2011 14:47:05 EDT")
    Debug.Print PubDateToVBDate("Sun, 05 Jun 2011 13:52:53 PST")
    Debug.Print PubDateToVBDate("2011-06-05 21:35:26")
    Debug.Print PubDateToVBDate("8/7/2010 12:16:37 AM")
    Debug.Print PubDateToVBDate("8/6/2010 11:46:33 PM")
    Debug.Print PubDateToVBDate("6/6/2011 11:35:14 PM GMT")
    Debug.Print PubDateToVBDate("Wed, 27 Apr 2011 18:26:06 +0000")
    Debug.Print PubDateToVBDate("Wed, 27 Apr 2011 18:26:06 +0200")
    Debug.Print PubDateToVBDate("2011-06-06T06:16:42+02:00")
    Debug.Print PubDateToVBDate("2011-06-06T06:16:42-02:00")
    Debug.Print PubDateToVBDate("2011-06-06T05:40:00Z")
    Debug.Print PubDateToVBDate("2011-06-06T17:45:23+00:00")

End Sub
 
Private Function PubDateToVBDate(ByVal sPubDate As String) As Date
    Dim tTZI           As TIME_ZONE_INFORMATION
    Dim lRet As Long
    Dim TDelay As String
    Dim sSimbol As String
    Dim sHour As String
    Dim sMinute As String
    Dim ArrMonthEnglish As Variant
    
    Dim I As Long
 
    GetTimeZoneInformation tTZI
    
    sPubDate = UCase(sPubDate)
    
    ArrMonthEnglish = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")
    
    For I = 0 To 11
        sPubDate = Replace(sPubDate, CStr(ArrMonthEnglish(I)), I + 1)
    Next

    If IsDate(sPubDate) Then
        PubDateToVBDate = DateAdd("h", -(tTZI.Bias / 60), CDate(sPubDate))
        Exit Function
    End If
 
    lRet = InStr(sPubDate, ", ")
    If lRet Then
        sPubDate = Mid(sPubDate, lRet + 2)
    End If

    If IsDate(sPubDate) Then 'por las dudas
        PubDateToVBDate = DateAdd("h", -(tTZI.Bias / 60), CDate(sPubDate))
        Exit Function
    End If
    
    lRet = InStr(sPubDate, " ")

    If lRet = 0 Then
        sPubDate = Replace(sPubDate, "T", " ")
        If Right(sPubDate, 1) = "Z" Then
            sPubDate = Replace(sPubDate, "Z", "+00:00")
        End If
        TDelay = Replace(Right$(sPubDate, 6), ":", "")
        sPubDate = Left$(sPubDate, Len(sPubDate) - 6)
    Else
        
        Select Case Right(sPubDate, 3)
            Case "GMT":         TDelay = "+0000"
            Case "EDT":         TDelay = "-0400"
            Case "CDT", "EST":  TDelay = "-0500"
            Case "CST", "MDT":  TDelay = "-0600"
            Case "MST", "PDT":  TDelay = "-0700"
            Case "PST", "ADT":  TDelay = "-0800"
            Case "AST", "HDT":  TDelay = "-0900"
            Case "HDT":         TDelay = "-1000"
        End Select

        If Len(TDelay) Then
            sPubDate = Left(sPubDate, Len(sPubDate) - 4)
        Else
            TDelay = Right(sPubDate, 5)
            sPubDate = Left(sPubDate, Len(sPubDate) - 6)
         
        End If
    End If
    
    If IsDate(sPubDate) Then
    
        sSimbol = Left$(TDelay, 1)
        sHour = Mid$(TDelay, 2, 2)
        sMinute = Right$(TDelay, 2)
        
        If IsNumeric(sHour) And IsNumeric(sMinute) Then
            If sSimbol = "+" Then
                sPubDate = DateAdd("h", -Val(sHour), CDate(sPubDate))
                sPubDate = DateAdd("m", -Val(sMinute), CDate(sPubDate))
            ElseIf sSimbol = "-" Then
                sPubDate = DateAdd("h", Val(sHour), CDate(sPubDate))
                sPubDate = DateAdd("m", Val(sMinute), CDate(sPubDate))
            End If
            
            PubDateToVBDate = DateAdd("h", -(tTZI.Bias / 60), CDate(sPubDate))
        End If
        
    End If
            
End Function

creo que no hay mas variantes, si alguno encuentra algo que avise.

Saludos
84  Programación / Programación Visual Basic / Conversión de fecha (PubDate) en: 6 Junio 2011, 06:32 am
Hola alguien necesito pasar una tipo de fecha PubDate (son las que vienen los rss, feed, atom etc) pero bueno mirando un poco vi que tienen muchos formatos diferentes y no se bien si estoy haciendo lo correcto
por el momento hice esta función pero tengo problema con los dos últimos formatos
(2011-06-06T06:16:42+02:00    Y    2011-06-05T21:46:13Z) alguien conoce otra forma o como mejorar esta.

Código:
Option Explicit

Private Type TIME_ZONE_INFORMATION
   Bias As Long
   Reserved(0 To 169) As Byte
End Type
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
        
Private Sub Form_Load()

Debug.Print PubDateToVBDate("Sun, 05 Jun 2011 07:57:15 PDT")
Debug.Print PubDateToVBDate("Sun, 05 Jun 2011 22:06:29 GMT")
Debug.Print PubDateToVBDate("2011-06-05 21:35:26")
Debug.Print PubDateToVBDate("Sun, 05 Jun 2011 13:52:53 PST")
Debug.Print PubDateToVBDate("2011-06-06T06:16:42+02:00")
Debug.Print PubDateToVBDate("2011-06-05T21:46:13Z")


End Sub


Private Function PubDateToVBDate(ByVal sPubDate As String) As Date
    Dim TZI As TIME_ZONE_INFORMATION

    Dim sDate As String
    Dim lRet As Long
    lRet = InStr(sPubDate, ", ")
    If lRet Then
        sDate = Mid$(sPubDate, InStr(sPubDate, ", ") + 2)
    Else
        sDate = sPubDate
    End If

    If InStrRev(sDate, " ") <> InStr(sDate, " ") Then
        sDate = Left$(sDate, InStrRev(sDate, " "))
    End If
    GetTimeZoneInformation TZI
    sDate = DateAdd("h", -(TZI.Bias / 60), CDate(sDate))
    If InStr(sPubDate, "PDT") Then sDate = DateAdd("h", 7, sDate)
    If InStr(sPubDate, "PST") Then sDate = DateAdd("h", 8, sDate)
    PubDateToVBDate = sDate
End Function
85  Programación / Programación Visual Basic / Re: Que paso con uploadsourceocde en: 26 Mayo 2011, 02:03 am
Hola esta off, y no cambio de dominio.

Saludos.
86  Programación / Programación Visual Basic / Re: Feliz Cumpleaños Visual Basic!! en: 21 Mayo 2011, 22:22 pm
Aguante Visual basic!!!!!!
87  Programación / Programación Visual Basic / Re: [Reto]Punto A Punto en: 16 Mayo 2011, 22:20 pm
Bueno quien mas si no era LaVolpe  :P
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=61062&lngWId=1
88  Programación / Programación Visual Basic / Re: [Reto]Punto A Punto en: 16 Mayo 2011, 19:37 pm
Cita de: Karcrack en 15 Mayo 2011, 17:21 pm
Quien quiera ahorrarse un poco de trabajo ya lo tiene hecho :P
Código:
http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=54237&lngWId=1
Creo que el señor Amoxys ya ha ganado el reto :laugh: :laugh:

Hola he revisado el codigo y esta muy bueno, es casi lo que dice el reto o almenos la idea principal, pero solo funcionaria con Regiones de poligonos con una clase interna que maneja los x, y de cada linea, ahora que pasaria si la region es un CreateEllipticRgn, la verdad como dije en un principio es vastante complicado, no probe aun pero quizas tomando como ejemplo dicho surce y creando un array de point en base a una región (GetRegionData) se pueda hacer.
89  Programación / Programación Visual Basic / Re: [Reto]Punto A Punto en: 15 Mayo 2011, 04:46 am
Huy que bruto puse POINTAPY, ya lo corregí, supongo que le ponen API al final para no chocar con algunas clases privadas en algunos lenguajes.
la velocidad es secundario por el momento, ya que es muy dificil el reto de lograrlo, sobre todo cuando uno piensa en todas las posiciones del punto A con respecto al B y las diferentes formas y posicion de la region.
yo por el momento no doy con ninguna solucion.
90  Programación / Programación Visual Basic / [Reto]Punto A Punto en: 15 Mayo 2011, 02:01 am
Buenas para darle un poco mas de emoción al foro voy a proponer un nuevo Reto, el cual lo veo super difícil, según mi punto de vista hay que usar mucha lógica, este reto va a durar un mes o menos si alguien lo resuelve.  asi que le voy a poner una chincheta hasta que se termine.

Les paso a explicar en que consiste:
Situados dos puntos "A" y "B"  debe crearse un Array de puntos (POINTAPI) desde "A" hacia "B" lo cual no es muy difícil, el reto sera que abra un obstáculo de por medio el cual debera esquivar este obstáculo sera una Región (CreateRectRgn, CreateEllipticRgn, CreateRoundRectRgn, etc) para detectar si hay colición podemos utilizar el api
Código
  1. Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long

para tener una idea mejor muestro un ejemplo (no optimizado) de como seria "el puto "A" al "B" sin el obstaculo.

(Agregar dos CommandButton a un formulario bien separados)
Código
  1. Option Explicit
  2.  
  3. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  4.  
  5. Private Type POINTAPI
  6.     X As Long
  7.     Y As Long
  8. End Type
  9.  
  10. Private Sub Form_Load()
  11.     Dim i As Long
  12.     Dim PT1 As POINTAPI
  13.     Dim PT2 As POINTAPI
  14.     Dim mPT() As POINTAPI
  15.  
  16.     Me.ScaleMode = vbPixels
  17.  
  18.     Command1.Caption = "A"
  19.     Command2.Caption = "B"
  20.  
  21.     PT1.X = Command1.Left
  22.     PT1.Y = Command1.Top
  23.  
  24.     PT2.X = Command2.Left
  25.     PT2.Y = Command2.Top
  26.  
  27.     CreatePointLine PT1, PT2, mPT
  28.  
  29.     Me.Show
  30.  
  31.     For i = 0 To UBound(mPT)
  32.         Command1.Move mPT(i).X, mPT(i).Y
  33.         DoEvents
  34.         Sleep 5
  35.     Next
  36.  
  37. End Sub
  38.  
  39.  
  40. Private Function CreatePointLine(PT1 As POINTAPI, PT2 As POINTAPI, DestPT() As POINTAPI)
  41.     Dim X As Long, Y As Long
  42.     Dim i As Long, j As Long
  43.  
  44.     X = Abs(PT2.X - PT1.X)
  45.     Y = Abs(PT2.Y - PT1.Y)
  46.  
  47.     If X > Y Then
  48.         ReDim DestPT(X)
  49.         For i = PT1.X To PT1.X + X
  50.  
  51.             If PT1.X > PT2.X Then
  52.                 DestPT(j).X = PT1.X - j
  53.             Else
  54.                 DestPT(j).X = PT1.X + j
  55.             End If
  56.  
  57.             If PT1.Y > PT2.Y Then
  58.                 DestPT(j).Y = PT1.Y - (Y * (j * 100 / X) / 100)
  59.             Else
  60.                 DestPT(j).Y = PT1.Y + (Y * (j * 100 / X) / 100)
  61.             End If
  62.             j = j + 1
  63.         Next
  64.     Else
  65.         ReDim DestPT(Y)
  66.         For i = PT1.Y To PT1.Y + Y
  67.  
  68.             If PT1.Y > PT2.Y Then
  69.                 DestPT(j).Y = PT1.Y - j
  70.             Else
  71.                 DestPT(j).Y = PT1.Y + j
  72.             End If
  73.  
  74.             If PT1.X > PT2.X Then
  75.                 DestPT(j).X = PT1.X - (X * (j * 100 / Y) / 100)
  76.             Else
  77.                 DestPT(j).X = PT1.X + (X * (j * 100 / Y) / 100)
  78.             End If
  79.             j = j + 1
  80.         Next
  81.     End If
  82. End Function

como ven crea un array de puntos de "A" hasta "B" ahora les dejo un prototipo para empezar a crear una funcion similar con una Region la cual devera esquivar para poder llegar al punto "B"

Código
  1. Option Explicit
  2. Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
  3. Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
  4. Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
  5. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  6. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  7. Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
  8.  
  9. Private Type POINTAPI
  10.     x As Long
  11.     y As Long
  12. End Type
  13.  
  14. Private Sub Form_Load()
  15.     Dim i As Long
  16.     Dim PT1 As POINTAPI
  17.     Dim PT2 As POINTAPI
  18.     Dim mPT() As POINTAPI
  19.     Dim hRgn As Long
  20.  
  21.     With Me
  22.         .AutoRedraw = True
  23.         .ScaleMode = vbPixels
  24.         .Width = 10000
  25.         .Height = 10000
  26.     End With
  27.  
  28.     Command1.Move 350, 50, 32, 32: Command1.Caption = "A"
  29.     Command2.Move 400, 570, 32, 32: Command2.Caption = "B"
  30.  
  31.     hRgn = CreateRegion
  32.     FillRgn Me.hdc, hRgn, GetStockObject(4)
  33.  
  34.  
  35.     PT1.x = Command1.Left
  36.     PT1.y = Command1.Top
  37.  
  38.     PT2.x = Command2.Left
  39.     PT2.y = Command2.Top
  40.  
  41.  
  42.  
  43.     '---------- Esta función es el reto-----------
  44.     'CreatePointLine hRgn, PT1, PT2, mPT
  45.     '---------------------------------------------
  46.  
  47.     Me.Show
  48.     On Error Resume Next
  49.     For i = 0 To UBound(mPT)
  50.         Command1.Move mPT(i).x, mPT(i).y
  51.         DoEvents
  52.         Sleep 5
  53.     Next
  54.  
  55.     DeleteObject hRgn
  56. End Sub
  57.  
  58. ' La funcion del Reto
  59. Private Function CreatePointLine(ByVal hRgn As Long, PT1 As POINTAPI, PT2 As POINTAPI, DestPT() As POINTAPI) As Boolean
  60.     '---------
  61. End Function
  62.  
  63. Private Function CreateRegion() As Long
  64.     Dim PT(0 To 9) As POINTAPI
  65.  
  66.     PT(0).x = 170: PT(0).y = 203
  67.     PT(1).x = 310: PT(1).y = 287
  68.     PT(2).x = 398: PT(2).y = 192
  69.     PT(3).x = 403: PT(3).y = 301
  70.     PT(4).x = 560: PT(4).y = 217
  71.     PT(5).x = 457: PT(5).y = 375
  72.     PT(6).x = 551: PT(6).y = 506
  73.     PT(7).x = 375: PT(7).y = 425
  74.     PT(8).x = 164: PT(8).y = 492
  75.     PT(9).x = 275: PT(9).y = 339
  76.  
  77.     CreateRegion = CreatePolygonRgn(PT(0), 10, 1)
  78. End Function
  79.  

Aqui una imagen de lo que deberia hacer



para culminar, el objetivo es tratar de que funcione, luego se evaluara la velocidad en generar el array, y cual es la que genere el array mas preciso para llegar del punto A al B
Páginas: 1 2 3 4 5 6 7 8 [9] 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 ... 74
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines