Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.
Cita de: Raul100 en 6 Junio 2011, 02:07 AM
de como escribir en una archivo de texto en la misma linea osea
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-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 stTZI As TIME_ZONE_INFORMATION
Dim lln As Long
Dim sTagGet As String
Dim sAdd As String
Dim lAdd As Long
Dim llnAdd As Long
GetTimeZoneInformation stTZI
If (UCase(Mid$(sPubDate, 11, 1)) = "T") Then
Mid$(sPubDate, 11, 1) = " "
lln = InStrRev(sPubDate, "+")
If (lln > 0) Then
lAdd = 1
Else
lln = InStrRev(sPubDate, "-")
If (lln > 0) Then
lAdd = (-1)
End If
End If
If (lln > 0) Then
sAdd = Mid$(sPubDate, lln + 1)
llnAdd = Len(sAdd)
If (lAdd = 1) Then
sPubDate = Replace$(sPubDate, "+" & sAdd, "")
Else
sPubDate = Replace$(sPubDate, "-" & sAdd, "")
End If
End If
sTagGet = sPubDate
Mid$(sPubDate, 1, 2) = Mid$(sTagGet, 9, 2) ' // Dia.
Mid$(sPubDate, 3, 1) = " "
Mid$(sPubDate, 4, 2) = Mid$(sTagGet, 6, 2) ' // Mes.
Mid$(sPubDate, 6, 1) = " "
Mid$(sPubDate, 7, 4) = Mid$(sTagGet, 1, 4) ' // Año.
lln = Len(sPubDate)
If (lln > 19) Then
sPubDate = Left$(sPubDate, 19)
End If
If (llnAdd > 0) Then
If (llnAdd >= 2) Then
sPubDate = DateAdd("h", Val(Mid$(sAdd, 1, 2)) * lAdd, CDate(sPubDate)) ' // Horas
End If
If (llnAdd >= 5) Then
sPubDate = DateAdd("m", Val(Mid$(sAdd, 4, 2)) * lAdd, CDate(sPubDate)) ' // Minutos
End If
If (llnAdd >= 8) Then
sPubDate = DateAdd("s", Val(Mid$(sAdd, 7, 2)) * lAdd, CDate(sPubDate)) ' // Segundos
End If
End If
Else
lln = Len(sPubDate)
sTagGet = Right$(sPubDate, 3)
sPubDate = Mid$(sPubDate, InStr(sPubDate, ", ") + 2)
sPubDate = Left$(sPubDate, InStrRev(sPubDate, " ") - 1)
sPubDate = DateAdd("h", -(stTZI.Bias / 60), CDate(sPubDate))
Select Case sTagGet
Case "PDT"
sPubDate = DateAdd("h", 7, sPubDate)
Case "PST"
sPubDate = DateAdd("h", 8, sPubDate)
'Case "GMT"
' // No se que hacer xP...
End Select
End If
PubDateToVBDate = CDate(sPubDate)
End Function
' // Para valores tipo Long
Private Sub lSwap(ByRef lVal1 As Long, ByRef lVal2 As Long)
' // Intercambia {lVal1} por {lVal2} y {lVal2} a {lVal1} sin variable temporal
lVal1 = lVal1 Xor lVal2
lVal2 = lVal2 Xor lVal1
lVal1 = lVal1 Xor lVal2
End Sub
Private Function lIsNegative(ByRef lVal As Long)
' // Para cualquier valor que lVal pueda tomar.
' // Comprueba si lval es negativo.
lIsNegative = (lVal And &H80000000)
End Function
Private Function iIsNegative(ByRef iVal As Integer) As Boolean
' // Para cualquier valor que iVal pueda tomar.
' // Comprueba si lval es negativo.
iIsNegative = (iVal And 32768)
End Function
Private Sub iSwap(ByRef iVal1 As Integer, ByRef iVal2 As Integer)
' // Intercambia {iVal1} por {iVal2} y {iVal2} a {iVal1} sin variable temporal
iVal1 = iVal1 Xor iVal2
iVal2 = iVal2 Xor iVal1
iVal1 = iVal1 Xor iVal2
End Sub
Private Sub bSwap(ByRef iVal1 As byte, ByRef iVal2 As byte)
' // Intercambia {iVal1} por {iVal2} y {iVal2} a {iVal1} sin variable temporal
iVal1 = iVal1 Xor iVal2
iVal2 = iVal2 Xor iVal1
iVal1 = iVal1 Xor iVal2
End Sub
Function max(ByVal val1 As Long, ByVal val2 As Long) As Long
If (val1 > val2) Then
max = val1
Else
max = val2
End If
End Function
Function min(ByVal val1 As Long, ByVal val2 As Long) As Long
If (val1 > val2) Then
min = val2
Else
min = val1
End If
End Function
Function bSwapBit(ByVal myLong As Long, ByVal bit1 As Byte, ByVal bit2 As Byte) As Long
' Los bits se CUENTAS DE DERECHA A IZQUIERDA es decir: 31, 30, ... , 3, 2, 1, 0
' Solo se admite rango 0 al 31.
Dim aux As Long
Dim mask As Long
aux = max(bit1, bit2)
bit2 = min(bit1, bit2)
bit1 = aux ' max
Debug.Assert (bit1 > 31) ' No se permiten numero mayores a 32
Debug.Assert (bit2 < 0) ' No se permiten valores negativos
mask = Not ((2 ^ bit1) Or (2 ^ bit2))
aux = (2 ^ (bit1 - bit2))
bSwapBit = (myLong And mask) Or _
(myLong And (2 ^ bit1)) / aux Or _
(myLong And (2 ^ bit2)) * aux
End Function
option explicit
Public Function ExitsInArrayNR(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
Dim lng_lb As Long
Dim lng_Ub As Long
lng_lb = LBound(vBuff&())
lng_Ub = UBound(vBuff&())
If Not vBuff&(lng_Ub) > vBuff&(lng_lb) Then
Dim t As Long
t = lng_Ub
lng_Ub = lng_lb
lng_lb = t
End If
Do Until ExitsInArrayNR
Select Case vValue
Case vBuff&(lng_lb&)
p& = lng_lb&
ExitsInArrayNR = True
Case vBuff&(lng_Ub&)
p& = lng_Ub&
ExitsInArrayNR = True
Case Else
p = (lng_lb& + lng_Ub&) / 2
If p <> lng_lb& And p& <> lng_Ub& Then
If vBuff&(p&) < vValue& Then
lng_lb = p
ElseIf vBuff&(p&) > vValue& Then
lng_Ub = p
ElseIf vBuff&(p&) = vValue& Then
ExitsInArrayNR = True
End If
Else
Exit Do
End If
End Select
Loop
End Function
option explicit
Private Sub SwapVals(ByRef lVal1 As Long, ByRef lval2 As Long)
lval2 = lval2 Xor lVal1
lVal1 = lVal1 Xor lval2
lval2 = lval2 Xor lVal1
End Sub
Public Function ExitsInArray(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
Dim lng_lb As Long
Dim lng_Ub As Long
lng_lb = LBound(vBuff&())
lng_Ub = UBound(vBuff&())
If Not vBuff&(lng_Ub) > vBuff&(lng_lb) Then
SwapVals lng_lb, lng_Ub
End If
Select Case vValue
Case vBuff&(lng_lb&)
p& = lng_lb&
ExitsInArray = True
Case vBuff&(lng_Ub&)
p& = lng_Ub&
ExitsInArray = True
Case Else
Do Until ExitsInArray
p = (lng_lb& + lng_Ub&) / 2
If p <> lng_lb& And p& <> lng_Ub& Then
If vBuff&(p&) < vValue& Then
lng_lb = p
ElseIf vBuff&(p&) > vValue& Then
lng_Ub = p
ElseIf vBuff&(p&) = vValue& Then
ExitsInArray = True
End If
Else
Exit Do
End If
Loop
End Select
End Function