View previous topic :: View next topic |
Author |
Message |
six1
Joined: 27 Feb 2009 Posts: 553
|
Posted: Tue Dec 04, 2012 11:41 am Post subject: WIZNET Ethernet Functions |
|
|
Hi,
i will start publishing ETH Protocols for use with Bascom WIZ functions.
During time i've implementet a few protocols for my projects and will change them to work with Mark's WIZ functions.
This is Code out from Projects, so you may have to define one ore more Variables!
I've tried to make it easy, but these things aren't easy...
At all these Protocols are not that easy in Details! So you have to spend a "little" time.
If there are Questions ore somethings missing, feel free to ask.
best, michael
DNS
look up an IP from given URL
Code: |
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
|
save this as ETH_DNS.INC File
Code: |
'*******************************************************************************
'
' 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 :
|
have fun,
Michael _________________ For technical reasons, the signature is on the back of this message.
Last edited by six1 on Wed Dec 12, 2012 7:58 am; edited 2 times in total |
|
Back to top |
|
|
six1
Joined: 27 Feb 2009 Posts: 553
|
Posted: Wed Dec 05, 2012 4:50 pm Post subject: |
|
|
NTP Timeserver
Code: |
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)
|
save this as "ETH_NTP.inc"
Code: |
'*******************************************************************************
'
' 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 :
|
_________________ For technical reasons, the signature is on the back of this message.
Last edited by six1 on Fri Dec 07, 2012 7:11 pm; edited 1 time in total |
|
Back to top |
|
|
six1
Joined: 27 Feb 2009 Posts: 553
|
Posted: Fri Dec 07, 2012 7:11 pm Post subject: |
|
|
DHCP
Code: |
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))
|
save this as "ETH_DHCP.inc"
Code: |
'*******************************************************************************
'
' 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 :
|
_________________ For technical reasons, the signature is on the back of this message.
Last edited by six1 on Wed Dec 12, 2012 8:03 am; edited 2 times in total |
|
Back to top |
|
|
six1
Joined: 27 Feb 2009 Posts: 553
|
Posted: Mon Dec 10, 2012 5:24 pm Post subject: |
|
|
MYSQL
!!! http://www.mcselec.com/index2.php?option=com_forum&Itemid=59&page=viewtopic&t=11766 !!!
Code: |
#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()
|
_________________ For technical reasons, the signature is on the back of this message.
Last edited by six1 on Wed Aug 21, 2013 2:20 pm; edited 2 times in total |
|
Back to top |
|
|
six1
Joined: 27 Feb 2009 Posts: 553
|
Posted: Mon Dec 10, 2012 5:25 pm Post subject: |
|
|
Ready Projects (XMEGA & ATMEGA) for testing above _________________ For technical reasons, the signature is on the back of this message. |
|
Back to top |
|
|
albertsm
Joined: 09 Apr 2004 Posts: 5913 Location: Holland
|
Posted: Mon Dec 10, 2012 9:55 pm Post subject: |
|
|
hi SIX1,
Thank you for sharing your work. It is impressive and very convenient that you sorted that out. Translating RFC into code is not so simple as it seems.
The MYSQL demonstrates that a skilled programmer can let the 8 bit AVR do about anything. _________________ Mark |
|
Back to top |
|
|
|
|
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum You cannot attach files in this forum You cannot download files in this forum
|
|