Mensajes

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

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 [Seleccionar] Expandir

<?xml version="1.0" encoding="UTF-8"?>
si yo descargo el documento en disco y pongo

Código [Seleccionar] Expandir

<?xml version="1.0" encoding="ISO-8859-1"?>
lee el documento correctamente.

Código [Seleccionar] Expandir

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


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 [Seleccionar] Expandir


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

[PubDate]

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 [Seleccionar] Expandir

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

Hola esta off, y no cambio de dominio.

Saludos.

Aguante Visual basic!!!!!!

Bueno quien mas si no era LaVolpe 
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=61062&lngWId=1

Quien quiera ahorrarse un poco de trabajo ya lo tiene hecho

Código [Seleccionar] Expandir

http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=54237&lngWId=1
Creo que el señor Amoxys ya ha ganado el reto

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.

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.

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 (vb) [Seleccionar] Expandir

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 (vb) [Seleccionar] Expandir

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Sub Form_Load()
    Dim i As Long
    Dim PT1 As POINTAPI
    Dim PT2 As POINTAPI
    Dim mPT() As POINTAPI
   
    Me.ScaleMode = vbPixels
   
    Command1.Caption = "A"
    Command2.Caption = "B"
   
    PT1.X = Command1.Left
    PT1.Y = Command1.Top
   
    PT2.X = Command2.Left
    PT2.Y = Command2.Top
   
    CreatePointLine PT1, PT2, mPT

    Me.Show
   
    For i = 0 To UBound(mPT)
        Command1.Move mPT(i).X, mPT(i).Y
        DoEvents
        Sleep 5
    Next
   
End Sub


Private Function CreatePointLine(PT1 As POINTAPI, PT2 As POINTAPI, DestPT() As POINTAPI)
    Dim X As Long, Y As Long
    Dim i As Long, j As Long
   
    X = Abs(PT2.X - PT1.X)
    Y = Abs(PT2.Y - PT1.Y)
       
    If X > Y Then
        ReDim DestPT(X)
        For i = PT1.X To PT1.X + X
       
            If PT1.X > PT2.X Then
                DestPT(j).X = PT1.X - j
            Else
                DestPT(j).X = PT1.X + j
            End If
                       
            If PT1.Y > PT2.Y Then
                DestPT(j).Y = PT1.Y - (Y * (j * 100 / X) / 100)
            Else
                DestPT(j).Y = PT1.Y + (Y * (j * 100 / X) / 100)
            End If
            j = j + 1
        Next
    Else
        ReDim DestPT(Y)
        For i = PT1.Y To PT1.Y + Y
       
            If PT1.Y > PT2.Y Then
                DestPT(j).Y = PT1.Y - j
            Else
                DestPT(j).Y = PT1.Y + j
            End If

            If PT1.X > PT2.X Then
                DestPT(j).X = PT1.X - (X * (j * 100 / Y) / 100)
            Else
                DestPT(j).X = PT1.X + (X * (j * 100 / Y) / 100)
            End If
            j = j + 1
        Next
    End If
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 (vb) [Seleccionar] Expandir


Option Explicit
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Sub Form_Load()
    Dim i As Long
    Dim PT1 As POINTAPI
    Dim PT2 As POINTAPI
    Dim mPT() As POINTAPI
    Dim hRgn As Long
   
    With Me
        .AutoRedraw = True
        .ScaleMode = vbPixels
        .Width = 10000
        .Height = 10000
    End With
   
    Command1.Move 350, 50, 32, 32: Command1.Caption = "A"
    Command2.Move 400, 570, 32, 32: Command2.Caption = "B"
   
    hRgn = CreateRegion
    FillRgn Me.hdc, hRgn, GetStockObject(4)
   
   
    PT1.x = Command1.Left
    PT1.y = Command1.Top
   
    PT2.x = Command2.Left
    PT2.y = Command2.Top
   
   
   
    '---------- Esta función es el reto-----------
    'CreatePointLine hRgn, PT1, PT2, mPT
    '---------------------------------------------

    Me.Show
    On Error Resume Next
    For i = 0 To UBound(mPT)
        Command1.Move mPT(i).x, mPT(i).y
        DoEvents
        Sleep 5
    Next
   
    DeleteObject hRgn
End Sub

' La funcion del Reto
Private Function CreatePointLine(ByVal hRgn As Long, PT1 As POINTAPI, PT2 As POINTAPI, DestPT() As POINTAPI) As Boolean
    '---------
End Function

Private Function CreateRegion() As Long
    Dim PT(0 To 9) As POINTAPI
   
    PT(0).x = 170: PT(0).y = 203
    PT(1).x = 310: PT(1).y = 287
    PT(2).x = 398: PT(2).y = 192
    PT(3).x = 403: PT(3).y = 301
    PT(4).x = 560: PT(4).y = 217
    PT(5).x = 457: PT(5).y = 375
    PT(6).x = 551: PT(6).y = 506
    PT(7).x = 375: PT(7).y = 425
    PT(8).x = 164: PT(8).y = 492
    PT(9).x = 275: PT(9).y = 339

    CreateRegion = CreatePolygonRgn(PT(0), 10, 1)
End Function


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