Dim Eth_buffer(280) As Byte  ' <--- general Buffer from your project for WIZ TX-RX



   Dim Idx_DNS As Byte
   Dim Url As String * 50               ' Variable for holding URL String
   Dim Dns_ip As Dword                ' Variable for resolved URL-IP
   Dim Dns_server As Dword         ' Variable for DNS-SERVER IP. This is normaly your Gateway! i.e. 192.168.1.254

   $include "ETH_DNS.INC"

   Url = "www.google.com"
   Dns_server = Maketcp(192 , 168 , 1 , 254)                                          ' <--- insert your Gateway Address
   Idx_dns = 2                                                                                      ' free Socket No.        
   Dns_ip = Dns_resolve_url(url , Idx_dns , Dns_server, Eth_buffer(1))     ' <--- here we go...

   If Dns_ip > 0 Then
     ' Got IP
      print Ip2str(dns_ip)
   Else
     ' sorry, no IP
    print "no ip"
   End If
 

'*******************************************************************************
'
'  Copyright Michael Koecher aka six1 8/2010
'  -> http://www.six1.net/   michael@koecher-web.de
'
'   http://creativecommons.org/licenses/by-sa/3.0/de/
'
'   Sie dürfen:
'
'     * das Werk bzw. den Inhalt vervielfältigen, verbreiten und öffentlich zugänglich machen
'
'     * Abwandlungen und Bearbeitungen des Werkes bzw. Inhaltes anfertigen
'
'   Zu Den Folgenden Bedingungen:
'
'     * Namensnennung.
'       Sie müssen den Namen des Autors/Rechteinhabers in der von ihm festgelegten Weise nennen.
'
'     * Keine kommerzielle Nutzung.
'       Dieses Werk darf nicht für kommerzielle Zwecke verwendet werden.
'
'     * Weitergabe unter gleichen Bedingungen.
'       Wenn Sie das lizenzierte Werk bzw. den lizenzierten Inhalt bearbeiten
'       oder in anderer Weise erkennbar als Grundlage für eigenes Schaffen verwenden,
'       dürfen Sie die daraufhin neu entstandenen Werke bzw. Inhalte nur
'       unter Verwendung von Lizenzbedingungen weitergeben, die mit denen
'       dieses Lizenzvertrages identisch oder vergleichbar sind.
'
'   Wobei gilt:
'
'     * Verzichtserklärung
'       Jede der vorgenannten Bedingungen kann aufgehoben werden, sofern Sie
'       die ausdrückliche Einwilligung des Rechteinhabers dazu erhalten.
'
'     * Sonstige Rechte
'       Die Lizenz hat keinerlei Einfluss auf die folgenden Rechte:
'          - Die gesetzlichen Schranken des Urheberrechts und sonstigen
'            Befugnisse zur privaten Nutzung
'          - Das Urheberpersönlichkeitsrecht des Rechteinhabers
'          - Rechte anderer Personen, entweder am Lizenzgegenstand selber oder
'            bezüglich seiner Verwendung, zum Beispiel Persönlichkeitsrechte abgebildeter Personen.
'
'  Hinweis
'
'      Im Falle einer Verbreitung müssen Sie anderen alle Lizenzbedingungen
'      mitteilen, die für dieses Werk gelten. Am einfachsten ist es,
'      einen Link auf http://creativecommons.org/licenses/by-sa/3.0/de/ einzubinden.
'

'*******************************************************************************
$nocompile



Dim Udp_dns_port_local As Word
Const Udp_dns_port_remote = 53



'*******************************************************************************
'* PUBLIC DECLARATIONS
'*******************************************************************************
'-------------------------------------------------------------------------------
'  Udp_resolve_url_tx  Get IP from URL
'-------------------------------------------------------------------------------
Declare Function Dns_resolve_url(byref Url As String , Byval Socket As Byte , Dns_server As Dword , Byref Buffer() As Byte ) As Dword



Goto Dns_end









'*******************************************************************************
'* DNS Procedures and Functions
'*******************************************************************************




'-------------------------------------------------------------------------------
'  Udp_resolve_url_tx  Get IP from URL
'-------------------------------------------------------------------------------
Function Dns_resolve_url(byref Url As String , Byval Socket As Byte , Dns_server As Dword, byref Buffer() As Byte ) As Dword
      Local Pos As Word , Y As word , Label_len As Byte , Label_len_pos As Byte
      Local Char As String * 1
      Local Dns_timeout As Word                                                 'in ms
      Local Rx_size As Word
      Local Result As Byte


      Dns_resolve_url = 0

      Udp_dns_port_local = 50000
      Udp_dns_port_local = Udp_dns_port_local + Rnd(15000)

      Pos = 1
      'transaction id
      Buffer(pos) = Rnd(&Hff) : Incr Pos
      Buffer(pos) = Rnd(&Hff) : Incr Pos
      ' flags Standard query = &H1000
      Buffer(pos) = &H01 : Incr Pos
      Buffer(pos) = &H00 : Incr Pos
      ' Questions
      Buffer(pos) = &H00 : Incr Pos
      Buffer(pos) = &H01 : Incr Pos
      ' Answer RRs
      Buffer(pos) = &H00 : Incr Pos
      Buffer(pos) = &H00 : Incr Pos
      ' Authority RRs
      Buffer(pos) = &H00 : Incr Pos
      Buffer(pos) = &H00 : Incr Pos
      ' Additional RRs
      Buffer(pos) = &H00 : Incr Pos
      Buffer(pos) = &H00 : Incr Pos

      'first label len
      Buffer(pos) = &H00
      Label_len_pos = Pos
      Incr Pos

      Label_len = 1
      For Y = 1 To Len(url)
         Char = Mid(url , Y , 1)
         If Char = "." Then
            Decr Label_len
            Buffer(label_len_pos) = Label_len
            Label_len_pos = Pos
            Label_len = 0
         End If
         Buffer(pos) = Asc(char)
         Incr Pos
         Incr Label_len
      Next
      ' last label len
      Decr Label_len
      Buffer(label_len_pos) = Label_len
      'length Zero Byte
      Buffer(pos) = &H00 : Incr Pos
      'Request Type: &H0001 => Host Adress
      Buffer(pos) = &H00 : Incr Pos
      Buffer(pos) = &H01 : Incr Pos
      'Class: IN &H0001
      Buffer(pos) = &H00 : Incr Pos
      Buffer(pos) = &H01


      Closesocket socket
      Result = Getsocket(socket , Sock_dgram , Udp_dns_port_local , 0)
      If Result = 255 Then
         ' open failed
         Dns_resolve_url = 0
      Else
        Result = Udpwrite(Dns_server , Udp_dns_port_remote , Socket , Buffer(1) , Pos)
        Dns_timeout = 0
        Dns_resolve_url = 0
        Do
          Incr Dns_timeout
          Rx_size = Socketstat(socket , Sel_recv)           ' get number of bytes waiting
          If Rx_size > 0 Then
             If Rx_size > 280 Then Rx_size = 280
'             Udpreadheader socket
             Result = Udpread(socket , Buffer(1) , Rx_size)

             For Y = 16 To Rx_size
                Pos = 0
                If Buffer(y) = &H00 Then
                  Pos = Y + 1
                  If Buffer(pos) = &H04 Then
                    Incr Pos
                    Exit For
                  End If
                End If
             Next
             If Pos > 0 Then
               Dns_resolve_url = Maketcp(Buffer(pos) , Buffer(pos + 1) , Buffer(pos + 2) , Buffer(pos + 3) )
             Else
               Dns_resolve_url = 0
             End If
             Dns_timeout = &HFFFF
          End If
          Waitms 1
          Reset Watchdog
        Loop Until Dns_timeout > 2000
      End If
      Closesocket Socket
End Function


Dns_end:
 

    Use_xram = 0

   #if Use_xram = 1
     Dim Eth_buffer(300) As xram Byte
   #else
     Dim Eth_buffer(300) As Byte
   #endif

'-------------------------------------------------------------------------------
' SNTP TIME SERVER
'-------------------------------------------------------------------------------
   Print #1 , "TEST SNTP TIME SERVER"
   Dim Local_time As long
   Time$ = Time(local_time)
   Date$ = Date(local_time)
   Print #1 , "Time before SNTP: " ; Date(local_time) ; ", " ; Time(local_time)

   Dim NTP_ip As Dword
   Dim Sock_sntp As Byte

   Ntp_ip = Maketcp(64.90.182.55 )
   Sock_sntp = Get_free_socket()


   $include "ETH_NTP.inc"

   Call Check_time(sock_sntp , Ntp_ip , Eth_buffer(1))

   Print #1 , "Time after SNTP: " ; Date(local_time) ; ", " ; Time(local_time)
 

'*******************************************************************************
'
'  Copyright Michael Koecher aka six1 8/2010
'  -> http://www.six1.net/   michael@koecher-web.de
'
'   http://creativecommons.org/licenses/by-sa/3.0/de/
'
'   Sie dürfen:
'
'     * das Werk bzw. den Inhalt vervielfältigen, verbreiten und öffentlich zugänglich machen
'
'     * Abwandlungen und Bearbeitungen des Werkes bzw. Inhaltes anfertigen
'
'   Zu Den Folgenden Bedingungen:
'
'     * Namensnennung.
'       Sie müssen den Namen des Autors/Rechteinhabers in der von ihm festgelegten Weise nennen.
'
'     * Keine kommerzielle Nutzung.
'       Dieses Werk darf nicht für kommerzielle Zwecke verwendet werden.
'
'     * Weitergabe unter gleichen Bedingungen.
'       Wenn Sie das lizenzierte Werk bzw. den lizenzierten Inhalt bearbeiten
'       oder in anderer Weise erkennbar als Grundlage für eigenes Schaffen verwenden,
'       dürfen Sie die daraufhin neu entstandenen Werke bzw. Inhalte nur
'       unter Verwendung von Lizenzbedingungen weitergeben, die mit denen
'       dieses Lizenzvertrages identisch oder vergleichbar sind.
'
'   Wobei gilt:
'
'     * Verzichtserklärung
'       Jede der vorgenannten Bedingungen kann aufgehoben werden, sofern Sie
'       die ausdrückliche Einwilligung des Rechteinhabers dazu erhalten.
'
'     * Sonstige Rechte
'       Die Lizenz hat keinerlei Einfluss auf die folgenden Rechte:
'          - Die gesetzlichen Schranken des Urheberrechts und sonstigen
'            Befugnisse zur privaten Nutzung
'          - Das Urheberpersönlichkeitsrecht des Rechteinhabers
'          - Rechte anderer Personen, entweder am Lizenzgegenstand selber oder
'            bezüglich seiner Verwendung, zum Beispiel Persönlichkeitsrechte abgebildeter Personen.
'
'  Hinweis
'
'      Im Falle einer Verbreitung müssen Sie anderen alle Lizenzbedingungen
'      mitteilen, die für dieses Werk gelten. Am einfachsten ist es,
'      einen Link auf http://creativecommons.org/licenses/by-sa/3.0/de/ einzubinden.
'

'*******************************************************************************
$nocompile



Const Udp_port_ntp_dst = 123
Const Udp_port_ntp_src = 1024

'******************************************************************************
' NTP frame
'******************************************************************************
'Dim Ntp_msg(Eth_max_buf) As Xram Byte At Eth_buffer Overlay
#if Use_xram = 1
  Dim Ntp_b_peer_clock_stratum As Xram Byte At Eth_buffer + 1 Overlay
  Dim Ntp_b_peer_polling_interval As Xram Byte At Eth_buffer + 2 Overlay
  Dim Ntp_b_peer_clock_precision As Xram Byte At Eth_buffer + 3 Overlay
  Dim Ntp_l_root_delay As Xram Long At Eth_buffer + 4 Overlay
  Dim Ntp_l_root_dispersion As Xram Long At Eth_buffer + 8 Overlay
  Dim Ntp_b4_ref_clock_id(4) As Xram Byte At Eth_buffer + 12 Overlay
  Dim Ntp_b8_ref_clock_update_time(8) As Xram Byte At Eth_buffer + 16 Overlay
  Dim Ntp_b8_originate_timestamp(8) As Xram Byte At Eth_buffer + 24 Overlay
  Dim Ntp_b8_receive_timestamp(8) As Xram Byte At Eth_buffer + 32 Overlay
  Dim Ntp_b8_transmit_timestamp(8) As Xram Byte At Eth_buffer + 40 Overlay
#else
  Dim Ntp_b_peer_clock_stratum As Byte At Eth_buffer + 1 Overlay
  Dim Ntp_b_peer_polling_interval As Byte At Eth_buffer + 2 Overlay
  Dim Ntp_b_peer_clock_precision As Byte At Eth_buffer + 3 Overlay
  Dim Ntp_l_root_delay As Long At Eth_buffer + 4 Overlay
  Dim Ntp_l_root_dispersion As Long At Eth_buffer + 8 Overlay
  Dim Ntp_b4_ref_clock_id(4) As Byte At Eth_buffer + 12 Overlay
  Dim Ntp_b8_ref_clock_update_time(8) As Byte At Eth_buffer + 16 Overlay
  Dim Ntp_b8_originate_timestamp(8) As Byte At Eth_buffer + 24 Overlay
  Dim Ntp_b8_receive_timestamp(8) As Byte At Eth_buffer + 32 Overlay
  Dim Ntp_b8_transmit_timestamp(8) As  Byte At Eth_buffer + 40 Overlay
#endif

'******************************************************************************
' NTP Constants and variables
'******************************************************************************
Const Ntp_offset_to_bascom = 1139293696
Const Ntp_one_hour_offset = 3600
Const Ntp_flags_leap_indicator = 1
Const Ntp_flags_version = 3
Const Ntp_flags_mode = 3
Const Ntp_flags_server_gw = 42

Dim Ntp_on As Byte
Dim Ntp_stat_on As Byte
Dim Ntp_request_time As Dword
Ntp_request_time = 0


declare Sub Check_time( Byval Socket As Byte , Dns_server As Dword, Byref Buffer() As Byte)
'-------------------------------------------------------------------------------
' Udp_ntp get time from received packet
'-------------------------------------------------------------------------------
Declare Sub Ntp_parse()
'-------------------------------------------------------------------------------
' Ntp_dst_correction correct date
'-------------------------------------------------------------------------------
Declare Sub Ntp_dst_correction
'-------------------------------------------------------------------------------
' Start An Ntp Request
'-------------------------------------------------------------------------------
Declare Sub Ntp_request( Byval Socket As Byte , Dns_server As Dword, Byref Buffer() As Byte)



Goto Ntp_end

'*******************************************************************************
'* NTP Procedures and Functions
'*******************************************************************************

' RFC 1305 NTP

Sub Check_time( Byval Socket As Byte , Dns_server As Dword, Byref Buffer() As Byte)
    If Ntp_request_time <= Local_time Then
       Ntp_request_time = Local_time + 3
       Call Ntp_request(socket , Dns_server , Buffer(1))
    End If
End Sub


'-------------------------------------------------------------------------------
' Udp_ntp get time from received packet
'-------------------------------------------------------------------------------
Sub Ntp_parse()
   Local_time = Ntp_b8_receive_timestamp(1)
   Shift Local_time , Left , 8
   Local_time = Local_time + Ntp_b8_receive_timestamp(2)
   Shift Local_time , Left , 8
   Local_time = Local_time + Ntp_b8_receive_timestamp(3)
   Shift Local_time , Left , 8
   Local_time = Local_time + Ntp_b8_receive_timestamp(4)

   Local_time = Local_time + Ntp_offset_to_bascom
   Local_time = Local_time + Ntp_one_hour_offset                ' offset UTC + 1 hour
   Call Ntp_dst_correction
   'Update Time every hour
   Ntp_request_time = Local_time + 3600
End Sub


'-------------------------------------------------------------------------------
' Ntp_dst_correction correct date
'-------------------------------------------------------------------------------
Sub Ntp_dst_correction
   Local Second As Byte
   Local Minute As Byte
   Local Hour As Byte
   Local Day As Byte
   Local Month As Byte
   Local Year As Byte
   Local Dow As Byte

   Day = Date(local_time)
   Month = 4
   Day = 1
   Hour = 2
   Minute = 0
   Second = 0
   Dow = Dayofweek(day)
   Day = 31 - Dow
   Month = 3
   If Local_time >= Syssec(second) Then
       Day = 1
       Month = 11
       Dow = Dayofweek(day)
       Day = 31 - Dow
       Month = 10
       If Local_time < Syssec(second) Then
          Local_time = Local_time + Ntp_one_hour_offset
       End If
   End If

End Sub

