FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  FAQFAQ  RechercherRechercher  S'enregistrerS'enregistrer  MembresMembres  GroupesGroupes  Connexion  
Derniers sujets
» COMPILATEUR V 0.9 beta 7 du 10 aout 2017
par Yannick Aujourd'hui à 1:58

» Pb 17 (en analyse): ITEM_SELECT ne fonctionne pas
par Jack Hier à 19:26

» Compilateur FBPano
par Mike Hier à 13:52

» un nouveau editeur panobasic
par Jean Claude Hier à 10:18

» Le compilateur.
par Pedro Alvarez Hier à 8:36

» Pb 16 (en analyse): ON_CLOSE plante à l'exécution
par Jack Mer 16 Aoû 2017 - 20:00

» Pb 15 (en analyse): TIMER_ON plante à l'exécution
par Jack Mer 16 Aoû 2017 - 19:58

» KGF_dll - nouvelles versions
par Yannick Dim 13 Aoû 2017 - 17:35

» probleme d'outil
par Yannick Dim 13 Aoû 2017 - 17:32

» Carte de France des régions
par Yannick Sam 12 Aoû 2017 - 21:33

» Pb 14 (en analyse): PRINT_LOCATE plante à l'exécution
par Jack Ven 11 Aoû 2017 - 22:37

» Petit avertissement [Mots réservés]
par papydall Ven 11 Aoû 2017 - 13:45

» Distances sur plan
par JL35 Jeu 10 Aoû 2017 - 21:29

» Tracé : Triangle, Carrée, Dents de scie, Sinusoïde redressée
par papydall Jeu 10 Aoû 2017 - 14:52

» Troncature dans une image
par JL35 Mer 9 Aoû 2017 - 13:45

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Août 2017
LunMarMerJeuVenSamDim
 123456
78910111213
14151617181920
21222324252627
28293031   
CalendrierCalendrier

Partagez | 
 

 Application client/serveur eventuellement sur réseau

Voir le sujet précédent Voir le sujet suivant Aller en bas 
AuteurMessage
Klaus

avatar

Nombre de messages : 10062
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Application client/serveur eventuellement sur réseau   Dim 24 Jan 2016 - 5:01

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...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
 
Application client/serveur eventuellement sur réseau
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» Utiliser l'iPhone comme lecteur réseau
» Connexion Urmet sur mon iphone 4
» FTP avec serveur NAS D-LINK-323
» Disque dur en ethernet sur bbox (réseau samba)
» Le début de mon réseau, Nord-EST......

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC 32 bits :: Vos sources, vos utilitaires à partager-
Sauter vers: