Application client/serveur eventuellement sur réseau

Je viens de mettre une nouvelle version de KGF.dll en ligne. Cette version donne de nouvelles fonctionnalités en matière de communication entre programmes. Tout est documenté dans l'aide de KGF.dll (KGF.chm) ou dans l'aide en ligne.

Pour montrer les possibilités de ces fonctions, j'ai fait une petite application client/serveur. Deux programmes indépendants:
- un serveur qui se cache automatiquement après le lancement et qui est protégé contre un double lancement
- un client qui communique avec le serveur

L'avantage de cette technique, c'est qu'on peut avoir un serveur dédié à un type de problème, et plusieurs programmes client qui tournent simultanément et utilisent le même serveur, sans entrer techniquement en conflit, puisque les actions sont sérialisées, et une action n'est commencée que lorsque la précédente est terminée. Par contre, rien n'interdit d'avoir plusieurs serveurs actifs simultanément, chacun avec sa mailbox personnelle, et plusieurs clients s'adressent à un serveur ou un autre, en fonction du problème à résoudre.

Le client a une petite combo donnant la liste des actions possibles. Certaines actions sont considérées comme des actions "internes" et sont utilisées pour gérer le serveur: connexion, ping, stop, montrer le serveur, cacher le serveur. D'autres actions sont purement du ressort de l'application. Pour des besoins de la démo, j'ai fait une action "login valide" et une autre "login invalide". Chaque action s'effectue via un message envoyé vers le serveur. Ce dernier (s'il est en ligne !) le reçoit, le traite et répond par un autre message qui est alors reçu et traité par le client.

Pour l'essayer, il faut générer l'EXE à partir du serveur, et lancer le serveur en double-cliquant sur l'EXE. Je rappelle qu'il se cache immédiatement, mais reste actif ! Voici le code:

Code:: ' server_par_mailbox.bas
'
' Ce serveur reçoit des messages du format:
' expéditeur
' adresse
' commande
' nombre de paramètres
' paramètre 1
' ...
' paramètre n
' Chaque élément se trouve sur une ligne séparée. Dans le texte du méssage,
' les éléments sont donc séparés par chr$(13)+chr$(10).
' Sens des éléments:
' expéditeur chaîne de caractères libre identifiant l'expéditeur
' adresse chaîne de caractères contenant la mailbox de l'expéditeur
' commande identifiant de la fonction à exécuter
' nombre de paramètres nombre de paramètres pour la commande
' paramètre x chaîne de caractères contenant le paramètre x pour la commande
' Le serveur exécute la commande utilisant les paramètres passés
' Si l'expéditeur est spécifié, le serveur enverra une réponse, en fonction de la commande.
'
' Commandes internes:
' #STOP arrête le serveur (réponse #OK)
' #PING renvoie un signal de présence (réponse #OK)
' #DELAY définit le délai d'attente entre deux tentatives de réception (défaut: 500)
' #SHOW montre le serveur (réponse #OK)
' #HIDE cache le serveur (réponse #OK)
' Commandes application:
' login identification (paramètres identifiant et mot de passe)
' réponses #OK ou #ERROR 101
'
' Réponses du serveur:
' expéditeur PanoramicServer
' adresse \\.\mailslot\PanoramicServer
' réponse identifiant de la réponse
' nombre de paramètres nombre de paramètres pour la réponse
' paramètre x chaîne de caractères contenant le paramètre x pour la réponse
'
' Réponses internes:
' #OK confirmation (nombre de paramètres = 0)
' #ERROR erreur (1 paramètre: code erreur)
'
' Codes erreur internes transmis par le message #ERROR:
' 1 = format de message invalide
' 2 = nombre de paramètres invalide
' 3 = paramètre non numérique
' Codes erreur application transmis par le message #ERROR
' 101 = login invalide
'
' Le programme utilise deux mémos (potentiellement cachés) pour le message reçu et la trace.
' Ces mémos ont des numéros qui se suivent. Le premier est ServerMemo%

hide 0 : ' invisible par défaut
left 0,screen_x - width(0) : ' coller à droite par défaut

label close0, stp

dim delai% : delai% = 500
dim nl$ : nl$ = chr$(13) + chr$(10)
dim ServerMemo% : ServerMemo% = 1
dim res%, mbx$, mbxhnd%, cmd$, msg$, stp%
dim exp$

dim nuser%, userid$(20),usermbx$(20)

' message reçu
memo ServerMemo% : full_space ServerMemo% : bar_both ServerMemo% : width ServerMemo%,250
' historique des messages
memo ServerMemo%+1 : full_space ServerMemo%+1 : bar_both ServerMemo%+1 : width ServerMemo%+1,250 : left ServerMemo%+1,255

button 4 : left 4,150 : caption 4,"Stop" : on_click 4,stp : top 4,35

dll_on "kgf"
on_close 0,close0
caption 0,"PanoramicServer"

mbx$ = "\\.\mailslot\PanoramicServer"

' tester si le serveur est déjà lancé
IsServerPresent(mbx$)
if count(ServerMemo%)>0
message "Le serveur est déjà en cours d'exécution !"
terminate
end_if
res% = dll_call1("CloseMailbox",mbxhnd%)

' création de la mailbox du serveur
mbxhnd% = dll_call1("CreateMailbox",adr(mbx$))
item_add ServerMemo%+1,date$+" "+time$+"Start PanoramicServer"

' boucle infinie d'attente d'un message
repeat
if stp%=1 then terminate
res% = dll_call2("ReceiveMailboxMessage",mbxhnd%,handle(ServerMemo%))
if count(ServerMemo%)>0
cmd$ = item_read$(ServerMemo%,3)
exp$ = item_read$(ServerMemo%,2)
LogInp()
' commandes internes
if cmd$="#STOP" then CmdSTOP()
if cmd$="#PING" then CmdPING()
if cmd$="#DELAY" then CmdDELAY()
if cmd$="#SHOW" then CmdSHOW()
if cmd$="#HIDE" then CmdHIDE()
' comandes de l'application
if lower$(cmd$)="login" then Login()
' ...
else
pause delai%
end_if

until 1=2
end

' *** arrêt forcé par bouton
stp:
stp% = 1
return

close0:
res% = dll_call1("CloseMailbox",mbxhnd%)
return

' *** ajouter le message entrant au journal des messages
sub LogInp()
dim_local s$, i%
for i%=1 to count(ServerMemo%)
s$ = s$ + " "+item_read$(ServerMemo%,i%) + nl$
next i%
item_add ServerMemo%+1,date$+" "+time$+" <inp> "+nl$+left$(s$,len(s$)-2)
end_sub

' *** ajouter le message sortant au journal des messages
sub LogOut(mbx$,s$)
dim_local s1$, s2$, p%
s1$ = s$
p% = instr(s1$,nl$)
while p%>0
s2$ = s2$ + " " + left$(s1$,p%+1)
s1$ = mid$(s1$,p%+2,len(s1$))
p% = instr(s1$,nl$)
end_while
item_add ServerMemo%+1,date$+" "+time$+" <out> "+nl$+" "+mbx$+nl$+s2$
end_sub

' *** arrêter le serveur
sub CmdSTOP()
SendOK()
pause 500
terminate
end_sub

' *** répondre à une demande de présence
sub CmdPING()
SendOK()
end_sub

' *** changer le délai d'attente entre deux tentatives de réception
sub CmdDELAY()
dim_local s$, n%
s$ = item_read$(ServerMemo%,4)
if numeric(s$)=0
SendERROR(1) : ' format message invalide
exit_sub
end_if
n% = val(s$)
if n%<>1
SendERROR(2) : ' nombre de paramètres invalide
exit_sub
end_if
s$ = item_read$(ServerMemo%,5)
if numeric(s$)=0
SendERROR(3) : ' paramètre non numérique
exit_sub
end_if
if val(s$)<1
SendERROR(3) : ' paramètre non numérique
exit_sub
end_if
delay% = val(s$)
if exp$<>"" then SendOK()
end_sub

' *** montrer le serveur
sub CmdSHOW()
show 0
SendOK()
end_sub

' ***cacher le serveur
sub CmdHIDE()
hide 0
SendOK()
end_sub

' *** envoyer le mesage OK
sub SendOK()
dim_local s$
if len(exp$)=0 then exit_sub
s$ = mbx$+nl$+"\\.\mailslot\PanoramicServer"+nl$+"#OK"+nl$+"0"+nl$
res% = dll_call2("SendMailboxMessage",adr(exp$),adr(s$))
LogOut(exp$,s$)
end_sub

' *** envoyer un message d'erreur avec son code
sub SendERROR(err%)
dim_local s$
if exp$="" then exit_sub
s$ = mbx$+nl$+"\\.\mailslot\PanoramicServer"+nl$+"#ERROR"+nl$+"1"+nl$+str$(err%)+nl$
res% = dll_call2("SendMailboxMessage",adr(exp$),adr(s$))
LogOut(exp$,s$)
end_sub

' *** tester si le serveur est présent
sub IsServerPresent(mbx$)
dim_local msg$, mbxhnd%, mbxtmp$
mbxtmp$ = file_extract_name$(param_value$(0))
mbxtmp$ = "\\.\mailslot\"+left$(mbxtmp$,len(mbxtmp$)-4)+"_"+str$(handle(0))
mbxhnd% = dll_call1("CreateMailbox",adr(mbxtmp$))
msg$ = mbxtmp$+nl$+mbxtmp$+nl$+"#PING"+nl$+"0"+nl$
res% = dll_call2("SendMailboxMessage",adr(mbx$),adr(msg$))
LogOut(mbx$,msg$)

pause 800
res% = dll_call2("ReceiveMailboxMessage",mbxhnd%,handle(ServerMemo%))
LogInp()
end_sub

sub Login()
dim_local user$, pwd$, s$, n%
s$ = item_read$(ServerMemo%,4)
if numeric(s$)=0
SendERROR(1) : ' format message invalide
exit_sub
end_if
n% = val(s$)
if n%<>2
SendERROR(2) : ' nombre de paramètres invalide
exit_sub
end_if
user$ = item_read$(ServerMemo%,5)
pwd$ = item_read$(ServerMemo%,6)
if (user$="Klaus") and (pwd$="KGF")
if nuser%>0
for n%=0 to nuser%-1
if userid$(n%)=user$
SendOK()
exit_sub
end_if
next n%
end_if
userid$(nuser%) = user$
usermbx$(nuser%) = exp$
nuser% = nuser% + 1
SendOK()
else
SendERROR(101)
end_if
end_sub

Et voici le client qui peut être utilisé à partir de l'éditeur de Panoramic ou généré en EXE et lancé à partir de l'EXE:

Code:: ' client_pour_server_par_mailbox.bas
'
' Ce client communique avec son serveur par des messages du format:
' expéditeur
' adresse
' commande
' nombre de paramètres
' paramètre 1
' ...
' paramètre n
' Chaque élément se trouve sur une ligne séparée. Dans le texte du méssage,
' les éléments sont donc séparés par chr$(13)+chr$(10).
' Sens des éléments:
' expéditeur chaîne de caractères libre identifiant l'expéditeur
' adresse chaîne de caractères contenant la mailbox de l'expéditeur
' commande identifiant de la fonction à exécuter
' nombre de paramètres nombre de paramètres pour la commande
' paramètre x chaîne de caractères contenant le paramètre x pour la commande
' Le serveur exécute la commande utilisant les paramètres passés
' Si l'expéditeur est spécifié, le serveur enverra une réponse, en fonction de la commande.
'
' Commandes internes:
' #STOP arrête le serveur (réponse #OK)
' #PING renvoie un signal de présence (réponse #OK)
' #DELAY définit le délai d'attente entre deux tentatives de réception (défaut: 500)
' #SHOW montrer le serveur (réponse #OK)
' #HIDE cacher le serveur (réponse #OK)
'
' Réponses du serveur:
' expéditeur PanoramicServer
' adresse \\.\mailslot\PanoramicServer
' réponse identifiant de la réponse
' nombre de paramètres nombre de paramètres pour la réponse
' paramètre x chaîne de caractères contenant le paramètre x pour la réponse
'
' Réponses internes:
' #OK confirmation (nombre de paramètres = 0)
' #ERROR erreur (1 paramètre: code erreur)
'
' Codes erreur transmis par le message #ERROR:
' 1 = format de message invalide
' 2 = nombre de paramètres invalide
' 3 = paramètre non numérique
'
' Le programme utilise deux mémos (potentiellement cachés) pour le message reçu et la trace.
' Ces mémos ont des numéros qui se suivent. Le premier est ClientMemo%

label close0, go

dim delai% : delai% = 500
dim nl$ : nl$ = chr$(13) + chr$(10)
dim ClientMemo% : ClientMemo% = 1
dim res%, cmbx$, smbx$, mbxhnd%, cmd$, msg$, stp%, act%
dim exp$

' message reçu
memo ClientMemo% : full_space ClientMemo% : bar_both ClientMemo% : width ClientMemo%,250
height ClientMemo%,height(ClientMemo%)-40 : top ClientMemo%,40
' historique des messages
memo ClientMemo%+1 : full_space ClientMemo%+1 : bar_both ClientMemo%+1 : width ClientMemo%+1,250 : left ClientMemo%+1,255
height ClientMemo%+1,height(ClientMemo%+1)-40 : top ClientMemo%+1,40

alpha 11 : top 11,10 : left 11,10 : caption 11,"Action:"
combo 12 : top 12,5 : left 12,60 : width 12,200
item_add 12,"Connexion"
item_add 12,"Ping"
item_add 12,"Stop"
item_add 12,"Montrer le serveur"
item_add 12,"Cacher le serveur"
item_add 12,"Login valide"
item_add 12,"Login invalide"
' ...
button 13 : top 13,5 : left 13,270 : caption 13,"Exécuter" : on_click 13,go

dll_on "kgf"
on_close 0,close0
caption 0,"Client pour PanoramicServer"

smbx$ = "\\.\mailslot\PanoramicServer"
cmbx$ = "\\.\mailslot\Client_"+str$(handle(0))

end

go:
act% = item_index(12) : ' numéro de l'action choisie
select act%
' actions internes
case 1: ActConnect()
case 2: ActPing()
case 3: ActHalt()
case 4: ActShow()
case 5: ActHide()
' actions application
case 6: ActLogin(1)
case 7: ActLogin(0)
' ...
end_select
return

close0:
res% = dll_call1("CloseMailbox",mbxhnd%)
return

' *** ajouter le message entrant au journal des messages
sub LogInp()
dim_local s$, i%
for i%=1 to count(ClientMemo%)
s$ = s$ + " "+item_read$(ClientMemo%,i%) + nl$
next i%
item_add ClientMemo%+1,date$+" "+time$+" <inp> "+nl$+left$(s$,len(s$)-2)
end_sub

' *** ajouter le message sortant au journal des messages
sub LogOut(mbx$,s$)
dim_local s1$, s2$, p%
s1$ = s$
p% = instr(s1$,nl$)
while p%>0
s2$ = s2$ + " " + left$(s1$,p%+1)
s1$ = mid$(s1$,p%+2,len(s1$))
p% = instr(s1$,nl$)
end_while
item_add ClientMemo%+1,date$+" "+time$+" <out> "+nl$+" "+mbx$+nl$+s2$
end_sub

' *** tester si le serveur est présent
sub IsServerPresent(mbx$)
dim_local msg$, mbxhnd%, mbxtmp$
mbxtmp$ = file_extract_name$(param_value$(0))
mbxtmp$ = "\\.\mailslot\"+left$(mbxtmp$,len(mbxtmp$)-4)+"_"+str$(handle(0))
mbxhnd% = dll_call1("CreateMailbox",adr(mbxtmp$))
msg$ = mbxtmp$+nl$+mbxtmp$+nl$+"#PING"+nl$+"0"+nl$
res% = dll_call2("SendMailboxMessage",adr(smbx$),adr(msg$))
LogOut(smbx$,msg$)

pause 800
res% = dll_call2("ReceiveMailboxMessage",mbxhnd%,handle(ClientMemo%))
LogInp()
end_sub

' *** tenter une connexion au serveur
sub ActConnect()
' tester si le serveur est déjà lancé
IsServerPresent(mbx$)
if count(ClientMemo%)=0
message "Le serveur n'est pas actif !"
return
end_if
res% = dll_call1("CloseMailbox",mbxhnd%)

' création de la mailbox du client
mbxhnd% = dll_call1("CreateMailbox",adr(cmbx$))
item_add ClientMemo%+1,date$+" "+time$+"Connexion à PanoramicServer"
message "Connecté au serveur"
end_sub

' *** envoyer le mesage PING
sub ActPing()
dim_local s$
clear ClientMemo%
s$ = "Client "+str$(handle(0))+nl$+cmbx$+nl$+"#PING"+nl$+"0"+nl$
res% = dll_call2("SendMailboxMessage",adr(smbx$),adr(s$))
LogOut(smbx$,s$)
pause 800
res% = dll_call2("ReceiveMailboxMessage",mbxhnd%,handle(ClientMemo%))
LogInp()
if count(ClientMemo%)>0
message "Réponse: "+item_read$(ClientMemo%,3)
else
message "Pas de réponse"
end_if
end_sub

' *** envoyer le mesage SHOW
sub ActShow()
dim_local s$
clear ClientMemo%
s$ = "Client "+str$(handle(0))+nl$+cmbx$+nl$+"#SHOW"+nl$+"0"+nl$
res% = dll_call2("SendMailboxMessage",adr(smbx$),adr(s$))
LogOut(smbx$,s$)
pause 800
res% = dll_call2("ReceiveMailboxMessage",mbxhnd%,handle(ClientMemo%))
LogInp()
if count(ClientMemo%)>0
message "Réponse: "+item_read$(ClientMemo%,3)
else
message "Pas de réponse"
end_if
end_sub

' *** envoyer le mesage HIDE
sub ActHide()
dim_local s$
clear ClientMemo%
s$ = "Client "+str$(handle(0))+nl$+cmbx$+nl$+"#HIDE"+nl$+"0"+nl$
res% = dll_call2("SendMailboxMessage",adr(smbx$),adr(s$))
LogOut(smbx$,s$)
pause 800
res% = dll_call2("ReceiveMailboxMessage",mbxhnd%,handle(ClientMemo%))
LogInp()
if count(ClientMemo%)>0
message "Réponse: "+item_read$(ClientMemo%,3)
else
message "Pas de réponse"
end_if
end_sub

sub ActHalt()
dim_local s$
clear ClientMemo%
s$ = "Client "+str$(handle(0))+nl$+cmbx$+nl$+"#STOP"+nl$+"0"+nl$
res% = dll_call2("SendMailboxMessage",adr(smbx$),adr(s$))
LogOut(smbx$,s$)
pause 800
res% = dll_call2("ReceiveMailboxMessage",mbxhnd%,handle(ClientMemo%))
LogInp()
if count(ClientMemo%)>0
message "Réponse: "+item_read$(ClientMemo%,3)
else
message "Pas de réponse"
end_if
end_sub

sub ActLogin(v%)
dim_local s$
clear ClientMemo%

if v%=1 : ' logiin valide
s$ = "Client "+str$(handle(0))+nl$+cmbx$+nl$+"login"+nl$+"2"+nl$+"Klaus"+nl$+"KGF"+nl$
res% = dll_call2("SendMailboxMessage",adr(smbx$),adr(s$))
LogOut(smbx$,s$)
pause 800
res% = dll_call2("ReceiveMailboxMessage",mbxhnd%,handle(ClientMemo%))
LogInp()
if count(ClientMemo%)>0
message "Réponse: "+item_read$(ClientMemo%,3)
else
message "Pas de réponse"
end_if
else : ' login invalide
s$ = "Client "+str$(handle(0))+nl$+cmbx$+nl$+"login"+nl$+"2"+nl$+"Klaus"+nl$+"kgf"+nl$
res% = dll_call2("SendMailboxMessage",adr(smbx$),adr(s$))
LogOut(smbx$,s$)
pause 800
res% = dll_call2("ReceiveMailboxMessage",mbxhnd%,handle(ClientMemo%))
LogInp()
if count(ClientMemo%)>0
message "Réponse: "+item_read$(ClientMemo%,3)
else
message "Pas de réponse"
end_if
end_if
end_sub

Pour la démo, tout est évidemment sur la même machine. J'espère que cette technique vous donnera des idées...

» Gestion d'un système client-serveur.
» ServerIPC - Technologie Client/Serveur remplaçant les DLL
» Des procédures pour le réseau
» Serveur FTP gratuit.
» Serveur RPC pas disponible