'-------------------------------------------------------------------------------
' Start An Ntp Request
'-------------------------------------------------------------------------------
Sub Ntp_request( Byval Socket As Byte , Dns_server As Dword, Byref Buffer() As Byte)
   Local Xx As Byte
   Local Ntp_timeout As Word
   Local Result As Byte
   Local Rx_size As Word

   For Xx = 1 To 48
     Buffer(xx) = &H00
   Next

'(
      +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
      +    Byte 1     +    Byte 2     +    Byte 3     +    Byte 4     +
      +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
      |               |    1          |        2      |            3  |
       0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
      +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
1     |LI | VN  |Mode |    Stratum    |     Poll      |   Precision   |
      +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
2     |                          Root Delay                           |
      +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
3     |                       Root Dispersion                         |
      +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
4     |                    Reference Identifier                       |
      +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
5     |                    Reference Timestamp (64)                   |
      +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
6     |                    Reference Timestamp                        |
      +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
7     |                    Originate Timestamp (64)                   |
      +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
8     |                    Originate Timestamp                        |
      +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
9     |                     Receive Timestamp  (64)                   |
      +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
10    |                     Receive Timestamp                         |
      +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
11    |                    Transmit Timestamp  (64)                   |
      +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
12    |                    Transmit Timestamp                         |
      +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+

      11011001
      LI        2 bit  01   +1 second (following minute has 61 seconds)
      VN        3 bit  110  Version 3
      mode      3 bit  110  Client 3
')

'NTP Frame
   'LI, VN, MODE
    Buffer(1) = Ntp_flags_mode : Shift Buffer(1) , Left , 3
    Buffer(1) = Buffer(1) Or Ntp_flags_version : Shift Buffer(1) , Left , 3
    Buffer(1) = Buffer(1) Or Ntp_flags_leap_indicator
   'stratum  Buffer(2)
   'poll     Buffer(3)
   'Precision Buffer(4)
    Buffer(4) = &H01

   'Root Delay            Buffer(5) - Buffer(
   'Root Dispersion       Buffer(9) - Buffer(12)
   'Reference Identifier  Buffer(13) - Buffer(16)
   'Reference Timestamp   Buffer(17) - Buffer(24)
   'Originate Timestamp   Buffer(25) - Buffer(32)
   'Receive Timestamp     Buffer(33) - Buffer(40)
   'Transmit Timestamp    Buffer(41) - Buffer(4


      Socket = Getsocket(socket , Sock_dgram , Udp_port_ntp_src , 0)
      If socket = 255 Then
         ' "NTP Socket open failed"
      Else
        Peersize = 48
        Result = Udpwrite(dns_server , Udp_port_ntp_dst , socket , Buffer(1) , Peersize)

        Ntp_timeout = 0
        Do
          Incr Ntp_timeout
          Rx_size = Socketstat(socket , Sel_recv)           ' get number of bytes waiting

          If Rx_size > 0 Then
            Udpreadheader socket
            Result = Udpread(socket , Buffer(1) , Peersize)
            Call Ntp_parse()
            Ntp_timeout = &HFFFF
          End If
          Waitms 1
          Reset Watchdog
        Loop Until Ntp_timeout > 2000
      End If
      Closesocket socket
End Sub


Ntp_end:
 

    Use_xram = 0

   #if Use_xram = 1
     Dim Eth_buffer(300) As xram Byte
   #else
     Dim Eth_buffer(300) As Byte
   #endif

    Dim Eth_mac(6) As Byte
    Dim Eth_ip(4) As Byte
    Dim Eth_mask(4) As Byte
    Dim Eth_gateway(4) As Byte
    Dim Eth_ip_ntp(4) As Byte
    Dim Eth_ip_dhcp(4) As Byte
    Dim Eth_ip_dns(4) As Byte

    Dim Eth_hostname As String * 12
    Eth_hostname = "SIX1"

    Dim Ip_ As long
    Dim Subnetmask_ As Long
    Dim Gateway_ As Long
    Dim Ip_ntp_ As Long
    Dim Ip_dhcp_ As Long
    Dim Ip_dns_ As long
    Dim IP_Dns_server_ As Long

    Ip_ = Maketcp(192 , 168 , 1 , 2)
    Subnetmask_ = Maketcp(255 , 255 , 255 , 0 )
    Gateway_ = Maketcp(192 , 168 , 1 , 254)
    Eth_mac(1) = 0 : Eth_mac(2) = 8 : Eth_mac(3) = &HDC : Eth_mac(4) = &H17 : Eth_mac(5) = &H01 : Eth_mac(6) = &H02
    IP_Dns_server_ = Maketcp(192 , 168 , 1 , 254)
    Ip_ntp_ = Maketcp(64.90.182.55 )

'-------------------------------------------------------------------------------
' DHCP
'-------------------------------------------------------------------------------
   Print #1 , "TEST DHCP"
   Print #1 , "IP now: 192.168.1.5"

   Dim Dhcp_ip As Dword
   Dim Sock_dhcp As Byte

   Dhcp_ip = Maketcp(64.90.182.55 )
   Sock_dhcp = Get_free_socket()

   const Debug_dhcp = 2
   $include "Classes\ETH_DHCP.inc"

   Call Check_dhcp(Sock_dhcp, eth_buffer(1))
 

'*******************************************************************************
'
'  Copyright Michael Koecher aka six1 8/2010
'  basedon Code from Framuel/BascomForum.de
'  -> http://www.six1.net/   michael@koecher-web.de
'
'   http://creativecommons.org/licenses/by-sa/3.0/de/
'
'   Sie dürfen:
'
'     * das Werk bzw. den Inhalt vervielfältigen, verbreiten und öffentlich zugänglich machen
'
'     * Abwandlungen und Bearbeitungen des Werkes bzw. Inhaltes anfertigen
'
'   Zu Den Folgenden Bedingungen:
'
'     * Namensnennung.
'       Sie müssen den Namen des Autors/Rechteinhabers in der von ihm festgelegten Weise nennen.
'
'     * Keine kommerzielle Nutzung.
'       Dieses Werk darf nicht für kommerzielle Zwecke verwendet werden.
'
'     * Weitergabe unter gleichen Bedingungen.
'       Wenn Sie das lizenzierte Werk bzw. den lizenzierten Inhalt bearbeiten
'       oder in anderer Weise erkennbar als Grundlage für eigenes Schaffen verwenden,
'       dürfen Sie die daraufhin neu entstandenen Werke bzw. Inhalte nur
'       unter Verwendung von Lizenzbedingungen weitergeben, die mit denen
'       dieses Lizenzvertrages identisch oder vergleichbar sind.
'
'   Wobei gilt:
'
'     * Verzichtserklärung
'       Jede der vorgenannten Bedingungen kann aufgehoben werden, sofern Sie
'       die ausdrückliche Einwilligung des Rechteinhabers dazu erhalten.
'
'     * Sonstige Rechte
'       Die Lizenz hat keinerlei Einfluss auf die folgenden Rechte:
'          - Die gesetzlichen Schranken des Urheberrechts und sonstigen
'            Befugnisse zur privaten Nutzung
'          - Das Urheberpersönlichkeitsrecht des Rechteinhabers
'          - Rechte anderer Personen, entweder am Lizenzgegenstand selber oder
'            bezüglich seiner Verwendung, zum Beispiel Persönlichkeitsrechte abgebildeter Personen.
'
'  Hinweis
'
'      Im Falle einer Verbreitung müssen Sie anderen alle Lizenzbedingungen
'      mitteilen, die für dieses Werk gelten. Am einfachsten ist es,
'      einen Link auf http://creativecommons.org/licenses/by-sa/3.0/de/ einzubinden.
'

'*******************************************************************************
$nocompile




'*******************************************************************************
'* PUBLIC DECLARATIONS
'*******************************************************************************
  Declare Sub Check_dhcp(byref Socket As Byte , Byref Eth_buffer() As Byte)




Const Udp_port_dhcp_remote = 67                                                 'reversed &H43 (67)
Const Udp_port_dhcp_local = 68                                                  'reversed &H44 (6

