AuroNet/AuroNet.cls

   1 VERSION 1.0 CLASS
   2 BEGIN
   3   MultiUse = -1  'True
   4   Persistable = 0  'NotPersistable
   5   DataBindingBehavior = 0  'vbNone
   6   DataSourceBehavior  = 0  'vbNone
   7   MTSTransactionMode  = 0  'NotAnMTSObject
   8 END
   9 Attribute VB_Name = "AuroNet"
  10 Attribute VB_GlobalNameSpace = False
  11 Attribute VB_Creatable = True
  12 Attribute VB_PredeclaredId = False
  13 Attribute VB_Exposed = False
  14 Option Explicit
  15 '<CSCC>
  16 '--------------------------------------------------------------------------------
  17 '    Componente  : AuroNet 0.1
  18 '    Projecto    : Herramientas AuroWare
  19 '
  20 '    Descripción : Libreria de uso general para la interacción WEB
  21 '    Depende de  : cSocketMaster, modSocketMaster, modBasico, AuroNetConf
  22 '
  23 '    Modificado  :
  24 '   24/06/07 - UserAgent como propiedad
  25 '   24/06/07 - Control de versión
  26 '--------------------------------------------------------------------------------
  27 '</CSCC>
  28 '
  29 Private WithEvents AuroSocket As CSocketMaster
  30 Attribute AuroSocket.VB_VarHelpID = -1
  31 Private ErrorGeneral As Boolean
  32 Private ExitoGeneral As Boolean
  33 Private MiTag As String
  34 Private pBuffer As String
  35 Private URL As String
  36 Private Proxy As String
  37 Private Proxy_Puerto As Integer
  38 Private strHTTP As String
  39
  40 Public Function HTML_CONSULTAR() As Boolean
  41     '<EhHeader>
  42     On Error GoTo HTML_CONSULTAR_Err
  43     '</EhHeader>
  44     ExitoGeneral = False
  45     ErrorGeneral = False
  46     Debug.Print Time & "$ CONSULTAR - Inicio | " & URL
  47     strHTTP = vbNullString
  48     AuroSocket.Connect IIf(Proxy <> "", Proxy, HostDeURL) & pBuffer, IIf(Proxy <> "", Proxy_Puerto, 80)
  49
  50     Do
  51         Esperar 0.5
  52     Loop Until AuroSocket.State = sckConnected Or AuroSocket.State = sckError Or ErrorGeneral
  53
  54     If AuroSocket.State <> sckConnected Then
  55         HTML_CONSULTAR = False
  56         ExitoGeneral = False
  57         ErrorGeneral = True
  58     Else
  59         HTML_CONSULTAR = True
  60         ExitoGeneral = True
  61         ErrorGeneral = False
  62     End If
  63
  64     AuroSocket.CloseSck
  65     Debug.Print Time & "$ CONSULTAR - Fin | " & HTML_CONSULTAR
  66     '<EhFooter>
  67     Exit Function
  68 HTML_CONSULTAR_Err:
  69     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.HTML_CONSULTAR"
  70     Resume Next
  71     '</EhFooter>
  72 End Function
  73
  74 Public Function Exito()
  75     '<EhHeader>
  76     On Error GoTo Exito_Err
  77     '</EhHeader>
  78     Exito = ExitoGeneral
  79     '<EhFooter>
  80     Exit Function
  81 Exito_Err:
  82     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Exito"
  83     Resume Next
  84     '</EhFooter>
  85 End Function
  86
  87 Public Function HTML_GET(Optional Parametros As String) As String
  88     '<EhHeader>
  89     On Error GoTo HTML_GET_Err
  90     '</EhHeader>
  91 Redireccion:
  92     Debug.Print "$ GET - Inicio | " & URL & " | " & Now
  93     AuroSocket.CloseSck
  94
  95     If IsMissing(Parametros) Then pBuffer = vbNullString Else pBuffer = Parametros
  96     ErrorGeneral = False
  97     ExitoGeneral = False
  98     strHTTP = "GET " + IIf(Proxy <> "", URL, URLdeHost) & pBuffer + " HTTP/1.0" + vbCrLf
  99     strHTTP = strHTTP + "Accept: " + ACCEPT_TOKEN + vbCrLf
 100     strHTTP = strHTTP + "Referer: " + HostDeURL + vbCrLf
 101     strHTTP = strHTTP + "User-Agent: " + USERAGENT_TOKEN + vbCrLf
 102     strHTTP = strHTTP + "Host: " + HostDeURL + vbCrLf
 103     strHTTP = strHTTP + vbCrLf
 104     AuroSocket.Connect IIf(Proxy <> "", Proxy, HostDeURL) & pBuffer, IIf(Proxy <> "", Proxy_Puerto, 80)
 105
 106     Do
 107         Esperar 0.5
 108     Loop Until ExitoGeneral Or ErrorGeneral
 109
 110     AuroSocket.CloseSck
 111     Dim pRedireccion As Long
 112     Dim Redireccion As String
 113     Dim Cabeceras As String
 114     Cabeceras = ObtenerCabeceras(pBuffer)
 115     pRedireccion = InStr(1, Cabeceras, "Location:")
 116
 117     If pRedireccion <> 0 Then
 118         pRedireccion = pRedireccion + Len("Location:")
 119         Redireccion = Trim$(Mid$(Cabeceras, pRedireccion, InStr(pRedireccion, Cabeceras, vbCrLf) - pRedireccion))
 120
 121         If URL <> Redireccion Then
 122             Direccion = Redireccion
 123             Debug.Print Time & "$ GET - Redirección | " & URL
 124             GoTo Redireccion
 125         End If
 126     End If
 127
 128     HTML_GET = ObtenerHTML(pBuffer)
 129     Debug.Print "$SOCKET HTML leido | " & Len(HTML_GET) & " | " & Now
 130
 131     If Len(pBuffer) <> 0 And ExitoGeneral = True And ErrorGeneral = False Then
 132         ExitoGeneral = True
 133     Else
 134         ErrorGeneral = True
 135     End If
 136
 137     '<EhFooter>
 138     Exit Function
 139 HTML_GET_Err:
 140     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.HTML_GET"
 141     Resume Next
 142     '</EhFooter>
 143 End Function
 144
 145 Public Function IpLocal()
 146     '<EhHeader>
 147     On Error GoTo IpLocal_Err
 148     '</EhHeader>
 149     IpLocal = AuroSocket.LocalIP
 150     '<EhFooter>
 151     Exit Function
 152 IpLocal_Err:
 153     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.IpLocal"
 154     Resume Next
 155     '</EhFooter>
 156 End Function
 157
 158 Private Function HostDeURL() As String
 159     '<EhHeader>
 160     On Error GoTo HostDeURL_Err
 161     '</EhHeader>
 162     HostDeURL = Replace$(Trim$(URL), "http://", vbNullString)
 163     Dim Init As Integer
 164     Init = InStr(1, HostDeURL, "/", vbTextCompare)
 165
 166     If Init <> 0 Then HostDeURL = Left$(HostDeURL, Init - 1)
 167     '<EhFooter>
 168     Exit Function
 169 HostDeURL_Err:
 170     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.HostDeURL"
 171     Resume Next
 172     '</EhFooter>
 173 End Function
 174
 175 Private Function URLdeHost() As String
 176     '<EhHeader>
 177     On Error GoTo URLdeHost_Err
 178     '</EhHeader>
 179     URLdeHost = Replace$(Trim$(URL), "http://", vbNullString)
 180     Dim Init As Integer
 181     Init = InStr(1, URLdeHost, "/", vbTextCompare)
 182
 183     If Init <> 0 Then URLdeHost = Mid$(URLdeHost, Init)
 184     '<EhFooter>
 185     Exit Function
 186 URLdeHost_Err:
 187     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.URLdeHost"
 188     Resume Next
 189     '</EhFooter>
 190 End Function
 191
 192 Private Sub AuroSocket_CloseSck()
 193     '<EhHeader>
 194     On Error GoTo AuroSocket_CloseSck_Err
 195     '</EhHeader>
 196     Debug.Print "$SOCKET - Cerrado" & " | " & Now
 197     ExitoGeneral = True
 198     '<EhFooter>
 199     Exit Sub
 200 AuroSocket_CloseSck_Err:
 201     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.AuroSocket_CloseSck"
 202     Resume Next
 203     '</EhFooter>
 204 End Sub
 205
 206 Private Sub AuroSocket_Connect()
 207     '<EhHeader>
 208     On Error GoTo AuroSocket_Connect_Err
 209     '</EhHeader>
 210     AuroSocket.SendData strHTTP
 211     Debug.Print "$SOCKET - Datos enviados" & " | " & Now
 212     '<EhFooter>
 213     Exit Sub
 214 AuroSocket_Connect_Err:
 215     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.AuroSocket_Connect"
 216     Resume Next
 217     '</EhFooter>
 218 End Sub
 219
 220 Private Sub AuroSocket_DataArrival(ByVal bytesTotal As Long)
 221     '<EhHeader>
 222     On Error GoTo AuroSocket_DataArrival_Err
 223     '</EhHeader>
 224     Dim Pedazo As String
 225     AuroSocket.GetData Pedazo
 226     pBuffer = pBuffer & Pedazo
 227     Debug.Print "$SOCKET - Respuesta recibida | " & AuroSocket.State & " | " & bytesTotal & " | " & Now
 228     '<EhFooter>
 229     Exit Sub
 230 AuroSocket_DataArrival_Err:
 231     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.AuroSocket_DataArrival"
 232     Resume Next
 233     '</EhFooter>
 234 End Sub
 235
 236 Private Sub AuroSocket_Error(ByVal Number As Integer, _
 237                              Description As String, _
 238                              ByVal sCode As Long, _
 239                              ByVal Source As String, _
 240                              ByVal HelpFile As String, _
 241                              ByVal HelpContext As Long, _
 242                              CancelDisplay As Boolean)
 243     '<EhHeader>
 244     On Error GoTo AuroSocket_Error_Err
 245     '</EhHeader>
 246     Debug.Print "$SOCKET - ERROR!!!" & " | " & Now
 247     ErrorGeneral = True
 248     '<EhFooter>
 249     Exit Sub
 250 AuroSocket_Error_Err:
 251     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.AuroSocket_Error"
 252     Resume Next
 253     '</EhFooter>
 254 End Sub
 255
 256 Private Sub Class_Initialize()
 257     '<EhHeader>
 258     On Error GoTo Class_Initialize_Err
 259     '</EhHeader>
 260     USERAGENT_TOKEN = "Auronet " & AuroNetVer
 261     Set AuroSocket = New CSocketMaster
 262     '<EhFooter>
 263     Exit Sub
 264 Class_Initialize_Err:
 265     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Class_Initialize"
 266     Resume Next
 267     '</EhFooter>
 268 End Sub
 269
 270 Private Sub Class_Terminate()
 271     '<EhHeader>
 272     On Error Resume Next
 273     '</EhHeader>
 274     Set AuroSocket = Nothing
 275 End Sub
 276
 277 Public Property Get Direccion() As Variant
 278     '<EhHeader>
 279     On Error GoTo Direccion_Err
 280     '</EhHeader>
 281     Direccion = URL
 282     '<EhFooter>
 283     Exit Property
 284 Direccion_Err:
 285     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Direccion"
 286     Resume Next
 287     '</EhFooter>
 288 End Property
 289
 290 Public Property Let Direccion(ByVal pDato As Variant)
 291     '<EhHeader>
 292     On Error GoTo Direccion_Err
 293     '</EhHeader>
 294     URL = pDato
 295     pDato = Replace$(pDato, "http://", "")
 296
 297     If InStr(1, pDato, "/") = 0 Then URL = URL & "/"
 298     '<EhFooter>
 299     Exit Property
 300 Direccion_Err:
 301     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Direccion"
 302     Resume Next
 303     '</EhFooter>
 304 End Property
 305
 306 Public Property Get error() As Variant
 307     '<EhHeader>
 308     On Error GoTo error_Err
 309     '</EhHeader>
 310     error = ErrorGeneral
 311     '<EhFooter>
 312     Exit Property
 313 error_Err:
 314     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.error"
 315     Resume Next
 316     '</EhFooter>
 317 End Property
 318
 319 Public Property Let error(ByVal Estado As Variant)
 320     '<EhHeader>
 321     On Error GoTo error_Err
 322     '</EhHeader>
 323     ErrorGeneral = Estado
 324     '<EhFooter>
 325     Exit Property
 326 error_Err:
 327     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.error"
 328     Resume Next
 329     '</EhFooter>
 330 End Property
 331
 332 Public Property Get Tag() As Variant
 333     '<EhHeader>
 334     On Error GoTo Tag_Err
 335     '</EhHeader>
 336     Tag = MiTag
 337     '<EhFooter>
 338     Exit Property
 339 Tag_Err:
 340     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Tag"
 341     Resume Next
 342     '</EhFooter>
 343 End Property
 344
 345 Public Property Let Tag(ByVal Tag As Variant)
 346     '<EhHeader>
 347     On Error GoTo Tag_Err
 348     '</EhHeader>
 349     MiTag = Tag
 350     '<EhFooter>
 351     Exit Property
 352 Tag_Err:
 353     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Tag"
 354     Resume Next
 355     '</EhFooter>
 356 End Property
 357
 358 Public Property Get Agente() As Variant
 359     '<EhHeader>
 360     On Error GoTo Agente_Err
 361     '</EhHeader>
 362     Agente = USERAGENT_TOKEN
 363     '<EhFooter>
 364     Exit Property
 365 Agente_Err:
 366     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Agente"
 367     Resume Next
 368     '</EhFooter>
 369 End Property
 370
 371 Public Property Let Agente(ByVal vNewValue As Variant)
 372     '<EhHeader>
 373     On Error GoTo Agente_Err
 374     '</EhHeader>
 375     USERAGENT_TOKEN = CStr(vNewValue)
 376     '<EhFooter>
 377     Exit Property
 378 Agente_Err:
 379     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Agente"
 380     Resume Next
 381     '</EhFooter>
 382 End Property
 383
 384 Private Function ObtenerCabeceras(HTML As String) As String
 385     '<EhHeader>
 386     On Error GoTo ObtenerCabeceras_Err
 387     '</EhHeader>
 388     Dim Prueba As Long
 389     Prueba = InStr(1, HTML, vbCrLf & vbCrLf)
 390
 391     If Prueba <> 0 Then ObtenerCabeceras = Left$(HTML, Prueba)
 392     '<EhFooter>
 393     Exit Function
 394 ObtenerCabeceras_Err:
 395     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.ObtenerCabeceras"
 396     Resume Next
 397     '</EhFooter>
 398 End Function
 399
 400 Private Function ObtenerHTML(HTML As String) As String
 401     '<EhHeader>
 402     On Error GoTo ObtenerHTML_Err
 403     '</EhHeader>
 404     Dim Prueba As Long
 405     Prueba = InStr(1, HTML, vbCrLf & vbCrLf)
 406
 407     If Prueba <> 0 Then ObtenerHTML = Mid$(HTML, Prueba + 4)
 408     '<EhFooter>
 409     Exit Function
 410 ObtenerHTML_Err:
 411     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.ObtenerHTML"
 412     Resume Next
 413     '</EhFooter>
 414 End Function
 415
 416 Public Property Get Usar_Proxy() As Variant
 417     '<EhHeader>
 418     On Error GoTo Usar_Proxy_Err
 419     '</EhHeader>
 420     Usar_Proxy = Direccion
 421     '<EhFooter>
 422     Exit Property
 423 Usar_Proxy_Err:
 424     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Usar_Proxy"
 425     Resume Next
 426     '</EhFooter>
 427 End Property
 428
 429 Public Property Let Usar_Proxy(ByVal Direccion As Variant)
 430     '<EhHeader>
 431     On Error GoTo Usar_Proxy_Err
 432     '</EhHeader>
 433     Proxy = CStr(Direccion)
 434     '<EhFooter>
 435     Exit Property
 436 Usar_Proxy_Err:
 437     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Usar_Proxy"
 438     Resume Next
 439     '</EhFooter>
 440 End Property
 441
 442 Public Property Get Usar_Proxy_Puerto() As Variant
 443     '<EhHeader>
 444     On Error GoTo Usar_Proxy_Puerto_Err
 445     '</EhHeader>
 446     Usar_Proxy_Puerto = CStr(Proxy_Puerto)
 447     '<EhFooter>
 448     Exit Property
 449 Usar_Proxy_Puerto_Err:
 450     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Usar_Proxy_Puerto"
 451     Resume Next
 452     '</EhFooter>
 453 End Property
 454
 455 Public Property Let Usar_Proxy_Puerto(ByVal puerto As Variant)
 456     '<EhHeader>
 457     On Error GoTo Usar_Proxy_Puerto_Err
 458     '</EhHeader>
 459     Proxy_Puerto = CInt(puerto)
 460     '<EhFooter>
 461     Exit Property
 462 Usar_Proxy_Puerto_Err:
 463     Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Usar_Proxy_Puerto"
 464     Resume Next
 465     '</EhFooter>
 466 End Property