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 100     ExitoGeneral = False
  45 101     ErrorGeneral = False
  46 102     Debug.Print Time & "$ CONSULTAR - Inicio | " & URL
  47 103     strHTTP = vbNullString
  48 104     AuroSocket.Connect IIf(Proxy <> "", Proxy, HostDeURL) & pBuffer, IIf(Proxy <> "", Proxy_Puerto, 80)
  49
  50         Do
  51 105         Esperar 0.5
  52 106     Loop Until AuroSocket.State = sckConnected Or AuroSocket.State = sckError Or ErrorGeneral
  53
  54 107     If AuroSocket.State <> sckConnected Then
  55 108         HTML_CONSULTAR = False
  56 109         ExitoGeneral = False
  57 110         ErrorGeneral = True
  58         Else
  59 111         HTML_CONSULTAR = True
  60 112         ExitoGeneral = True
  61 113         ErrorGeneral = False
  62         End If
  63
  64 114     AuroSocket.CloseSck
  65 115     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.Ref 12/2/2008 : 09:38:32"
  70         Resume Next
  71         '</EhFooter>
  72 End Function
  73
  74 Public Function Exito()
  75         '<EhHeader>
  76         On Error GoTo Exito_Err
  77         '</EhHeader>
  78 100     Exito = ExitoGeneral
  79         '<EhFooter>
  80         Exit Function
  81 Exito_Err:
  82         Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Exito.Ref 12/2/2008 : 09:38:32"
  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 100     Debug.Print "$ GET - Inicio | " & URL & " | " & Now
  93 101     AuroSocket.CloseSck
  94
  95 102     If IsMissing(Parametros) Then pBuffer = vbNullString Else pBuffer = Parametros
  96 103     ErrorGeneral = False
  97 104     ExitoGeneral = False
  98 105     strHTTP = "GET " + IIf(Proxy <> "", URL, URLdeHost) & pBuffer + " HTTP/1.0" + vbCrLf
  99 106     strHTTP = strHTTP + "Accept: " + ACCEPT_TOKEN + vbCrLf
 100 107     strHTTP = strHTTP + "Referer: " + HostDeURL + vbCrLf
 101 108     strHTTP = strHTTP + "User-Agent: " + USERAGENT_TOKEN + vbCrLf
 102 109     strHTTP = strHTTP + "Host: " + HostDeURL + vbCrLf
 103 110     strHTTP = strHTTP + vbCrLf
 104 111     AuroSocket.Connect IIf(Proxy <> "", Proxy, HostDeURL) & pBuffer, IIf(Proxy <> "", Proxy_Puerto, 80)
 105
 106         Do
 107 112         Esperar 0.5
 108 113     Loop Until ExitoGeneral Or ErrorGeneral
 109
 110 114     AuroSocket.CloseSck
 111         Dim pRedireccion As Long
 112         Dim Redireccion As String
 113         Dim Cabeceras As String
 114 115     Cabeceras = ObtenerCabeceras(pBuffer)
 115 116     pRedireccion = InStr(1, Cabeceras, "Location:")
 116
 117 117     If pRedireccion <> 0 Then
 118 118         pRedireccion = pRedireccion + Len("Location:")
 119 119         Redireccion = Trim$(Mid$(Cabeceras, pRedireccion, InStr(pRedireccion, Cabeceras, vbCrLf) - pRedireccion))
 120
 121 120         If URL <> Redireccion Then
 122 121             Direccion = Redireccion
 123 122             Debug.Print Time & "$ GET - Redirección | " & URL
 124 123             GoTo Redireccion
 125             End If
 126         End If
 127
 128 124     HTML_GET = ObtenerHTML(pBuffer)
 129 125     Debug.Print "$SOCKET HTML leido | " & Len(HTML_GET) & " | " & Now
 130
 131 126     If Len(pBuffer) <> 0 And ExitoGeneral = True And ErrorGeneral = False Then
 132 127         ExitoGeneral = True
 133         Else
 134 128         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.Ref 12/2/2008 : 09:38:32"
 141         Resume Next
 142         '</EhFooter>
 143 End Function
 144
 145 Public Function IpLocal()
 146         '<EhHeader>
 147         On Error GoTo IpLocal_Err
 148         '</EhHeader>
 149 100     IpLocal = AuroSocket.LocalIP
 150         '<EhFooter>
 151         Exit Function
 152 IpLocal_Err:
 153         Controlar_Error Erl, Err.Description, "Reseter.AuroNet.IpLocal.Ref 12/2/2008 : 09:38:32"
 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 100     HostDeURL = Replace$(Trim$(URL), "http://", vbNullString)
 163         Dim Init As Integer
 164 101     Init = InStr(1, HostDeURL, "/", vbTextCompare)
 165
 166 102     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.Ref 12/2/2008 : 09:38:32"
 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 100     URLdeHost = Replace$(Trim$(URL), "http://", vbNullString)
 180         Dim Init As Integer
 181 101     Init = InStr(1, URLdeHost, "/", vbTextCompare)
 182
 183 102     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.Ref 12/2/2008 : 09:38:32"
 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 100     Debug.Print "$SOCKET - Cerrado" & " | " & Now
 197 101     ExitoGeneral = True
 198         '<EhFooter>
 199         Exit Sub
 200 AuroSocket_CloseSck_Err:
 201         Controlar_Error Erl, Err.Description, "Reseter.AuroNet.AuroSocket_CloseSck.Ref 12/2/2008 : 09:38:32"
 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 100     AuroSocket.SendData strHTTP
 211 101     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.Ref 12/2/2008 : 09:38:32"
 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 100     AuroSocket.GetData Pedazo
 226 101     pBuffer = pBuffer & Pedazo
 227 102     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.Ref 12/2/2008 : 09:38:32"
 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 100     Debug.Print "$SOCKET - ERROR!!!" & " | " & Now
 247 101     ErrorGeneral = True
 248         '<EhFooter>
 249         Exit Sub
 250 AuroSocket_Error_Err:
 251         Controlar_Error Erl, Err.Description, "Reseter.AuroNet.AuroSocket_Error.Ref 12/2/2008 : 09:38:32"
 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 100     USERAGENT_TOKEN = "Auronet " & AuroNetVer
 261 101     Set AuroSocket = New CSocketMaster
 262         '<EhFooter>
 263         Exit Sub
 264 Class_Initialize_Err:
 265         Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Class_Initialize.Ref 12/2/2008 : 09:38:32"
 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 100     Direccion = URL
 282         '<EhFooter>
 283         Exit Property
 284 Direccion_Err:
 285         Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Direccion.Ref 12/2/2008 : 09:38:32"
 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 100     URL = pDato
 295 101     pDato = Replace$(pDato, "http://", "")
 296
 297 102     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.Ref 12/2/2008 : 09:38:32"
 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 100     error = ErrorGeneral
 311         '<EhFooter>
 312         Exit Property
 313 error_Err:
 314         Controlar_Error Erl, Err.Description, "Reseter.AuroNet.error.Ref 12/2/2008 : 09:38:32"
 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 100     ErrorGeneral = Estado
 324         '<EhFooter>
 325         Exit Property
 326 error_Err:
 327         Controlar_Error Erl, Err.Description, "Reseter.AuroNet.error.Ref 12/2/2008 : 09:38:32"
 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 100     Tag = MiTag
 337         '<EhFooter>
 338         Exit Property
 339 Tag_Err:
 340         Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Tag.Ref 12/2/2008 : 09:38:32"
 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 100     MiTag = Tag
 350         '<EhFooter>
 351         Exit Property
 352 Tag_Err:
 353         Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Tag.Ref 12/2/2008 : 09:38:32"
 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 100     Agente = USERAGENT_TOKEN
 363         '<EhFooter>
 364         Exit Property
 365 Agente_Err:
 366         Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Agente.Ref 12/2/2008 : 09:38:32"
 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 100     USERAGENT_TOKEN = CStr(vNewValue)
 376         '<EhFooter>
 377         Exit Property
 378 Agente_Err:
 379         Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Agente.Ref 12/2/2008 : 09:38:32"
 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 100     Prueba = InStr(1, HTML, vbCrLf & vbCrLf)
 390
 391 101     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.Ref 12/2/2008 : 09:38:32"
 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 100     Prueba = InStr(1, HTML, vbCrLf & vbCrLf)
 406
 407 101     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.Ref 12/2/2008 : 09:38:32"
 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 100     Usar_Proxy = Direccion
 421         '<EhFooter>
 422         Exit Property
 423 Usar_Proxy_Err:
 424         Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Usar_Proxy.Ref 12/2/2008 : 09:38:32"
 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 100     Proxy = CStr(Direccion)
 434         '<EhFooter>
 435         Exit Property
 436 Usar_Proxy_Err:
 437         Controlar_Error Erl, Err.Description, "Reseter.AuroNet.Usar_Proxy.Ref 12/2/2008 : 09:38:32"
 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 100     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.Ref 12/2/2008 : 09:38:32"
 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 100     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.Ref 12/2/2008 : 09:38:32"
 464         Resume Next
 465         '</EhFooter>
 466 End Property