'******************************************************************************
' DHCP Constants and variables
'******************************************************************************
Const Dhcp_status_init = 0
Const Dhcp_status_rebinding = 1
Const Dhcp_status_renewing = 2
Const Dhcp_status_bound = 3
Const Dhcp_op_bootrequest = 1
Const Dhcp_op_bootreply = 2
Const Dhcp_cookie = &H63538263                                                  '0x63825363  reversed 99.130.83.99
Const Dhcp_msg_type_dhcpdiscover = 1
Const Dhcp_msg_type_dhcpoffer = 2
Const Dhcp_msg_type_dhcprequest = 3
Const Dhcp_msg_type_dhcpdecline = 4
Const Dhcp_msg_type_dhcpack = 5
Const Dhcp_msg_type_dhcpnak = 6
Const Dhcp_msg_type_dhcprelease = 7
Const Dhcp_msg_type_dhcpinform = 8
Const Dhcp_opt_message_type = 53
Const Dhcp_opt_parameter_request_list = 55
Const Dhcp_opt_requested_ip_address = 50
Const Dhcp_opt_server_identifier = 54
Const Dhcp_opt_client_identifier = 61
Const Dhcp_opt_client_identifier_mac = 1
Const Dhcp_hwtype_eth10mb = 1
Const Dhcp_options_start = 283 - 42
Const Dhcp_flags_broadcast = &H0080                                             'reversed 8000          '
Const Dhcp_flags_no_broadcast = &H0000                                          'reversed 0000

Const Dhcp_opt_subnetmask = 1
Const Dhcp_opt_routersonsubnet = 3
Const Dhcp_opt_ntp_server = 42
Const Dhcp_opt_nameserver = 5
Const Dhcp_opt_dns = 6
Const Dhcp_opt_domainname = 15
Const Dhcp_opt_broadcast_address = 28
Const Dhcp_opt_performrouterdiscovery = 31
Const Dhcp_opt_staticroute = 33
Const Dhcp_opt_hostname = 12
Const Dhcp_opt_leasetime = 51
Const Dhcp_opt_renewal = 58
Const Dhcp_opt_rebinding = 59

Const Dhcp_endoption = &HFF

dim Dhcp_on as byte
Dim Ee_dhcp_on As Eram Byte
Dim Dhcp_transaction_id As Long
Dim Dhcp_status As Byte
Dim Dhcp_secs_elapsed As Word
Dim Dhcp_lease_time As Long
Dim Dhcp_renew_time As Long
Dim Dhcp_rebinding_time As Long
Dim Dhcp_b_recent_server_ip(4) As Byte
Dim Dhcp_request_time As Dword
Dhcp_request_time = 0

'******************************************************************************
' DHCP Frame
'******************************************************************************


#if Use_xram = 1
Dim Dhcp_b_opcode As Xram Byte At Eth_buffer(1) Overlay
Dim Dhcp_b_hwtype As Xram Byte At Eth_buffer(2) Overlay
Dim Dhcp_b_hwlen As Xram Byte At Eth_buffer + 2 Overlay
Dim Dhcp_b_hops As Xram Byte At Eth_buffer + 3 Overlay
Dim Dhcp_l_transaction_id As Xram Long At Eth_buffer + 4 Overlay
Dim Dhcp_w_secs As Xram Word At Eth_buffer + 8 Overlay
Dim Dhcp_w_flags As Xram Word At Eth_buffer + 10 Overlay
Dim Dhcp_b_ciaddr(4) As Xram Byte At Eth_buffer + 12 Overlay
Dim Dhcp_b_yiaddr(4) As Xram Byte At Eth_buffer + 16 Overlay
Dim Dhcp_b_siaddr(4) As Xram Byte At Eth_buffer + 20 Overlay
Dim Dhcp_b_giaddr(4) As Xram Byte At Eth_buffer + 24 Overlay
Dim Dhcp_b_chaddr(16) As Xram Byte At Eth_buffer + 28 Overlay
Dim Dhcp_b_sname(64) As Xram Byte At Eth_buffer + 44 Overlay
Dim Dhcp_b_file(128) As Xram Byte At Eth_buffer + 108 Overlay
Dim Dhcp_l_dhcp_cookie As Xram Long At Eth_buffer + 236 Overlay
Dim Dhcp_b_options_start As Xram Byte At Eth_buffer(dhcp_options_start) Overlay
#else
Dim Dhcp_b_opcode As Byte At Eth_buffer(1) Overlay
Dim Dhcp_b_hwtype As Byte At Eth_buffer(2) Overlay
Dim Dhcp_b_hwlen As Byte At Eth_buffer + 2 Overlay
Dim Dhcp_b_hops As Byte At Eth_buffer + 3 Overlay
Dim Dhcp_l_transaction_id As Long At Eth_buffer + 4 Overlay
Dim Dhcp_w_secs As Word At Eth_buffer + 8 Overlay
Dim Dhcp_w_flags As Word At Eth_buffer + 10 Overlay
Dim Dhcp_b_ciaddr(4) As Byte At Eth_buffer + 12 Overlay
Dim Dhcp_b_yiaddr(4) As Byte At Eth_buffer + 16 Overlay
Dim Dhcp_b_siaddr(4) As Byte At Eth_buffer + 20 Overlay
Dim Dhcp_b_giaddr(4) As Byte At Eth_buffer + 24 Overlay
Dim Dhcp_b_chaddr(16) As Byte At Eth_buffer + 28 Overlay
Dim Dhcp_b_sname(64) As Byte At Eth_buffer + 44 Overlay
Dim Dhcp_b_file(128) As Byte At Eth_buffer + 108 Overlay
Dim Dhcp_l_dhcp_cookie As Long At Eth_buffer + 236 Overlay
Dim Dhcp_b_options_start As  Byte At Eth_buffer(dhcp_options_start) Overlay
#endif

Dim Dhcp_b_offer_ip(4) As Byte
Dim Dhcp_b_dhcp_ip(4) As Byte


Dhcp_on = Ee_dhcp_on




'*******************************************************************************
'* PRIVATE DECLARATIONS
'*******************************************************************************


  Declare Sub Dhcp_initialize(byref Socket As Byte,byref eth_buffer() as byte)
'-------------------------------------------------------------------------------
' Aufruf aus dem Hauptprogramm
'   Der Dhcp Status Wird Auf Init Gestellt Und Ein Dhcp Discover Paket Gesendet.
'-------------------------------------------------------------------------------
  Declare Sub Dhcp_every_minute(byref Socket as byte,byref eth_buffer() as byte)
'-------------------------------------------------------------------------------
' Aufruf aus dem Hauptprogramm
'   Diese Routine Sollte Aus Dem Hauptprogramm Heraus Etwa 1 X Pro Minute Aufgerufen Werden.
'   Es Werden Die Timer Für Rebind , Renew Und Lease Heruntergezählt,
'   Bei Erreichen Der Null Erfolgt Eine Entsprechende Änderung Des Dhcp Status.
'   Anschließend Wird Je Nach Dann Gültigen Status Eine Entsprechede Aktion Ausgelöst:
'   Status Bound - > Keine Aktion
'   Status Init - > Dhcp Discover
'   Status Renew Oder Rebind - > Dhcp Request
'-------------------------------------------------------------------------------
  Declare Sub Dhcp_create_new_xid
'-------------------------------------------------------------------------------
'   Es Wird Ein Dhcp Discover Paket Aufgebaut Und Verschickt.
'-------------------------------------------------------------------------------
  Declare Sub Dhcp_packet_filter(byref Socket As Byte,byref eth_buffer() as byte)
'-------------------------------------------------------------------------------
' Aufruf aus: Udp_packet_filter
'   Das Empfangene Paket Wird Geprüft:
'   Wenn Es Nicht An Die Eigene Ip Adresse Ging , Wird Es Abgewiesen
'   Wenn Es Nicht Von Unserem Dns -server Kam , Wird Es Abgewiesen
'   Ansonsten Wird Dns_reply_received Aufgerufen
'-------------------------------------------------------------------------------
  Declare Function Dhcp_find_option(byval Opt As Byte) As Word
'-------------------------------------------------------------------------------
' Aufruf z.B. aus: Udp_packet_filter
'   Diese Funktion Durchsucht Den Gesamten Optionen -bereich Nach Einer Bestimmten Option
'   (s.a. Dhcp_parse_options)
'-------------------------------------------------------------------------------
  Declare Sub Dhcp_send_discover(byref Socket As Byte , Byref Eth_buffer() As Byte)
'-------------------------------------------------------------------------------
'   Es Wird Ein Dhcp Discover Paket Aufgebaut Und Verschickt.
'-------------------------------------------------------------------------------
  Declare Sub Dhcp_send_request(byref Socket As Byte , Byref Eth_buffer() As Byte)
