Forums PureBasic - Français
http://forums.purebasic.com/french/
C'est pas possible ce que tu dis... ton doigt n'est pas plus rapide qu'un microprocesseur , comment veut tu loupé l'appuis sur un bouton ?3) Je veux remplir ma liste en arrière plan quoiqu'il arrive, sans perte de message, overflow ou latence : tu imagines si mon programme rate l'appui du bouton 'ALARME' juste parce qu'il est en train de traiter autre chose ?
Code : Tout sélectionner
Procedure lecture_reseau()
;...
EndProcedure
List message.i()
refrechTimer.i = 0
OpenWindow(0,0,0,100,100,"...")
Repeat
event = WindowEvent()
surveille_reseau = lecture_reseau()
If surveille_reseau = #True ; MESSAGE RECU !
; commande reseau....
Else
ForEach message() ; TRAITEMENT DES MESSAGES !
Next
EndIf
If refrechTimer < ElapsedMilliseconds()
refrechTimer = ElapsedMilliseconds() + 100
; Mise à jour des gadgets
; de la fenetre
; etc...
EndIf
Until event = #PB_Event_CloseWindow 
).Code : Tout sélectionner
; Velbus server 1.0 by Golfy (Purebasic 4.60)
; v2 -> try to delay message from Ethernet -> Velbus
; v2.1 -> inform about bad frame (from wich client)
; v2.2 -> correction with CRC checksum (add & $FF)
; v2.3 -> added INI file with 2 parameters (COM and TCPPort)
; v2.4 -> added last time if Bad Checksum
; v2.5 -> added buffer max monitor + list connexion (31/07/2012)
; Default parameters : COM4 and 8080
version$ = "2.5"
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, clientID.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 ProgramParameter(0) = ""
If OpenFile(0,"PB_Velbus-server.ini")
port$=ReadString(0)
port =Val(ReadString(0))
CloseFile(0)
Else
PrintN("Start with default parameters...")
Delay(2000)
EndIf
EndIf
PrintN("Opening serial "+port$+"...")
If OpenSerialPort(0, Port$, 9600, #PB_SerialPort_NoParity, 8, 1, #PB_SerialPort_NoHandshake, 2048, 2048)
PrintN("PB_Velbus-Server "+version$+" : 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
;declare structure and variables
*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
Structure netclient
portID.i
CRCErr.i
IPAdd.s
CRCDelay.i
EndStructure
Global NewList messages.Vmsg()
Global NewList Client.netclient()
Global TXNET.q = 0
Global TXBUS.q = 0
Global BPnet.q = 0
Global BPbus.q = 0
Global RXLenMax.i = 0
Global MaxMsg.i = 0
If CreateNetworkServer(0, Port)
ClearConsole()
PrintN("Listening Ethernet port : "+Str(port)+" / Serial port : "+port$)
HauteurCurseur = 0
d = ElapsedMilliseconds()
dbp = ElapsedMilliseconds()
uptime=Date()
Repeat
; server is alive : show date (french format)
If Date() <> dd
dd = Date()
ConsoleLocate(62,0)
PrintN(FormatDate("%dd/%mm/%yy %hh:%ii:%ss",Date()))
utime = Date()-uptime
yt = utime/31536000
mt = (utime-31536000*yt)/2635200
dt = (utime-2635200*mt)/86400
ConsoleLocate(0,6)
PrintN("Velbus-server UpTime : "+Str(yt)+" year, "+Str(mt)+" month, "+Str(dt)+" day(s) and "+FormatDate("%hh:%ii:%ss",utime))
ForEach Client()
de = (ElapsedMilliseconds()-Client()\CRCDelay)/1000
If client()\CRCErr>10 And de > 60
ConsoleLocate(0,9)
PrintN("Closing client "+client()\IPAdd+", "+Str(Client()\portID)+" because too many errors in one minut ("+Str(client()\CRCErr)+")")
CloseNetworkConnection(Client()\portID)
DeleteElement(Client(),1)
ElseIf de > 60
Client()\CRCErr = 0
Client()\CRCDelay = ElapsedMilliseconds()
EndIf
Next
EndIf
u= ElapsedMilliseconds()-dbp
If u > 1000
debitnet.f = ((TXNET-BPnet)*8/(u/1000))/1024
debitbus.f = ((TXBUS-BPbus)*8/(u/1000))/1024
ConsoleColor(14,0)
ConsoleLocate(20,3)
PrintN("BP Net : "+StrF(debitnet.f,2)+" kbps ")
ConsoleColor(15,0)
ConsoleLocate(42,3)
PrintN("BP Velbus : "+StrF(debitbus.f,2)+" kbps ")
ConsoleColor(7,0)
BPnet = TXNET
BPbus = TXBUS
dbp=ElapsedMilliseconds()
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()
If ListSize(messages()) > MaxMsg
MaxMsg = ListSize(messages())
EndIf
ConsoleLocate(20,4)
PrintN("Queue : "+Str(ListSize(messages()))+" msgs (Max : "+Str(MaxMsg)+") ")
EndIf
SEvent = NetworkServerEvent()
If SEvent
ConsoleLocate(0,2)
PrintN("[N]")
ClientID = EventClient()
Select SEvent
Case #PB_NetworkEvent_Connect
; new client connected
ConsoleLocate(0,7)
AddElement(Client())
Client()\portID = ClientID
IP$=IPString(GetClientIP(ClientID))
Client()\IPAdd = IP$
Client()\CRCErr + 0
Client()\CRCDelay = ElapsedMilliseconds()
Space(80)
ConsoleLocate(5,2)
PrintN("Nb Client:"+Str(ListSize(Client())))
ConsoleLocate(0,7)
PrintN("-------------------------------------------------------------------------")
ForEach Client()
PrintN("Open Connexion ID "+Str(Client()\portID)+" for "+Client()\IPAdd+" ("+FormatDate("%dd/%mm/%yy %hh:%ii:%ss",Date())+") ")
Next
Case #PB_NetworkEvent_Data
RXLen = ReceiveNetworkData(ClientID, *BNin, 4096)
If RXLen > 5
N = AnalyseMessage(*BNin,RXLen,ClientID)
TXNET=TXNET+RXLen
ConsoleLocate(20,2)
PrintN("Eth-> "+Str(TXNET)+" ("+Str(RXLen)+") ")
;PrintN("NET --> VelBUS : "+Str(N)+" messages received ("+Str(RXLen)+" bytes received)")
EndIf
Case #PB_NetworkEvent_Disconnect
; client has diconnected
ConsoleLocate(0,7)
ForEach Client()
If Client()\portID = ClientID
ip$=Client()\IPAdd
DeleteElement(Client(),1)
Space(80)
ConsoleLocate(0,7)
PrintN("-------------------------------------------------------------------------")
ForEach Client()
PrintN("Open Connexion ID "+Str(Client()\portID)+" for "+Client()\IPAdd+" ("+FormatDate("%dd/%mm/%yy %hh:%ii:%ss",Date())+") ")
Next
PrintN("Closed Connexion ID "+Str(ClientID)+" for "+ip$+" ("+FormatDate("%dd/%mm/%yy %hh:%ii:%ss",Date())+") ")
EndIf
Next
ConsoleLocate(5,2)
PrintN("Nb Client:"+Str(ListSize(Client())))
EndSelect
EndIf
; SERIAL TO NETWORK ==========================================================================
Serial = AvailableSerialPortInput(0)
If Serial
ConsoleLocate(0,2)
PrintN("[S]")
RXLen = ReadSerialPortData(0,*BSin,Serial)
If RXlen = Serial
z = 0
For y=0 To RXLen
a$ = RSet(Hex(PeekB(*Bsin+y) & $FF),2,"0")
If a$ = "0F"
cmd$ = "<-- 0F "
z = y
ElseIf a$ = "04" And y-z > 3
cmd$=cmd$+"04 ("+Str(y)+")-"
Debug cmd$
cmd$ = ""
Else
cmd$=cmd$+a$+" "
EndIf
Next y
ForEach Client()
Err = SendNetworkData(Client()\portID, *BSin, RXLen)
Next
TXBUS = TXBUS + RXLen
If RXLen > RXLenMax
RXLenMax = RXLen
EndIf
ConsoleLocate(42,2)
PrintN("VBus-> "+Str(TXBUS)+" ("+Str(RXLen)+"/"+Str(RXLenmax)+") ")
Else
Debug "Oct disponibles : "+Str(Serial)+" / Oct envoyés : "+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,ClientID)
; 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
z = 0
For y=0 To full
a$ = RSet(Hex(PeekB(*bus+y) & $FF),2,"0")
If a$ = "0F"
cmd$ = "--> 0F "
z = y
ElseIf a$ = "04"
cmd$=cmd$+"04 ("+Str(y)+")-"
Debug cmd$
cmd$ = ""
Else
cmd$=cmd$+a$+" "
EndIf
Next y
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) & $FF = $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)
Else
Debug "CRC Velbus : "+Str(PeekB(*bus+crcloc) & $FF)+" CRC PB : "+Str(crc)
ForEach client()
If Client()\portID = ClientID
Client()\CRCErr + 1
ConsoleLocate(0,8)
ConsoleColor(12,0)
PrintN("Bad frame from "+Str(ClientID)+ ": Event has become "+Str(Client()\CRCErr)+" times ("+FormatDate("%dd/%mm/%yyyy %hh:%ii:%ss",Date())+") ")
ConsoleColor(7,0)
EndIf
Next
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) & $FF ; (AND operation) and inverse with XOR (!), them add '1'
ProcedureReturn Somme ; Return the checksum value
EndProcedure
tu n'es pas tres curieux d'essayer ....Golfy a écrit :Merci pour vos indications.
1) Je note que le programme de Dobro fonctionne avec des appels à des API Windows... quid si je compile sous Linux (oui certains utilisateurs Velbus sont Win, d'autres Linux) ? les timer Purebasic ne sont pas fiables ?
Code : Tout sélectionner
Global cnt
Global dte
Global ddd
Global gct.d
enumeration
#window
#timer_1
#date
#Compteur
#timer_compt
#text_main
#text_thread
#text_timer
EndEnumeration
Declare tachecompte(void.i)
Declare affichedate()
Declare globalcount()
Declare TimerProc(hwnd.l, uMsg.l, idEvent.l, dwTime.l)
Declare WindowCallback(WindowID,message,wParam,lParam)
OpenWindow(#window,100,100,200,100,"TestThread")
TextGadget(#date, 70,10,120,20,"date",#PB_Text_Border)
TextGadget(#Compteur, 70,30,120,20,"cnt",#PB_Text_Border)
TextGadget(#timer_compt, 70,50,120,20,"timercnt",#PB_Text_Border)
TextGadget(#text_main, 10,10,120,20,"main")
TextGadget(#text_thread, 10,30,120,20,"thread")
TextGadget(#text_timer, 10,50,120,20,"timer")
; **** preparation du bin's ***********
AddWindowTimer(#window, #timer_1, 1000)
SetWindowCallback(@WindowCallback()) ; active le callback
th = CreateThread(@tachecompte(),1000) ; active le Thread
dte=Date()
ddd = ElapsedMilliseconds()
; ****** fin de preparation du bin's ******
; *** boucle principale ******
Repeat
affichedate()
select waitWindowEvent(2)
case #PB_Event_Timer
if EventTimer() = #timer_1
globalcount()
endif
case #PB_Event_CloseWindow
break
endselect
forever
; **** fin boucle principale ***
CloseWindow(0)
End
; ************* zone des procedures *******************
Procedure tachecompte(void.i)
; le Thread
z = 0
cnt = 0
Repeat
Delay(1000)
cnt+1
SetGadgetText(#Compteur, Str(cnt)+" ")
forever
EndProcedure
Procedure affichedate()
; le main joué par le callback
SetGadgetText(#date,FormatDate("%hh:%ii:%ss", Date()-dte)+" - "+Str((ElapsedMilliseconds()-ddd)/100))
EndProcedure
Procedure globalcount()
; le code joué par le timer
gct = gct + 0.1
SetGadgetText(#timer_compt, StrD(gct,1)+" ")
EndProcedure
Procedure WindowCallback(WindowID,message,wParam,lParam)
; by Dobro
res=#PB_ProcessPureBasicEvents
Select message
case #WM_MOVE ; se charge de continuer a incrementer la date si on bouge la fenetre !!
affichedate()
ProcedureReturn #True
case #WM_TIMER
if wParam=#timer_1
globalcount()
endif
ProcedureReturn #True
EndSelect
ProcedureReturn res ; important , laissez passer les autres evenements !!!
EndProcedure
; EPB
. Si je devais te conseiller un truc, c'est d'un peu ranger tout ça, mais tu dois le savoir... Si je vois un code sympa avec une bonne gestion de file d'attente, je pense à toi @DobroDaubreau a écrit :voici la version portable :
ha bon ?G-Rom a écrit :@DobroDaubreau a écrit :voici la version portable :
SetWindowCallback() n'est pas portable
