Working hard on a Purebasic Velbus server and trying VelbusLink through it... and do you know ? I've see a frame like this :
Code:
65 6c 62 75 73 4c 69 6e 6b 20 38 2e 34 2e.....
This frame is received at VelbusLink startup : it probably mean "VelbusLink 8.4.61687" (even if I've loose de 'V')
But now, here is the PureBasic Velbus-ServerCode:
; Velbus server 1.0 by Golfy (Purebasic 4.60)
; v2 -> try to delay message from Ethernet -> Velbus
; Default parameters : COM4 and 8080
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Port$ = "COM4"
CompilerElse
Port$ = "/dev/ttyS0"
CompilerEndIf
Port = 8080
OpenConsole()
EnableGraphicalConsole(1)
; declare useful procedures
Declare.i AnalyseMessage(*bus,Len.i)
Declare.s Hexa2(*B,longueur.i)
Declare.i LectureNet()
Declare.i CheckSum(*B,longueur.i)
; if parameter are transmit after commandline
If FindString(UCase(ProgramParameter(0)),"H",1) Or FindString(UCase(ProgramParameter(0)),"?",1)
PrintN("PB_Velbus-server.exe SERIALport NETWORKport (ex: PB_Velbus-server.exe COM4 8131)")
PrintN("PB_Velbus-server.exe default = COM4 and 8080")
Input()
End
EndIf
If ProgramParameter(0) : port$ = ProgramParameter(0) : EndIf
If ProgramParameter(1) : port = Val(ProgramParameter(1)) : EndIf
If OpenSerialPort(0, Port$, 9600, #PB_SerialPort_NoParity, 8, 1, #PB_SerialPort_NoHandshake, 2048, 2048)
PrintN("PB_Velbus-Server v2.0 : open port "+port$+" done")
Else
PrintN("Erreur port "+port$)
Delay(2000)
End
EndIf
If InitNetwork() = 0
PrintN("Error : Can't initialize the network !")
Delay(2000)
End
EndIf
*BSin = AllocateMemory(4096)
*BNin = AllocateMemory(4096)
*BFull = AllocateMemory(7)
*BReady = AllocateMemory(7)
PokeB(*BFull+0,$0F)
PokeB(*BFull+1,$F8)
PokeB(*BFull+2,$00)
PokeB(*BFull+3,$01)
PokeB(*BFull+4,$0B)
PokeB(*BFull+5,$ED)
PokeB(*BFull+6,$04)
PokeB(*BReady+0,$0F)
PokeB(*BReady+1,$F8)
PokeB(*BReady+2,$00)
PokeB(*BReady+3,$01)
PokeB(*BReady+4,$0C)
PokeB(*BReady+5,$EC)
PokeB(*BReady+6,$04)
Structure Vmsg
Len.i
*cmd
EndStructure
Global NewList messages.Vmsg()
Global NewList Client.i()
Global TXNET.q
Global TXBUS.q
If CreateNetworkServer(0, Port)
PrintN("[ ] Listening on Ethernet port : "+Str(port))
HauteurCurseur = 0
d = ElapsedMilliseconds()
Repeat
; server is alive : show date (french format)
If Date() <> dd
dd = Date()
ConsoleLocate(60,2)
PrintN(FormatDate("%dd/%mm%/%yyyy %hh:%ii:%ss",Date()))
EndIf
; Send bufferised messages with 60ms delay
If ListSize(messages()) And ElapsedMilliseconds()-d > 40
Err = FirstElement(messages())
Err = WriteSerialPortData(0, messages()\cmd, messages()\len)
err = FreeMemory(messages()\cmd)
Err = DeleteElement(messages(),1)
d = ElapsedMilliseconds()
EndIf
SEvent = NetworkServerEvent()
If SEvent
ConsoleLocate(0,2)
PrintN("[N]")
ClientID = EventClient()
Select SEvent
Case #PB_NetworkEvent_Connect
; new client connected
ConsoleLocate(0,3)
AddElement(Client())
Client() = ClientID
IP$=IPString(GetClientIP(ClientID))
PrintN("Opening Connexion ID "+Str(Client())+" for "+ip$+" (Client Number : "+Str(ListSize(Client()))+")")
Case #PB_NetworkEvent_Data
RXLen = ReceiveNetworkData(ClientID, *BNin, 4096)
If RXLen > 5
N = AnalyseMessage(*BNin,RXLen)
Locate(30,2)
PrintN("Ethernet-> "+Str(RXLen)+" ")
;PrintN("NET --> VelBUS : "+Str(N)+" messages received ("+Str(RXLen)+" bytes received)")
EndIf
Case #PB_NetworkEvent_Disconnect
; client has diconnected
ConsoleLocate(0,3)
ForEach Client()
If Client() = ClientID
DeleteElement(Client(),1)
PrintN("Closing Connexion ID "+Str(ClientID)+" (Client Number : "+Str(ListSize(Client()))+")")
EndIf
Next
EndSelect
EndIf
; SERIAL TO NETWORK ==========================================================================
Serial = AvailableSerialPortInput(0)
If Serial
ConsoleLocate(0,2)
PrintN("[S]")
RXLen = ReadSerialPortData(0,*BSin,Serial)
If RXlen = Serial
ForEach Client()
Err = SendNetworkData(Client(), *BSin, RXLen)
Next
Else
Locate(45,2)
PrintN("Velbus-> "+Str(RXLen)+" ")
EndIf
EndIf
Until Quit = 1
CloseNetworkServer(0)
Else
PrintN("Error : Can't create the server (port in use ?).")
EndIf
End
; ------
; Procedure for Network/BUS command
; _______________________________________________________________________________________________________
Procedure.i AnalyseMessage(*bus,full.i)
; Format de trame :
; OF FB ** RL xx xx xx CK 04 - 0F FB ** ....
; 12 34 56 78 9A .....
stx = 0
etx = 0
lng = 0
counter = 0
t = 0
Repeat
If PeekB(*bus+t) & $FF = $0F
counter+1
fixlen = 4
varlen = PeekB(*bus+t+3) & $0F
fintrame = t+fixlen+varlen+1
crcloc = fintrame-1
tlen = fixlen+varlen+2
crc = checksum(*bus+t,tlen-3)
If PeekB(*bus+fintrame) = $04 And (PeekB(*bus+crcloc) & $FF)=crc
AddElement(messages())
messages()\len = tlen
messages()\Cmd = AllocateMemory(messages()\len)
CopyMemory(*bus+t,messages()\cmd,messages()\len)
t = t+(messages()\len-2)
EndIf
EndIf
t = t + 1
Until t=>full
ProcedureReturn ListSize(messages())
EndProcedure
; _______________________________________________________________________________________________________
Procedure.i CheckSum(*B,longueur.i)
somme=0 ; Initialize Counter
For tr=0 To longueur ; Loop from 0 to checksum byte -1
Somme=Somme+PeekB(*B+tr) & $FF ; Adding each byte from the packet
Next tr
Somme = (Somme & $FF) ! $FF ; As PureBasic use signed integer, need to remove higher value
Somme = Somme + 1 ; (AND operation) and inverse with XOR (!), them add '1'
ProcedureReturn Somme ; Return the checksum value
EndProcedure
Login
Register
FAQ
Search