'-------------------------------------------------------------------------------
'   Es Wird Ein Dhcp Request Paket Aufgebaut Und Verschickt.
'   Im Dhcp Status Renew Wird Das Paket Direkt An Den Letzten Dhcp Server Geschickt,
'   Im Dhcp Status Rebind Wird Das Paket Per Broadcast Gesendet.
'-------------------------------------------------------------------------------
  Declare Sub Dhcp_received_ack(byref Socket As Byte , Byref Eth_buffer() As Byte)
'-------------------------------------------------------------------------------
'   Wenn Der Dhcp Request Vom Server Bestätigt Wird , Wird Der Dhcp Status Auf Bound Gesetzt.
'   Die Empfangenen Parameter Werden über Die Options Ausgelesen Und Die Einsprechenden Werte Gesetzt.
'-------------------------------------------------------------------------------
  Declare Sub Dhcp_parse_options(byref eth_buffer() as byte)
' Aufruf aus: Dhcp_received_ack
'   Die Meisten Der Für Dhcp Wichtigen Informationen Finden Sich Nicht An Festen Stellen Im Frame
'   (der Eigentlich Ein Bootp Frame Ist) , Sondern In Dem Eigentlich Für Option Vorgesehenen Bereich.
'   Eine Option Beginnt Immer Mit Einem Kennungs -byte , Gefolgt Von 2 Längenbytes , Dann Erst Die Eigentlichen Daten.
'   Diese Funktion Durchläuft Den Gesamten Optionen -bereich Und Wertet Die Jeweiligen Daten Aus.
'-------------------------------------------------------------------------------
  Declare Sub Dhcp_received_nak
'-------------------------------------------------------------------------------
'   Wenn Der Dhcp Request Vom Server Abgelehnt Wird , Wird Der Dhcp Status Auf Init Zurückgesetzt.
'-------------------------------------------------------------------------------


goto DHCP_END



'*******************************************************************************
'* DHCP Procedures and Functions
'*******************************************************************************


Sub Check_dhcp(byref Socket As Byte , Byref Eth_buffer() As Byte)
  If Dhcp_on > 0 Then
     If Dhcp_request_time <= local_time Then
         Dhcp_request_time = Local_time + 5
         Call Dhcp_every_minute(Socket, eth_buffer(1))
     End If
  End If
End Sub

'-------------------------------------------------------------------------------
'  DHCP-packet filter
'-------------------------------------------------------------------------------
Sub Dhcp_packet_filter(byref Socket As Byte , Byref Eth_buffer() As Byte)
Local Lw As Word
   If Dhcp_status = Dhcp_status_bound Then
      Exit Sub                                              'Don't accept packets anymore
   End If
   If Dhcp_b_opcode = Dhcp_op_bootreply Then
     If Dhcp_l_transaction_id = Dhcp_transaction_id Then
        Lw = Dhcp_find_option(53)
        If Lw = 0 Then Exit Sub
        Select Case Eth_buffer(lw + 2)
           Case Dhcp_msg_type_dhcpoffer
              Call Dhcp_send_request(socket , Eth_buffer(1))
           Case Dhcp_msg_type_dhcpack
              Call Dhcp_received_ack(socket , Eth_buffer(1))
           Case Dhcp_msg_type_dhcpnak
              Call Dhcp_received_nak
           Case Else
              #if Debug_dhcp > 0
                  Print #1 , "DHCP other packet received from IP "
              #endif
        End Select
     End If
  End If
End Sub

'-------------------------------------------------------------------------------
'  DHCP Initialization
'-------------------------------------------------------------------------------
Sub Dhcp_initialize(byref Socket As Byte , Byref Eth_buffer() As Byte)
   Dhcp_status = Dhcp_status_init
   #if Debug_dhcp > 1
      Print #1 , "DHCP Status set to INIT"
   #endif
   Call Dhcp_send_discover(Socket, eth_buffer(1))
End Sub

'-------------------------------------------------------------------------------
'  DHCP Every Minute
'-------------------------------------------------------------------------------
Sub Dhcp_every_minute(byref Socket As Byte , Byref Eth_buffer() As Byte)
   Select Case Dhcp_renew_time                                                  'T1
'      Case &HFFFFFFFF                                                           'infinite
      Case Is > 0:
         Dhcp_renew_time = Dhcp_renew_time - 60                                 '-60 secs
         If Dhcp_renew_time <= 0 Then
            Dhcp_status = Dhcp_status_renewing
            #if Debug_dhcp > 1
                Print #1 , "  DHCP Status changed to RENEWING"
            #endif
         End If
'      Case Else
   End Select
   Select Case Dhcp_rebinding_time                                              'T2
'      Case &HFFFFFFFF                                                           'infinite
      Case Is > 0:
         Dhcp_rebinding_time = Dhcp_rebinding_time - 60                         '-60 sec
         If Dhcp_rebinding_time <= 0 Then
            Dhcp_status = Dhcp_status_rebinding
            #if Debug_dhcp > 1
                Print #1 , "  DHCP Status changed to REBINDING"
            #endif
         End If
'      Case Else
   End Select
   Select Case Dhcp_lease_time
'      Case &HFFFFFFFF                                                           'infinite
      Case Is > 0:
         Dhcp_lease_time = Dhcp_lease_time - 60             '-60 sec
         If Dhcp_lease_time <= 0 Then
 '           Call Eth_hardware_init()                                                       'reset to static network
            Dhcp_status = Dhcp_status_init
            #if Debug_dhcp > 1
                Print #1 , "  DHCP Status changed to INIT"
            #endif
         End If
'      Case Else
   End Select
   Dhcp_secs_elapsed = Dhcp_secs_elapsed + 60

   #if Debug_dhcp > 1
      Print
      Select Case Dhcp_status
         Case Dhcp_status_init
             Print #1 , "DHCP Status = INIT"
         Case Dhcp_status_renewing
             Print #1 , "DHCP Status = RENEWING"
         Case Dhcp_status_rebinding
             Print #1 , "DHCP Status = REBINDING"
         Case Dhcp_status_bound
             Print #1 , "DHCP Status = BOUND"
      End Select
       Print #1 , " Renew  Tmr = " ; Dhcp_renew_time
       Print #1 , " Rebind Tmr = " ; Dhcp_rebinding_time
       Print #1 , " Lease  Tmr = " ; Dhcp_lease_time
       Print #1 , "SecsElapsed = " ; Dhcp_secs_elapsed
   #endif

   Select Case Dhcp_status
      Case Dhcp_status_bound
         Dhcp_request_time = local_time + 60
         Exit Sub
      Case Dhcp_status_init
         Call Dhcp_send_discover(socket , Eth_buffer(1))
         Dhcp_request_time = Local_time + 5
      Case Else
         Call Dhcp_send_request(socket , Eth_buffer(1))
         Dhcp_request_time = Local_time + 5
   End Select
End Sub

'-------------------------------------------------------------------------------
'  DHCP send Discover
'-------------------------------------------------------------------------------
Sub Dhcp_send_discover(byref Socket As Byte , Byref Eth_buffer() As Byte)
   Local Lw As Word , L1 As Word , L2 As Word , B_b As Byte
   Local Ls As String * 1
   Local Li As Integer
   Local I As Integer , Row As String * 55 , Rownr As Word
   Local Dhcp_timeout As Word
   Local Dest_ip As Long , Result As Byte , Rx_size As Word

   Dhcp_b_opcode = Dhcp_op_bootrequest
   Dhcp_b_hwtype = Dhcp_hwtype_eth10mb
   Dhcp_b_hwlen = 6
   Dhcp_b_hops = 0

  Call Dhcp_create_new_xid()

   Dhcp_l_transaction_id = Dhcp_transaction_id
   Dhcp_w_flags = Dhcp_flags_broadcast

'###############################################################################
   Dhcp_b_ciaddr(1) = 0                                                         'Set all addresses to zero
   Dhcp_b_ciaddr(2) = 0
   Dhcp_b_ciaddr(3) = 0
   Dhcp_b_ciaddr(4) = 0

   Dhcp_b_yiaddr(1) = 0
   Dhcp_b_yiaddr(2) = 0
   Dhcp_b_yiaddr(3) = 0
   Dhcp_b_yiaddr(4) = 0

   Dhcp_b_siaddr(1) = 0
   Dhcp_b_siaddr(2) = 0
   Dhcp_b_siaddr(3) = 0
   Dhcp_b_siaddr(4) = 0

   Dhcp_b_offer_ip(1) = Dhcp_b_yiaddr(1)
   Dhcp_b_offer_ip(2) = Dhcp_b_yiaddr(2)
   Dhcp_b_offer_ip(3) = Dhcp_b_yiaddr(3)
   Dhcp_b_offer_ip(4) = Dhcp_b_yiaddr(4)

   Dhcp_b_dhcp_ip(1) = Dhcp_b_siaddr(1)
   Dhcp_b_dhcp_ip(2) = Dhcp_b_siaddr(2)
   Dhcp_b_dhcp_ip(3) = Dhcp_b_siaddr(3)
   Dhcp_b_dhcp_ip(4) = Dhcp_b_siaddr(4)

   For I = 1 To 4
     Dhcp_b_giaddr(i) = 0
   Next
   For I = 1 To 16
     Dhcp_b_chaddr(i) = 0
   Next
   For I = 1 To 64
     Dhcp_b_sname(i) = 0
   Next
   For I = 1 To 128
     Dhcp_b_file(i) = 0
   Next

