VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "URLtoIP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Dim PortN As String
Dim Anfor As String
Dim Buffer As String
Dim Ncount As Integer

Private WithEvents wins As CSocket
Attribute wins.VB_VarHelpID = -1
Private CallConn As Object

Public RealServer As String

Public Sub TimerEvent(TimerID As Integer)
  CanceldRes
End Sub

Public Sub ConvertToIP(ConnectionClass As Object, wURL As String)
  Dim I As Integer
  Dim I2 As Integer
  Dim I3 As Integer
  
  Set CallConn = ConnectionClass
  If Ncount > 4 Then CanceldRes: Exit Sub
  If UCase(Left(wURL, 7)) = "HTTP://" Then I = 7
  I2 = InStr(I + 1, wURL, ":")
  I3 = InStr(I + 1, wURL, "/")
  If I3 = 0 Then I3 = Len(wURL) + 1
  If I2 = 0 Or I2 > I3 Then
    I2 = I3
    PortN = "80"
  Else
    PortN = Mid(wURL, I2 + 1, I3 - I2 - 1)
  End If
  If I2 = 0 Then I2 = Len(wURL) + 2
  RealServer = Mid(wURL, I + 1, I2 - I - 1)
  If I3 = Len(wURL) + 1 Then
    Anfor = "/"
  Else
    Anfor = Right(wURL, Len(wURL) - I3 + 1)
  End If
  If wins.State > 1 Then wins.Disconnect
  DnsResolve Me
End Sub

Public Sub DnsResEvent(IP As String)
  wins.LocalPort = 0
  wins.Connect IP, PortN
  StartTimer Me, 5000, 1
End Sub

Private Sub wins_Closed()
  CanceldRes
End Sub

Public Sub CanceldRes()
  KillTimerByID 1, Me
  If wins.State > 1 Then wins.Disconnect
  CallConn.RealServer = ""
  CallConn.FinishConnection
End Sub

Private Sub wins_Connected()
  Dim HttpRe As String
  HttpRe = "GET " + Anfor + " HTTP/1.0" + Chr(13) + Chr(10)
  HttpRe = HttpRe + "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*" + Chr(13) + Chr(10)
  HttpRe = HttpRe + "Accept-Language: de" + Chr(13) + Chr(10)
  HttpRe = HttpRe + "User-Agent: Mozilla/4.0 (compatible; Nettalk)" + Chr(13) + Chr(10)
  HttpRe = HttpRe + "Host: " + RealServer + Chr(13) + Chr(10)
  HttpRe = HttpRe + "Connection: Close" + Chr(13) + Chr(10) + Chr(13) + Chr(10)
  wins.SendData HttpRe
  Buffer = ""
  StartTimer Me, 5000, 1
End Sub

Private Sub WinS_DataArrival()
  Dim I As Long
  Dim I2 As Long
  Dim I3 As Long
  Dim BinData As String
  
  wins.Recive BinData
  Buffer = Buffer + BinData
  
  If Len(Buffer) = 0 Then Exit Sub
  I3 = InStr(1, Buffer, Chr(13) + Chr(10) + Chr(13) + Chr(10))
  If I3 > 0 Then
    I = InStr(1, Buffer, "Location: ")
    If I > 0 Then
      I2 = InStr(I, Buffer, Chr(13) + Chr(10))
      ConvertToIP CallConn, Mid(Buffer, I + 10, I2 - I - 10)
      Exit Sub
    End If
    KillTimerByID 1, Me
    If wins.State > 1 Then wins.Disconnect
    If Len(Buffer) > I3 + 4 Then
      I2 = InStr(I3 + 4, Buffer, Chr(13))
      If I2 = 0 Then I2 = Len(Buffer) + 1
      CallConn.RealServer = Mid(Buffer, I3 + 4, I2 - I3 - 4)
      CallConn.FinishConnection
    Else
      CanceldRes
    End If
  End If
End Sub

Private Sub Class_Initialize()
  Set wins = New CSocket
  Ncount = 0
End Sub

Private Sub Class_Terminate()
  KillTimerByID 1, Me
  If wins.State > 1 Then wins.Disconnect
End Sub