'###############################################################################

   Dhcp_b_chaddr(1) = Eth_mac(1)
   Dhcp_b_chaddr(2) = Eth_mac(2)
   Dhcp_b_chaddr(3) = Eth_mac(3)
   Dhcp_b_chaddr(4) = Eth_mac(4)
   Dhcp_b_chaddr(5) = Eth_mac(5)
   Dhcp_b_chaddr(6) = Eth_mac(6)
   Dhcp_l_dhcp_cookie = Dhcp_cookie

'###############################################################################
'W5200 creates Header Ethernet-, IP-, UDP- and Parts of the BootStrap-Protokoll (0x0000-0119 / #000-281)
'incl. the Magic Cookie

'Start building the BootStrap-Option of the DHCP-Frame                          (0x011A-024D / #282-590)
   Lw = Dhcp_options_start                                                      'Start ByteCounting (0x011A      / #282

'1´st Option - DISCOVER-Request
   Eth_buffer(lw) = Dhcp_opt_message_type                                         'Option  53
   Incr Lw : Eth_buffer(lw) = 1                                                   'Length
   Incr Lw : Eth_buffer(lw) = Dhcp_msg_type_dhcpdiscover                          'Dhcp_request

'2´nd Option - Client Identifier
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_client_identifier                          'Option 61
   Incr Lw : Eth_buffer(lw) = 7                                                   'Length
   Incr Lw : Eth_buffer(lw) = 1                                                   'HardwareType
   Incr Lw : Eth_buffer(lw) = Eth_mac(1)
   Incr Lw : Eth_buffer(lw) = Eth_mac(2)
   Incr Lw : Eth_buffer(lw) = Eth_mac(3)
   Incr Lw : Eth_buffer(lw) = Eth_mac(4)
   Incr Lw : Eth_buffer(lw) = Eth_mac(5)
   Incr Lw : Eth_buffer(lw) = Eth_mac(6)

'3´rd Option - Host Name
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_hostname                                   'Option 12
   Incr Lw : Eth_buffer(lw) = Len(eth_hostname)             'Length
   For Li = 1 To Len(eth_hostname)                          'Hostname
      Ls = Mid(eth_hostname , Li , 1)
      Incr Lw : Eth_buffer(lw) = Asc(ls)
   Next Li

'4´th Option - Parameter Request List
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_parameter_request_list                     'Option 55
   Incr Lw : Eth_buffer(lw) = 7                                                   'Size of Options
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_subnetmask
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_routersonsubnet
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_dns
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_domainname
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_renewal
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_rebinding
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_ntp_server

'DHCP Options END'
   Incr Lw : Eth_buffer(lw) = &HFF                                                'end

'Padding up to 548 Bytes BootStartSize
   Incr Lw
   For I = Lw To 547                                                            '590-43
     Incr Lw : Eth_buffer(lw) = 0
   Next


'###############################################################################
#if Debug_dhcp > 2

  Print #1 , "DHCP - Send DISCOVER (Bootstrap Protocol)"
  Print #1 , "DHCP - Bootstrap Size = " ; Lw
  Print #1 , "_____________________________________________________"
  Print #1 , "0x   00 01 02 03 04 05 06 07  08 09 0A 0B 0C 0D 0E 0F"
  Print #1 , "====================================================="
  Row = "0020 -- -- -- -- -- -- -- --  -- --"
  Rownr = 32
  For I = 1 To Lw
    Row = Row + " " + + Hex(Eth_buffer(i))
    If Len(row) = 28 Then
      Row = Row + " "
    End If
    If Len(row) >= 52 Then
      Print #1 , Row
      Rownr = Rownr + 16
      Row = Hex(rownr)
    End If
  Next
  Print #1 , Row                                                                'the rest

  Print #1 , "_____________________________________________________"

#endif
'###############################################################################



      Dest_ip = Maketcp(255.255.255.255)                                     ' Broadcast

      Socket = Getsocket(socket , Sock_dgram , Udp_port_dhcp_local , 0)       ' get socket for client mode, specify port 0 so loal_port is used
      If Socket = 255 Then
          Print #1 , "DHCP Socket open failed"
      Else
        Peersize = Lw
        Result = Udpwrite(dest_ip , Udp_port_dhcp_remote , Socket , Eth_buffer(1) , Peersize)


        Dhcp_timeout = 0
        Do
          Incr Dhcp_timeout
          Rx_size = Socketstat(socket , Sel_recv)           ' get number of bytes waiting

          If Rx_size > 0 Then
            Udpreadheader Socket
            Result = Udpread(socket , Eth_buffer(1) , Peersize)
            Closesocket Socket
            Call Dhcp_packet_filter(Socket, eth_buffer(1))
            Dhcp_timeout = &HFFFF
          End If
          Waitms 1
          Reset Watchdog
        Loop Until Dhcp_timeout > 2500
        If Dhcp_timeout < &HFFFF Then
          '  Print #1 , "Timeout DHCP"
        End If
      End If
      Closesocket Socket

End Sub




'-------------------------------------------------------------------------------
'  DHCP send Request
'-------------------------------------------------------------------------------
Sub Dhcp_send_request(byref Socket As Byte , Byref Eth_buffer() As Byte)
   Local Lw As Word , L1 As Word , L2 As Word, b_b as byte
   Local Li As Integer
   Local Ls As String * 1
   Local I As Integer
   Local Opt_pos As Word
   Local Dest_ip As Long , Result As Byte , Rx_size As Word , Dhcp_timeout As Word

   Dhcp_b_offer_ip(1) = Dhcp_b_yiaddr(1)
   Dhcp_b_offer_ip(2) = Dhcp_b_yiaddr(2)
   Dhcp_b_offer_ip(3) = Dhcp_b_yiaddr(3)
   Dhcp_b_offer_ip(4) = Dhcp_b_yiaddr(4)

   If Dhcp_b_siaddr(1) > 0 Then
      Dhcp_b_dhcp_ip(1) = Dhcp_b_siaddr(1)
      Dhcp_b_dhcp_ip(2) = Dhcp_b_siaddr(2)
      Dhcp_b_dhcp_ip(3) = Dhcp_b_siaddr(3)
      Dhcp_b_dhcp_ip(4) = Dhcp_b_siaddr(4)
   Else
      Opt_pos = Dhcp_find_option(dhcp_opt_server_identifier)
      If Opt_pos > 0 Then
        Dhcp_b_dhcp_ip(1) = Eth_buffer(opt_pos + 2)
        Dhcp_b_dhcp_ip(2) = Eth_buffer(opt_pos + 3)
        Dhcp_b_dhcp_ip(3) = Eth_buffer(opt_pos + 4)
        Dhcp_b_dhcp_ip(4) = Eth_buffer(opt_pos + 5)
      Else
        ' didn't know, where to get adress from....
      End If
   End If

'###############################################################################
   Dhcp_b_yiaddr(1) = 0                                                         ' Set your Client IP to zero again
   Dhcp_b_yiaddr(2) = 0
   Dhcp_b_yiaddr(3) = 0
   Dhcp_b_yiaddr(4) = 0

   Dhcp_b_siaddr(1) = 0                                                         ' Set next server IP to zero again
   Dhcp_b_siaddr(2) = 0
   Dhcp_b_siaddr(3) = 0
   Dhcp_b_siaddr(4) = 0
'###############################################################################


   Dhcp_b_opcode = Dhcp_op_bootrequest
   Dhcp_b_hwtype = Dhcp_hwtype_eth10mb
   Dhcp_b_hwlen = 6
   Dhcp_b_hops = 0
   Dhcp_l_transaction_id = Dhcp_transaction_id

   If Dhcp_status < Dhcp_status_renewing Then
      Dhcp_w_flags = Dhcp_flags_broadcast
   Else
      Dhcp_w_flags = 0
      Dhcp_b_ciaddr(1) = Eth_ip(1)
      Dhcp_b_ciaddr(2) = Eth_ip(2)
      Dhcp_b_ciaddr(3) = Eth_ip(3)
      Dhcp_b_ciaddr(4) = Eth_ip(4)
   End If

   Dhcp_b_chaddr(1) = Eth_mac(1)
   Dhcp_b_chaddr(2) = Eth_mac(2)
   Dhcp_b_chaddr(3) = Eth_mac(3)
   Dhcp_b_chaddr(4) = Eth_mac(4)
   Dhcp_b_chaddr(5) = Eth_mac(5)
   Dhcp_b_chaddr(6) = Eth_mac(6)

   Dhcp_l_dhcp_cookie = Dhcp_cookie

'Options Request Parameter
   Lw = Dhcp_options_start
   Eth_buffer(lw) = Dhcp_opt_message_type                                         'option  53
   Incr Lw : Eth_buffer(lw) = &H01                                                'Length
   Incr Lw : Eth_buffer(lw) = Dhcp_msg_type_dhcprequest                           'Dhcp_request

   Incr Lw : Eth_buffer(lw) = Dhcp_opt_client_identifier

   Incr Lw : Eth_buffer(lw) = &H07                                                'Length
   Incr Lw : Eth_buffer(lw) = &H01                                                'Hardwaretyp = Ethernet

   Incr Lw : Eth_buffer(lw) = Eth_mac(1)
   Incr Lw : Eth_buffer(lw) = ETH_mac(2)
   Incr Lw : Eth_buffer(lw) = ETH_mac(3)
   Incr Lw : Eth_buffer(lw) = ETH_mac(4)
   Incr Lw : Eth_buffer(lw) = ETH_mac(5)
   Incr Lw : Eth_buffer(lw) = ETH_mac(6)

   If Dhcp_status = Dhcp_status_init Then
       Incr Lw : Eth_buffer(lw) = Dhcp_opt_requested_ip_address                   'offered IP, don´t use it until ACK is received
       Incr Lw : Eth_buffer(lw) = &H04
       Incr Lw : Eth_buffer(lw) = Dhcp_b_offer_ip(1)
       Incr Lw : Eth_buffer(lw) = Dhcp_b_offer_ip(2)
       Incr Lw : Eth_buffer(lw) = Dhcp_b_offer_ip(3)
       Incr Lw : Eth_buffer(lw) = Dhcp_b_offer_ip(4)

       Incr Lw : Eth_buffer(lw) = Dhcp_opt_server_identifier
       Incr Lw : Eth_buffer(lw) = &H04
       Incr Lw : Eth_buffer(lw) = Dhcp_b_dhcp_ip(1)
       Incr Lw : Eth_buffer(lw) = Dhcp_b_dhcp_ip(2)
       Incr Lw : Eth_buffer(lw) = Dhcp_b_dhcp_ip(3)
       Incr Lw : Eth_buffer(lw) = Dhcp_b_dhcp_ip(4)
   Else
       Incr Lw : Eth_buffer(lw) = Dhcp_opt_requested_ip_address
       Incr Lw : Eth_buffer(lw) = &H04
       Incr Lw : Eth_buffer(lw) = ETH_ip(1)
       Incr Lw : Eth_buffer(lw) = ETH_ip(2)
       Incr Lw : Eth_buffer(lw) = ETH_ip(3)
       Incr Lw : Eth_buffer(lw) = ETH_ip(4)
   End If

'Hostame
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_hostname                                   'set Hostname
   L2 = Len(eth_hostname)
   Incr Lw : Eth_buffer(lw) = L2                                                  'length of Option
   For Li = 1 To L2
      Ls = Mid(ETH_hostname , Li , 1)
      Incr Lw : Eth_buffer(lw) = Asc(ls)
   Next Li

'Options
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_parameter_request_list                     'request for...
   Incr Lw : L2 = Lw
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_subnetmask             'subnetmask
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_routersonsubnet
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_dns                                        'dns
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_hostname                                   'hostname
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_nameserver                                 'dns
   Incr Lw : Eth_buffer(lw) = Dhcp_opt_ntp_server                                 'ntp server
   L1 = Lw - L2 : Eth_buffer(l2) = L1                                             'Size of Options

   Dhcp_l_transaction_id = Dhcp_transaction_id
   Incr Lw : Eth_buffer(lw) = Dhcp_endoption

'fill up to 548 Bytes BootStarpSize
'   For I = Lw To 548
'     Incr Lw : Eth_buffer(lw) = 0
'   Next

      Dest_ip = Maketcp(255.255.255.255)                                     ' Broadcast


      Socket = Getsocket(socket , Sock_dgram , Udp_port_dhcp_local , 0)       ' get socket for client mode, specify port 0 so loal_port is used
      If Socket = 255 Then
          Print #1 , "DHCP Socket open failed"
      Else
        Peersize = Lw
        Result = Udpwrite(dest_ip , Udp_port_dhcp_remote , Socket , Eth_buffer(1) , Peersize)


        Dhcp_timeout = 0
        Do
          Incr Dhcp_timeout
          Rx_size = Socketstat(socket , Sel_recv)           ' get number of bytes waiting

          If Rx_size > 0 Then
            Udpreadheader Socket
            Result = Udpread(socket , Eth_buffer(1) , Peersize)
            Closesocket Socket
            Call Dhcp_packet_filter(Socket, eth_buffer(1))
            Dhcp_timeout = &HFFFF
          End If
          Waitms 1
          Reset Watchdog
        Loop Until Dhcp_timeout > 2500
        If Dhcp_timeout < &HFFFF Then
           ' Print #1 , "Timeout DHCP"
        End If
      End If
     Closesocket Socket
End Sub


'-------------------------------------------------------------------------------
'  DHCP Acknowledgement received
'-------------------------------------------------------------------------------
Sub Dhcp_received_ack(byref Socket As Byte , Byref Eth_buffer() As Byte)
   #if Debug_dhcp > 0
       Print #1 , "DHCP Ack received from IP "
   #endif


   Call Dhcp_parse_options(eth_buffer(1))
   'set new network params
   'Call Wiz_network_param
   Dhcp_status = Dhcp_status_bound
   Closesocket Socket
   'reset already used transaction id
   Dhcp_transaction_id = 0

   #if Debug_dhcp > 1
       Print #1 , "DHCP Status changed to BOUND"
   #endif


   #if Debug_dhcp = 1
       Print #1 , "DHCP:"
       Print #1 , " IP    " ; Ip2str(ip_)
       Print #1 , " MASK  " ; Ip2str(submask_)
       Print #1 , " GW    " ; Ip2str(gateway_)
       Print #1 , " DNS   " ; Ip2str(eth_dns_)
   #endif
End Sub

'-------------------------------------------------------------------------------
'  DHCP Negative Acknowledgement received
'-------------------------------------------------------------------------------
Sub Dhcp_received_nak
   #if Debug_dhcp > 0
       Print #1 , "DHCP Nak received from IP "
       Print #1 , "DHCP Status set to INIT"
   #endif
   Dhcp_status = Dhcp_status_init
End Sub

'-------------------------------------------------------------------------------
'  DHCP find option
'-------------------------------------------------------------------------------
Function Dhcp_find_option(byval Opt As Byte) As Word
Local Lw As Word
Local Lx As Word
   Lw = Dhcp_options_start
   Do
      Select Case Eth_buffer(lw)
         Case 0                                                                 'Padding
            Incr Lw
         Case Opt
            Dhcp_find_option = Lw
            Exit Sub
         Case &HFF                                                              'End of Options
            Dhcp_find_option = 0
            Exit Sub
         Case Else
            Lx = Eth_buffer(lw + 1)
            Lw = Lw + 2
            Lw = Lw + Lx
      End Select
   Loop
End Function




'-------------------------------------------------------------------------------
'  DHCP parse options
'-------------------------------------------------------------------------------
Sub Dhcp_parse_options(byref eth_buffer() as byte)
    Local Lw As Word
    Local Llen As Word
    Local Lo As Byte
    Local Ntp_temp As Byte


   'received ip lease --> my IP
   'Set Ip adress
   Ip_ = Maketcp(dhcp_b_yiaddr(1) , Dhcp_b_yiaddr(2) , Dhcp_b_yiaddr(3) , Dhcp_b_yiaddr(4))
   Settcp Eth_mac(1).eth_mac(2).eth_mac(3).eth_mac(4).eth_mac(5).eth_mac(6) , _
           Ip_ , _
           Subnetmask_ , _
           Gateway_



   Lw = Dhcp_options_start
   'reset NTP. If DHCP is transmiting a NTP Server, it will be set again
   Ntp_temp = 0
   Do
      Llen = Eth_buffer(lw + 1)
      Lo = Eth_buffer(lw)
      Select Case Eth_buffer(lw)
         Case 0                                                                 'Padding
            Incr Lw
         Case Dhcp_opt_subnetmask                                               'Subnet Mask
            If Llen = 4 Then
               'Set Mask
               Eth_mask(1) = Eth_buffer(lw + 2)
               Eth_mask(2) = Eth_buffer(lw + 3)
               Eth_mask(3) = Eth_buffer(lw + 4)
               Eth_mask(4) = Eth_buffer(lw + 5)
               Subnetmask_ = Maketcp(eth_mask(1) , Eth_mask(2) , Eth_mask(3) , Eth_mask(4) )
               Settcp Eth_mac(1).eth_mac(2).eth_mac(3).eth_mac(4).eth_mac(5).eth_mac(6) , _
                      Ip_ , _
                      Subnetmask_ , _
                      Gateway_
            End If
            #if Debug_dhcp > 1
                Print #1 , "DHCP-Ack: Default Mask now: " ; Eth_mask(1) ; "." ; Eth_mask(2) ; "." ; Eth_mask(3) ; "." ; Eth_mask(4)
            #endif
         Case Dhcp_opt_routersonsubnet                                          'Routers
            If Llen >= 4 Then
               'Set gateway adress
               Eth_gateway(1) = Eth_buffer(lw + 2)
               Eth_gateway(2) = Eth_buffer(lw + 3)
               Eth_gateway(3) = Eth_buffer(lw + 4)
               Eth_gateway(4) = Eth_buffer(lw + 5)
               Gateway_ = Maketcp(eth_gateway(1) , Eth_gateway(2) , Eth_gateway(3) , Eth_gateway(4) )
               Settcp Eth_mac(1).eth_mac(2).eth_mac(3).eth_mac(4).eth_mac(5).eth_mac(6) , _
                      Ip_ , _
                      Subnetmask_ , _
                      Gateway_
               #if Debug_dhcp > 1
                  Print #1 , "DHCP-Ack: Default GW now: " ; Eth_gateway(1) ; "." ; Eth_gateway(2) ; "." ; Eth_gateway(3) ; "." ; Eth_gateway(4)
               #endif
            End If
         Case Dhcp_opt_ntp_server                           'Time Servers
            If Llen >= 4 Then
               Ntp_temp = 1
               Eth_ip_ntp(1) = Eth_buffer(lw + 2)
               Eth_ip_ntp(2) = Eth_buffer(lw + 3)
               Eth_ip_ntp(3) = Eth_buffer(lw + 4)
               Eth_ip_ntp(4) = Eth_buffer(lw + 5)
               Ip_ntp_ = Maketcp(eth_ip_ntp(1) , Eth_ip_ntp(2) , Eth_ip_ntp(3) , Eth_ip_ntp(4) )
               #if Debug_dhcp > 1
                  Print #1 , "DHCP-Ack: NTP server now: " ; Eth_ip_ntp(1) ; "." ; Eth_ip_ntp(2) ; "." ; Eth_ip_ntp(3) ; "." ; Eth_ip_ntp(4)
               #endif
            End If
         Case Dhcp_opt_dns
            If Llen >= 4 Then
                 Eth_ip_dns(1) = Eth_buffer(lw + 2)
                 Eth_ip_dns(2) = Eth_buffer(lw + 3)
                 Eth_ip_dns(3) = Eth_buffer(lw + 4)
                 Eth_ip_dns(4) = Eth_buffer(lw + 5)
                 Ip_dns_server_ = Maketcp(eth_ip_dns(1) , Eth_ip_dns(2) , Eth_ip_dns(3) , Eth_ip_dns(4) )
                 #if Debug_dhcp > 1
                    Print #1 , "DHCP-Ack: DNS server now: " ; Eth_ip_dns(1) ; "." ; Eth_ip_dns(2) ; "." ; Eth_ip_dns(3) ; "." ; Eth_ip_dns(4)
                 #endif
            End If
         Case Dhcp_opt_leasetime                            'IP Address Lease Time
            If Llen = 4 Then
               Dhcp_lease_time = Maketcp(eth_buffer(lw + 5) , Eth_buffer(lw + 4) , Eth_buffer(lw + 3) , Eth_buffer(lw + 2))
            End If
         Case Dhcp_opt_server_identifier                                        'DHCP Server Identification
            If Llen = 4 Then
               Dhcp_b_recent_server_ip(1) = Eth_buffer(lw + 2)
               Dhcp_b_recent_server_ip(2) = Eth_buffer(lw + 3)
               Dhcp_b_recent_server_ip(3) = Eth_buffer(lw + 4)
               Dhcp_b_recent_server_ip(4) = Eth_buffer(lw + 5)
               #if Debug_dhcp > 1
                  Print #1 , "DHCP-Ack: DHCP Server now: " ; Dhcp_b_recent_server_ip(1) ; "." ; Dhcp_b_recent_server_ip(2) ; "." ; Dhcp_b_recent_server_ip(3) ; "." ; Dhcp_b_recent_server_ip(4)
               #endif
            End If
         Case Dhcp_opt_renewal                                                  'Renewal (T1) Time Value
            If Llen = 4 Then
               Dhcp_renew_time = Maketcp(eth_buffer(lw + 2) , Eth_buffer(lw + 3) , Eth_buffer(lw + 4) , Eth_buffer(lw + 5))
            End If
         Case Dhcp_opt_rebinding                                                'Rebinding (T2) Time Value
            If Llen = 4 Then
               Dhcp_rebinding_time = Maketcp(eth_buffer(lw + 2) , Eth_buffer(lw + 3) , Eth_buffer(lw + 4) , Eth_buffer(lw + 5))
            End If
         Case &HFF                                                              'End of Options
            Exit Sub
         Case Else
               #if Debug_dhcp > 1
                  Print #1 , "DHCP-Ack: DHCP Opt: $" ; Hex(Eth_buffer(lw))
               #endif
      End Select
      If Eth_buffer(lw) > 0 Then
         Lw = Lw + 2
         Lw = Lw + Llen
      End If
   Loop


End Sub

'-------------------------------------------------------------------------------
'  DHCP create new transaction ID
'-------------------------------------------------------------------------------
Sub Dhcp_create_new_xid
Local Lw As Word
   Dhcp_transaction_id = Rnd(&Hffff)
   Shift Dhcp_transaction_id , Left , 16
   Lw = Rnd(&Hffff)
   Dhcp_transaction_id = Dhcp_transaction_id + Lw
End Sub

Dhcp_end:
 

   #if Use_xram = 1
     Dim Eth_buffer(1500) As Xram Byte
   #else
     Dim Eth_buffer(1500) As Byte
   #endif



'-------------------------------------------------------------------------------
' MYSQL
' uses DNS Lookup! so define a DNS Server!
'-------------------------------------------------------------------------------
   Print #1 , "TEST MYSQL"

   Const Mysql_debug = 1
   $include "Classes\ETH_MYSQL.inc"


' Please have a look at "Mysql_process_data" in ETH_MYSQL.INC File!
' there you can take action on received result sets!
   '-------------------------------------------------------------------------------
   ' MYSQL DATABASE SETUP
   '-------------------------------------------------------------------------------
   Mysql_server_dst_port = 3306
   ' URL OR IP
'   Mysql_url = "six1.webhop.net"
   Mysql_url = "192.168.1.50"
   Mysql_username = "wiz200"
   Mysql_password = "wiz200"


  'connect mysql. for connection details have a look atETH_MYSQL.inc
  Call Mysql_connect(Mysql_url , Eth_buffer(1))
  'change Database
  Call Mysql_sql_query(com_init_db , "webserver" , Eth_buffer(1))
  'Select Data
  ' for Result Output have a look at ETH_MYSQL.INC / Mysql_process_data
  Call Mysql_sql_query(com_query , "Select * from temperatur order by lfdnr limit 20" , eth_buffer(1))
  Print #1 , " "
  Call Mysql_close()