Traitement de QCM - Code Complet

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
kerkael
Messages : 97
Inscription : mer. 03/sept./2008 21:08

Traitement de QCM - Code Complet

Message par kerkael »

:D Talut, comme je suis hyper heureux d'avoir fini mon programme, je le partage volontiers avec vous ! :P

Voilà le topo :
- une page web (non présentée ici) propose un QCM
- le code http utilise un formulaire de type POST pour générer un fichier réponse
- le fichier réponse est stocké sur le serveur web, attendant d'être traîté

Voici le code pour automatiser le traitement avec :

- connexion au serveur FTP par fichier de paramètre modifiable
- gestion multilingue de l'interface graphique
- gestion automatique d'un nouveau fichier de solution
- multiples QCM pouvant être traités d'après des solutions distinctes
- descente et traitement des QCM (que j'appelle ici des TNA, pour Training Needs Assessment)

Les pré-requis sont détaillés dans le menu d'aide du code :
- nom des fichiers à traiter prefixeJJMM.txt
- format des réponses à traiter Q1 ou Q01 à Q99
- séparateur de champs, le pipe |
- autres champs, nom, prenom ...
- fichiers à traités sous repertoire ./tna sur le serveur ftp
- fichiers descendus localement sous repertoire ./treated

Le code repose sur 4 fichiers + préférences linguistiques ... je vous le donne en plusieurs messages.

Pour l'analyse du code, le fichier TNA.pb présente l'interface graphique et le choix des menus.
Les menus de la fenêtre principale sollicitent soit du code directement rédigé, soit font appel à des procédures.
La plupart des petites procédures sont dans le code du fichier TNA, et 2 autres fichiers se partagent les tâches longues ou vraiment distinctes du reste du code :
- TNA_treatment, pour bien séparer l'analyse des fichiers du reste du code
- TNA_saveas, code pratiquement récupérable pour la fenêtre de sauvegarde
Reste le fichier du menu, et le fichier des langues.
N'est pas présenté le fichier ftp_settings car il sera créé depuis l'interface graphique à l'initiative de l'utilisateur, en cryptant le password ftp.

En respectant les pré-requis, vous pouvez récupérer le code tel quel et traiter les QCM de votre serveur FTP.

Cheers :P


Fichier 1/5 - TNA.pb - 565 lignes

Code : Tout sélectionner

 ;- Window Constants
InitNetwork()

Global MainChaine$
Global dec.S = Space(1024) , enc.S = Space(1024)
Global myServer.S, myUser.S, myPass.S,myPass2display$
Global suffixe.l

Enumeration
  #Window_0
  #Window_saveas
  #thatfile
  #TexteEnTete
  #TextePrincipal
  #StringPrincipal
  #myfile
  #myotherfile
  #myftp
  #mylocaldir
  #myfr3D1
  #myfr3D2
  #myfr3D3 
  #LaDate
  #TexteSaisie
  #radioEN
  #radioFR
  #radioCU
  #my_window_Language
  #ButtonOKtoDL
  #ButtonOKtoTreat
EndEnumeration
IncludeFile "TNA_menu.pb"
IncludeFile "TNA_treatment.pb"
IncludeFile "TNA_saveas.pb"

Structure FichierFTP
  Nom$
  sjour$
  smois$
  Taille.l
  MaDate.l
  DeleteOK.b
  ToUpload.b
EndStructure

;{ Definitions
Define FileOK$ 
Define.b nbTreated=0, nbDeleted=0, nbCopyed=0,nbFileTuUpload=0
;}

;{ Langues pref
DataSection
  StartFile0:
  IncludeBinary "langues.pref"  
  EndFile0:
EndDataSection;}

;{vérification, lecture et au besoin création d'un nouveau fichier de préférences adaptable
Pref=OpenPreferences(GetCurrentDirectory()+"langues.pref")
If Pref=0 ; comme ça il ne le fait pas à chaque fois !
  Size=?EndFile0-?StartFile0
  CreateFile(0,GetCurrentDirectory()+"langues.pref")
  WriteData(0, ?StartFile0,Size)
  CloseFile(0)
EndIf;}

Macro RPS
  ReadPreferenceString
EndMacro

Procedure readFTPsettings()  
  If ReadFile(#myfile,"ftp_settings")  
    myServer.S=ReadString(#myfile)  
    myUser.S=ReadString(#myfile)  
    theString.S=ReadString(#myfile)  
    Base64Decoder(@theString.S, Len(theString), @dec, 1024)
    myPass.S=dec
    myPass2display$=theString
    CloseFile(#myfile)
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure setFTPsettings(servername.S, ftpuser.S,ftppass.S )
  
  Debug servername+ftpuser+ftppass
  If CreateFile(#myfile,"ftp_settings")         ; création d'un nouveau fichier texte... 
    Base64Encoder(@ftppass.S, Len(ftppass), @enc, 1024) 
    WriteStringN(#myfile, servername.S)  ; écriture de 10 lignes (suivies du code 'Fin de Ligne')
    WriteStringN(#myfile, ftpuser.S)  ; ajoute 10 chaînes sur la même ligne (le code 'Fin de Ligne' n'est pas ajouté) 
    Debug enc
    WriteStringN(#myfile, enc) 
    CloseFile(#myfile)                        ; ferme le fichier précédemment ouvert et enregistre les données
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf 
EndProcedure

Procedure downloadFiles(QuelSuffixe)
  NewList NomFichier.FichierFTP()
  MainChaine$=""
  If OpenFTP(#myftp, myServer.S, myUser.S,myPass.S)
    SetFTPDirectory(#myftp,"/tna") 
    If ExamineFTPDirectory(#myftp) 
      While NextFTPDirectoryEntry(#myftp) 
        If FTPDirectoryEntryType(#myftp) = 1
          AddElement(NomFichier())
          With NomFichier()
            \Nom$ = FTPDirectoryEntryName(#myftp)
            \sjour$=Mid(\Nom$,Len(\Nom$)-7,2)
            \smois$=Mid(\Nom$,Len(\Nom$)-5,2)
            \Taille = FTPDirectoryEntrySize(#myftp)
            \MaDate.l = Val(\smois$)*100+Val(\sjour$) 
          EndWith
        EndIf 
      Wend  
    EndIf  
    SortStructuredList(NomFichier(), #PB_Sort_Ascending, OffsetOf(FichierFTP\MaDate.l), #PB_Sort_Long)
    nbTreated=ListSize(NomFichier())
    
    MainChaine$=""
    ForEach NomFichier()
      If NomFichier()\MaDate>=QuelSuffixe
        Resultat = ReceiveFTPFile(#myftp, NomFichier()\Nom$, "treated\"+NomFichier()\Nom$ )
        If Resultat=1
          nbCopyed.b+1
          MainChaine$+NomFichier()\Nom$+ Chr(13)
        EndIf
      EndIf
    Next   
    CloseFTP(#myftp)
    ProcedureReturn nbCopyed
  Else
    MessageRequester(RPS("messagewarning","Avertissement"),RPS("noconnexion","Connexion impossible !"))
  EndIf
EndProcedure

Procedure deleteFiles()
  NewList FichierAEffacer.FichierFTP()
  If OpenFTP(#myftp, myServer.S, myUser.S,myPass.S)
    SetFTPDirectory(#myftp,"/tna") 
    If ExamineFTPDirectory(#myftp) 
      While NextFTPDirectoryEntry(#myftp) 
        If FTPDirectoryEntryType(#myftp) = 1
          AddElement(FichierAEffacer())
          FichierAEffacer()\Nom$ = FTPDirectoryEntryName(#myftp)
        EndIf 
      Wend 
    EndIf  
    SortStructuredList(FichierAEffacer(), #PB_Sort_Ascending, OffsetOf(FichierFTP\Nom$), #PB_Sort_String)
    nbTreated=ListSize(FichierAEffacer())
    
    MainChaine$=""
    ForEach FichierAEffacer()
      FichierAEffacer()\DeleteOK=DeleteFTPFile(#myftp, FichierAEffacer()\Nom$)
      If FichierAEffacer()\DeleteOK=1 
        MainChaine$+FichierAEffacer()\Nom$+ Chr(13)
        nbDeleted+1
      Else
        MessageRequester(RPS("messagewarning","Avertissement"),RPS("nodeletion","Fichier impossible à effacer")+" : "+FichierAEffacer()\Nom$)
      EndIf 
    Next   
    CloseFTP(#myftp)
    ProcedureReturn nbDeleted
  Else
    MessageRequester(RPS("messagewarning","Avertissement"),RPS("noconnexion","Connexion impossible !"))
  EndIf
EndProcedure

Procedure deleteLocal()
  keeplocaldir$=GetCurrentDirectory()
  SetCurrentDirectory("treated\")
  Resultat$ = GetCurrentDirectory()
  MainChaine$=""  
  nbDeleted=0
  If ExamineDirectory(#mylocaldir, Resultat$, "*.txt")  
    While NextDirectoryEntry(#mylocaldir)
      If DirectoryEntryType(#mylocaldir) = #PB_DirectoryEntry_File
        LeFichier.S=DirectoryEntryName(#mylocaldir)
        If DeleteFile(LeFichier.S)
          nbDeleted+1
          MainChaine$=MainChaine$+LeFichier.S+Chr(13)
        Else
          MessageRequester(RPS("messagewarning","Avertissement"),RPS("nodeletion","Fichier impossible à effacer")+" : "+LeFichier.S)
        EndIf
      EndIf
    Wend
    FinishDirectory(#mylocaldir) 
  EndIf
  SetCurrentDirectory(keeplocaldir$)
  ProcedureReturn nbDeleted
EndProcedure
    
Procedure uploadFiles()
  NewList FichiersToUpload.FichierFTP()
  If OpenFTP(#myftp, myServer.S, myUser.S,myPass.S) 
    SetFTPDirectory(#myftp,"/tna")
    keeplocaldir$=GetCurrentDirectory()
    SetCurrentDirectory("treated\")
    Resultat$ = GetCurrentDirectory()
    MainChaine$=""
    If ExamineDirectory(#mylocaldir, Resultat$, "*.*")  
      While NextDirectoryEntry(#mylocaldir)
        If DirectoryEntryType(#mylocaldir) = #PB_DirectoryEntry_File
          AddElement(FichiersToUpload())
          FichiersToUpload()\Nom$=DirectoryEntryName(#mylocaldir)  
        EndIf 
      Wend
      SortStructuredList(FichiersToUpload(), #PB_Sort_Ascending, OffsetOf(FichierFTP\Nom$), #PB_Sort_String)
      nbTreated=ListSize(FichiersToUpload())
      ForEach FichiersToUpload()
        Resultat=SendFTPFile(#myftp,FichiersToUpload()\Nom$,FichiersToUpload()\Nom$)
        If Resultat=1
          FichiersToUpload()\ToUpload=0
          nbCopyed.b+1
          MainChaine$+FichiersToUpload()\Nom$+Chr(13)
        Else
          FichiersToUpload()\ToUpload=1
          nbFileTuUpload.b+1
        EndIf 
      Next
      FinishDirectory(#mylocaldir)
    EndIf
    CloseFTP(#myftp)
    SetCurrentDirectory(keeplocaldir$)
  Else
    MessageRequester(RPS("messagewarning","Avertissement"),RPS("noconnexion","Connexion impossible !"))
  EndIf
EndProcedure

;{ Fenetre Language
If OpenWindow(#my_window_Language, 368, 138, 160, 41, "Language", #PB_Window_ScreenCentered |#PB_Window_TitleBar )
  OptionGadget(#radioEN, 50, 10, 40, 20, "EN")  ;Les 3 options apparaissent sous forme de bouton Radio
  OptionGadget(#radioFR, 10, 10, 40, 20, "FR")  ;un seul choix possible, donc
  OptionGadget(#radioCU, 90, 10, 80, 20, "Custom")
EndIf;}

;{ Repeat Fenetre language
Repeat
  EventID = WaitWindowEvent()
  If EventID = #PB_Event_Gadget 
    Select EventGadget()
      Case #radioEN          
        PreferenceGroup("EN")
      Case #radioCU
        PreferenceGroup("CU")
      Default
        PreferenceGroup("FR")
    EndSelect
  EndIf
Until EventID = #PB_Event_Gadget  ;Dès la sélection d'une langue, la fenêtre se ferme
CloseWindow(#my_window_Language)
;}

;{ Fenetre Principale
largeur=700
hauteur=700
If OpenWindow(#Window_0, 216, 0, largeur, hauteur, "TNA",  #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_TitleBar )
  If CreateMenu(#MenuBar_0, WindowID(#Window_0))
    affiche_menu() ;appel de procédure d'affichage du menu au lancement
    DisableMenuItem(#MenuBar_0, #MENU_FUpload, 1) 
    ;DisableMenuItem(#MenuBar_0, #MENU_FSaveas, 1)
  EndIf 
  TextGadget(#TexteEnTete,15,20,largeur-280,15,"") 
  TextGadget(#TexteSaisie,15,57,largeur-280,15,"")
  DateGadget(#LaDate, 15, 52, 120, 25, "Date : %dd/%mm/%yyyy")
  SetGadgetAttribute(#LaDate,#PB_Date_Maximum,Date())
  ButtonGadget(#ButtonOKtoDL,180,52,25,25,"OK")  
  ButtonGadget(#ButtonOKtoTreat,180,52,25,25,"OK")
  Frame3DGadget(#myfr3D3,5,95,largeur-10,hauteur-120,"",#PB_Frame3D_Double)
  TextGadget(#TextePrincipal,15,110,largeur-30,hauteur-150,"") 
  HideGadget(#LaDate,1)
  HideGadget(#ButtonOKtoTreat,1) 
  HideGadget(#ButtonOKtoDL,1) 
EndIf
;}

;{ Repeat Fenetre Principale
Repeat
  EventID = WaitWindowEvent()
  If EventID=#PB_Event_Gadget
    ;{
    Select EventGadget() 
      Case #ButtonOKtoDL ; on a validé le download en appuyant sur le bouton OK 
        ;{
        SetGadgetText(#TextePrincipal,RPS("textedownloadwait","Veuillez patienter le temps du téléchargement ..."))
        
        LaDate$=GetGadgetText(#LaDate)
        
        suffixeday=Val(Mid(LaDate$,8,2))
        suffixemonth=Val(Mid(LaDate$,11,2))
        suffixe=suffixeday+suffixemonth*100
        
        ;Debug LaDate$ + Str(suffixeday) + Str(suffixemonth) + Str(suffixe)
        If readFTPsettings()
          nbDownloaded=downloadFiles(suffixe) 
          MainChaine$=RPS("textedownloadok","Fichiers correctement téléchargés") + " : " + Str(nbDownloaded) +Chr(13)+Chr(13)+MainChaine$
        Else
          MainChaine$=RPS("textftpviewok", "Fichier des paramètres FTP introuvable : ") + " ftp_settings"
        EndIf 
        SetGadgetText(#TextePrincipal,MainChaine$)   
        ;}
      Case #ButtonOKtoTreat ; on a validé le traitementen appuyant sur le bouton OK 
        ;{ 
        LaDate$=GetGadgetText(#LaDate)
        
        suffixeday=Val(Mid(LaDate$,8,2))
        suffixemonth=Val(Mid(LaDate$,11,2))
        suffixe=suffixeday+suffixemonth*100
        LeRepertoire$ = GetCurrentDirectory()
        MainChaine$=""
        FindPrefixe(LeRepertoire$)   
        SetGadgetText(#TextePrincipal,MainChaine$)
        SetCurrentDirectory(LeRepertoire$) 
        DisableMenuItem(#MenuBar_0, #MENU_FSaveas, 0) 
        ;} 
    EndSelect
  EndIf
  ;}
  If EventID = #PB_Event_Menu 
    ;{  
    HideGadget(#LaDate,1) 
    HideGadget(#ButtonOKtoDL,1)    
    HideGadget(#ButtonOKtoTreat,1)
    SetGadgetText(#TexteEnTete,"") 
    SetGadgetText(#TexteSaisie,"") 
    
    Select EventGadget()
      Case #MENU_FUpload ; Remonter les fichiers vers le serveur
        ;{
        Debug "Menu FUpload"
        SetGadgetText(#TexteEnTete,RPS("enteteupload","CHARGER DES FICHIERS SUR LE SERVEUR FTP")) 
        SetGadgetText(#TexteSaisie,RPS("textconnexionwait","Connexion en cours ..."))
        
        If readFTPsettings()
          uploadFiles()
        Else
          MainChaine$=RPS("nosettings","paramètres de connexion introuvables")+" : ftp_settings" 
        EndIf
        SetGadgetText(#TexteSaisie,RPS("saisieupload","Depuis le répertoire .\treated")) 
        SetGadgetText(#TextePrincipal,MainChaine$)       
        ;}
      Case #MENU_FTreat ; Traiter les fichiers descendus
        ;{
        Debug "Menu FTreat"
        SetGadgetText(#TexteEnTete,RPS("enteteftreat","TRAITER LES FICHIERS TNA DESCENDUS LOCALEMENT DEPUIS LE ...")) 
        SetGadgetText(#TexteSaisie,RPS("jour","Jour")+"                       "+RPS("mois","Mois"))
        HideGadget(#LaDate,0)        
        HideGadget(#ButtonOKtoTreat,0)
        ;}
      Case #MENU_FDownload ; Descendre les fichiers TNA
        ;{
        Debug "Menu FDownload"
        SetGadgetText(#TexteEnTete,RPS("entetedownload","TELECHARGEMENT DES FICHIERS TNA DEPUIS LE ...")) 
        HideGadget(#LaDate,0) 
        SetGadgetText(#TextePrincipal,"")      
        HideGadget(#ButtonOKtoDL,0) 
        ;}
      Case #MENU_FSaveas
        ;{
        SetGadgetText(#TexteEnTete,RPS("entetesaveas","SAUVEGARDER LES RESULTATS VERS UN FICHIER")) 
        SetGadgetText(#TexteSaisie,RPS("saisiesaveas","Le fichier peut être sauvé sous format .csv pour traitement par excel"))
        MainChaine$=GetGadgetText(#TextePrincipal)
        saveFileas(MainChaine$) 
        ;}
      Case #MENU_Copy   
        ;{ 
        SetClipboardText(GetGadgetText(#TextePrincipal)) 
        MessageRequester(RPS("messageInfo","Information"),RPS("copyed","Le texte de la fenêtre principale est dans le presse-papier."))
        ;}
        
      Case #MENU_LDelete; Effacer les fichiers TNA locaux
        ;{
        SetGadgetText(#TexteEnTete,RPS("enteteldelete","SUPPRIMER LES FICHIERS LOCAUX"))
        SetGadgetText(#TexteSaisie,RPS("saisieldelete","Les fichiers de solution ne sont pas concernés par cet effacement."))
        Resultat=MessageRequester(RPS("messagewarning","Avertissement"),RPS("confirmdelete2","Êtes-vous sûr de vouloir supprimer les fichiers locaux ?"),#PB_MessageRequester_YesNo)
        If Resultat=6
          nbdelete=deleteLocal() 
          SetGadgetText(#TexteSaisie,RPS("localdeleteok","Les fichiers locaux suivants ont été supprimés :"))
          MainChaine$=RPS("nbofdele","Nombre de fichiers effacés :") + " "+ Str(nbdelete) + Chr(13) + Chr(13)+ MainChaine$
        Else
          SetGadgetText(#TexteSaisie,RPS("nolocaldelete","Aucun fichier supprimé"))
          MainChaine$=""
        EndIf
        SetGadgetText(#TextePrincipal,MainChaine$)  
        ;}
      Case #MENU_FDelete ; Effacer les fichiers TNA du serveur FTP
        ;{
        SetGadgetText(#TexteEnTete,RPS("entetefdelete","SUPPRIMER LES FICHIERS DU SERVEUR FTP"))
        SetGadgetText(#TexteSaisie,RPS("textconnexionwait","Connexion en cours ..."))
        Resultat=MessageRequester(RPS("messagewarning","Avertissement"),RPS("confirmdelete","Êtes-vous sûr de vouloir supprimer les fichiers TNA du serveur ?"),#PB_MessageRequester_YesNo)
        
        If Resultat=6
          If readFTPsettings()
            nbDeleted=deleteFiles() 
            MainChaine$=RPS("textedeleteok","Nombre de fichiers supprimés") + " : " + Str(nbDeleted) +Chr(13)+Chr(13)+MainChaine$
          Else
            MainChaine$=RPS("textftpviewok", "Fichier des paramètres FTP introuvable :") + " ftp_settings"
          EndIf
        Else
          SetGadgetText(#TexteSaisie,RPS("connectionrefused","Connexion non établie"))
          MainChaine$=RPS("nodelete","Demande de suppression non confirmée par l'utilisateur.")
        EndIf
        SetGadgetText(#TextePrincipal,MainChaine$)  
        SetMenuItemState(#MenuBar_0, #MENU_FDelete, 1) 
        DisableMenuItem(#MenuBar_0, #MENU_FUpload, 0)
        ;} 
      Case #MENU_Modify ; Changer les paramètres FTP
        ;{
        SetGadgetText(#TexteEnTete,RPS("enteteftpset", "MODIFICATION DES PARAMETRES FTP"))
        If readFTPsettings() 
          Resultat = CopyFile("ftp_settings", "ftp_settings.old") 
        EndIf
        If Resultat
          SetGadgetText(#TexteSaisie,RPS("settings_copied", "Le fichier de paramètres à été copié sous le nom :") + " ftp_settings.old")
        EndIf
        newserver$=InputRequester(RPS("messagesaisie","Saisie de données"),RPS("setservername","Entrez l'adresse du serveur FTP"),myServer.S )
        newuser$=InputRequester(RPS("messagesaisie","Saisie de données"),RPS("setusername","Entrez le login utilisateur"),myUser.S )
        newpass$=InputRequester(RPS("messagesaisie","Saisie de données"),RPS("setpassword","Entrez le password non crypté"),myPass2display$ )
        If setFTPsettings(newserver$, newuser$,newpass$)
          If readFTPsettings()
            MainChaine$=myServer.S + Chr(13)+myUser.S+ Chr(13)+  myPass2display$
          Else
            MainChaine$=RPS("textftpviewok", "Fichier des paramètres FTP introuvable : ") + " ftp_settings"
          EndIf 
          SetGadgetText(#TextePrincipal,MainChaine$)
        EndIf
        SetGadgetText(#TexteSaisie,RPS("textftpviewok", "Contenu du fichier") + " ftp_settings")
        
        SetGadgetText(#TextePrincipal,MainChaine$)
        ;}
      Case #MENU_ViewSettings ;Voir les paramètres FTP
        ;{
        SetGadgetText(#TexteEnTete,RPS("enteteftpview", "PARAMETRES FTP ACTUELS")) 
        SetGadgetText(#TexteSaisie,RPS("textftpviewok", "Contenu du fichier") + " ftp_settings")
        SetGadgetText(#TextePrincipal,"") 
        If readFTPsettings()
          MainChaine$=myServer.S + Chr(13)+myUser.S+ Chr(13)+  "encrypted pass : " + myPass2display$
        Else
          MainChaine$=RPS("textftpviewok", "Fichier des paramètres FTP introuvable : ") + " ftp_settings"
        EndIf 
        Debug myServer +myUser+ myPass
        SetGadgetText(#TextePrincipal,MainChaine$)
        ;}
      Case #MENU_FTPtest ;Test de Connexion FTP
        ;{
        SetGadgetText(#TexteEnTete,RPS("enteteftptest", "TEST DE CONNEXION FTP"))
        SetGadgetText(#TexteSaisie,RPS("textconnexionwait","Connexion en cours ..."))
        SetGadgetText(#TextePrincipal,"...")
        If readFTPsettings()
          If OpenFTP(#myftp, myServer, myUser,myPass)
            MainChaine$=RPS("textftpok","Test de connexion validé pour")+" "+myServer
            CloseFTP(#myftp)
          Else
            MainChaine$=RPS("textftpko","Connexion impossible avec")+" "+myServer
          EndIf
        Else
          MainChaine$=RPS("textftpko","Connexion impossible avec")+" "+myServer
        EndIf
        SetGadgetText(#TextePrincipal,MainChaine$)
        ;}
      Case #MENU_HFields
        ;{        
        Debug "#Menu_HFields"
        SetGadgetText(#TexteEnTete,RPS("entetehfields", "AIDE : LISTE DES CHAMPS ATTENDUS"))
        SetGadgetText(#TexteSaisie,RPS("saisieehfields", "Les champs obligatoires sont marqués d'une *")) 
        MainChaine$=RPS("hquestions","* Q1 à Q99 ou Q01 à Q99")+Chr(13)
        MainChaine$=MainChaine$+"* nom "+RPS("or","ou")+" lname" +Chr(13)
        MainChaine$=MainChaine$+"* prenom "+RPS("or","ou")+" fname"+Chr(13)
        MainChaine$=MainChaine$+"function"+Chr(13)
        MainChaine$=MainChaine$+"title"+Chr(13)
        MainChaine$=MainChaine$+"mail"+Chr(13)
        MainChaine$=MainChaine$+"phone"+Chr(13)
        MainChaine$=MainChaine$+"company"+Chr(13)
        MainChaine$=MainChaine$+"company_type"+Chr(13)
        MainChaine$=MainChaine$+"activity"+Chr(13)
        MainChaine$=MainChaine$+"employees"+Chr(13)
        MainChaine$=MainChaine$+"adress1"+Chr(13)
        MainChaine$=MainChaine$+"adress2"+Chr(13)
        MainChaine$=MainChaine$+"adress3"+Chr(13)
        MainChaine$=MainChaine$+"city"+Chr(13)
        MainChaine$=MainChaine$+"zip"+Chr(13)
        MainChaine$=MainChaine$+"product"
        
        SetGadgetText(#TextePrincipal,MainChaine$)
        
        ;} 
      Case #MENU_Helpme
        ;{
        SetGadgetText(#TexteEnTete,RPS("entetehelpme", "AIDE A L'UTILISATION")) 
        SetGadgetText(#TexteSaisie,RPS("saisiehelpme", "Voir aussi la liste des champs"))
        MainChaine$=RPS("help00","Le programme TNA.exe permet d'évaluer les réponses données à des tests")
        MainChaine$=MainChaine$+", "+RPS("help01","tests passés sur le web, et stockées sur un serveur FTP.")
        MainChaine$=MainChaine$+Chr(13)
        MainChaine$=MainChaine$+Chr(13)+RPS("help10","MODE D'EMPLOI")
        MainChaine$=MainChaine$+Chr(13)+RPS("help11","1.- Fichier -> Descendre les fichiers TNA")
        MainChaine$=MainChaine$+RPS("help12","    Spécifier depuis quelle date, pour ne pas tout télécharger.")
        MainChaine$=MainChaine$+Chr(13)+RPS("help13","2.- Fichier -> Traiter les TNA descendus")
        MainChaine$=MainChaine$+RPS("help14","    Spécifier depuis quelle date, pour ne pas tout traiter à nouveau.")
        MainChaine$=MainChaine$+Chr(13)+RPS("help15","3.- Fichier -> Enregistrer sous...")
        MainChaine$=MainChaine$+RPS("help16","    L'affichage présent des derniers fichiers traités sera sauvegardé sous un fichier texte.") 
        MainChaine$=MainChaine$+Chr(13)
        MainChaine$=MainChaine$+Chr(13)+RPS("help20","PRE-REQUIS")
        MainChaine$=MainChaine$+Chr(13)+RPS("help21","- Le fichier ftp_settings accompagnant le programme TNA.exe contient les identifiants")
        MainChaine$=MainChaine$+" "+RPS("help22","du serveur FTP : serveur, utilisateur, et mot de passe.")
        MainChaine$=MainChaine$+Chr(13)+RPS("help23","- Pour assurer la sécurité su serveur FTP, le mot de passe est crypté.")
        MainChaine$=MainChaine$+Chr(13)+RPS("help24","- Pour modifier les paramètres FTP, il faut passer par l'application, Menu 'FTP -> Modifier les paramètres'.") 
        MainChaine$=MainChaine$+Chr(13)+RPS("help240","- On peut tester les paramètres et la bonne santé du serveur par le menu  'FTP -> Tester la Connexion'.")
        MainChaine$=MainChaine$+Chr(13)+RPS("help25","- Les fichiers TNA à évaluer sont dans le répertoire ./tna du serveur FTP.")
        MainChaine$=MainChaine$+Chr(13)+RPS("help26","- Le répertoire depuis lequel TNA.exe est lancé doit contenir un sous-répertoire : treated")
        MainChaine$=MainChaine$+" "+RPS("help27","ainsi que les fichiers de solution des tests.")
        MainChaine$=MainChaine$+Chr(13)+RPS("help28","- Les fichiers TNA générés par l'outil Web et les fichiers de solution portent un nom particulier :")
        MainChaine$=MainChaine$+Chr(13)+RPS("help29","   - Pour les fichiers de test à  évaluer: prefixe + date + .txt")
        MainChaine$=MainChaine$+", "+RPS("help30","avec prefixe quelconque, date au format JJMM, et extention .txt obligatoire")
        MainChaine$=MainChaine$+Chr(13)+RPS("help31","   - Pour les fichiers de solution : prefixe + soluce + .txt")
        MainChaine$=MainChaine$+", "+RPS("help32","avec le même préfixe que le fichier à tester, le mot soluce en toutes lettres, et extention .txt obligatoire")
        MainChaine$=MainChaine$+Chr(13)
        MainChaine$=MainChaine$+Chr(13)+RPS("help33","Une telle nomenclature permet d'avoir plusieurs tests différents, puisque chacun a sa solution.")
        MainChaine$=MainChaine$+" "+RPS("help34","Il est donc indispensable que le générateur de ces fichiers par le web utilise cette nomenclature en sortie comme Nom de fichier.")
        MainChaine$=MainChaine$+Chr(13)+RPS("help35","- L'outil web ayant généré les fichiers de sortie doit utiliser le séparateur de champ | (pipe).")
        MainChaine$=MainChaine$+Chr(13)+RPS("help36","- Les réponses attendues sont sous forme d'un chiffre ou d'une lettre après le nom du champ.")
        MainChaine$=MainChaine$+Chr(13)+RPS("help37","   - exemple : Q1|A|Q2|5 ... ou bien Q01|A|Q02|B ... La lettre Q est en majuscule !")
        MainChaine$=MainChaine$+Chr(13)+RPS("help38","- De 1 à 99 questions sont possible, mais chaque réponse ne repose que sur 1 caractère.")   
        MainChaine$=MainChaine$+Chr(13)+RPS("help39","- La liste des autres champs traités est disponible sous le menu 'Aide -> Liste des Champs'.")
        MainChaine$=MainChaine$+Chr(13)
        MainChaine$=MainChaine$+Chr(13)+RPS("help40","GENERER LA SOLUTION")
        MainChaine$=MainChaine$+Chr(13)+RPS("help41","- Si les fichiers de solution n'existent pas localement, on peut les générer à partir d'un TNA.")
        MainChaine$=MainChaine$+" "+RPS("help42","Pour cela, il suffit de passer le TNA, en donnant toutes les bonnes réponses, en renseignant le champ 'nom' avec le mot 'solution', et en indiquant son prénom.")
        MainChaine$=MainChaine$+Chr(13)+RPS("help43","- Le traitement suivant des fichiers TNA proposera de créer un fichier solution à partir de ces réponses.")
        MainChaine$=MainChaine$+" "+RPS("help44","Et tout traitement à venir utilisera ces nouvelles réponses.")
        MainChaine$=MainChaine$+Chr(13)
        MainChaine$=MainChaine$+Chr(13)+RPS("help50","MAINTENANCE ET NETTOYAGE")
        MainChaine$=MainChaine$+Chr(13)+RPS("help51","- Le Menu 'FTP -> Supprimer les fichiers du serveur FTP' permet de faire le ménage sur le serveur.")
        MainChaine$=MainChaine$+" "+RPS("help52","Si cela n'est pas fait de temps en temps, les fichiers TNA vont s'accumuler, et seront ré-évalués à chaque fois.")
        MainChaine$=MainChaine$+Chr(13)+RPS("help53","Attention ! Tous les fichiers du répertoire ./tna du serveur FTP seront supprimés !")
        MainChaine$=MainChaine$+" "+RPS("help54","Si on souhaite faire machine arrière, on peut toujours remonter les fichiers que l'on avait déjà descendus par le menu :")
        MainChaine$=MainChaine$+" "+RPS("help55","'FTP -> Remonter les fichiers ...' qui n'est accessible qu'après effacement.")
        MainChaine$=MainChaine$+" "+RPS("help56","Dans ce cas, tous les fichiers locaux du répertoire ./treated sont envoyés vers le répertoire ./tna du serveur FTP.")
        MainChaine$=MainChaine$+Chr(13)+RPS("help57","- Le Menu 'Fichier -> Supprimer les fichiers locaux' permet d'effacer tous les TNA présents dans le répertoire ./treated local.")
        MainChaine$=MainChaine$+Chr(13)+RPS("help58","Attention ! Si d'autres fichiers que les TNA sont dans ce répertoires, ils seront aussi supprimés !")
        SetGadgetText(#TextePrincipal,MainChaine$)
        ;}
      Case #MENU_HAbout
        ;{
        SetGadgetText(#TexteEnTete,RPS("enteteapropos", "A PROPOS DE TNA ...")) 
        SetGadgetText(#TexteSaisie,RPS("by", "par")+" ")
        MainChaine$="TNA"+Chr(13)+"v 1.1"+Chr(13)+ "26 05 2009"
        SetGadgetText(#TextePrincipal,MainChaine$)
        ;}
      Case #MENU_Quit ;Choix du menu Quitter
        ;{
        SetGadgetText(#TextePrincipal,"")
        End 
        ;}
      Default ;Effacer le texte principal
        ;{
        
    EndSelect
    ;}
  EndIf
  ;}
Until EventID = #PB_Event_CloseWindow
;}


; IDE Options = PureBasic 4.30 (Windows - x86)
; CursorPosition = 494
; FirstLine = 142
Dernière modification par kerkael le sam. 22/août/2009 23:04, modifié 5 fois.
kerkael
Messages : 97
Inscription : mer. 03/sept./2008 21:08

Message par kerkael »

Fichier 2/5 - TNA_menu.pb - 45 lignes

Code : Tout sélectionner

Enumeration
  #MENU_File
  #MENU_FDownload
  #MENU_FTreat
  #MENU_FSaveas
  #MENU_Copy  
  #MenuBar_0
  #MENU_Quit
  #MENU_LDelete 
  #MENU_FTP
  #MENU_ViewSettings
  #MENU_Modify 
  #MENU_FTPtest
  #MENU_FDelete
  #MENU_FUpload 
  #MENU_Help
  #MENU_Helpme
  #MENU_HAbout
  #MENU_HFields
  
EndEnumeration

Procedure affiche_menu()
  MenuTitle(ReadPreferenceString("File", "Fichier"))
  MenuItem(#MENU_FDownload, ReadPreferenceString("Download", "Descendre les fichiers TNA"))
  MenuItem(#MENU_FTreat, ReadPreferenceString("ftreat", "Traiter les TNA descendus"))
  MenuItem(#MENU_FSaveas, ReadPreferenceString("Saveas", "Enregistrer sous..."))
  MenuItem(#MENU_Copy, ReadPreferenceString("copy", "Copier vers le Presse-papier..."))
  MenuBar()
  MenuItem(#MENU_LDelete, ReadPreferenceString("ldelete", "Supprimer les fichiers locaux !"))
  MenuBar()
  MenuItem(#MENU_Quit, ReadPreferenceString("Quit", "Quitter"))
  MenuTitle("FTP")
  MenuItem(#MENU_ViewSettings, ReadPreferenceString("FTPView", "Voir les Paramètres"))
  MenuItem(#MENU_FTPtest, ReadPreferenceString("FTPTest", "Tester la Connexion"))
  MenuItem(#MENU_Modify, ReadPreferenceString("FTPSet", "Modifier les Paramètres"))
  MenuBar()
  MenuItem(#MENU_FDelete, ReadPreferenceString("FDelete", "Supprimer les fichiers du serveur FTP !"))
  MenuItem(#MENU_FUpload, ReadPreferenceString("FUpload", "Remonter les fichiers vers le serveur FTP !")) 
  MenuTitle(ReadPreferenceString("Help", "Aide"))
  MenuItem(#MENU_Helpme, ReadPreferenceString("Helpme", "Aide..."))
  MenuItem(#MENU_HFields, ReadPreferenceString("Fields", "Liste des Champs"))
  MenuBar()
  MenuItem(#MENU_HAbout, ReadPreferenceString("About", "A Propos de TNA"))
EndProcedure
kerkael
Messages : 97
Inscription : mer. 03/sept./2008 21:08

Message par kerkael »

Fichier 3/5 - TNA_treatment.pb 249 lignes
Global Dim Q.S(1,99) ;tableau des questions 1 à 99 du fichier 0, soluce et du fichier 1, traité

Global isdebug=1

Procedure deb(thatstringtodebug$)
   If isdebug
     Debug thatstringtodebug$
   EndIf
EndProcedure


Macro CeChampSoluce(CetteChaine)
  CettePosition.w= findstring (MesLignesDeSoluce.S(),CetteChaine,1)
   If CettePosition
    FinDeChamp.w=CettePosition+ len (CetteChaine)
    FinDeReponse.w= findstring (MesLignesDeSoluce.S(), "|" ,FinDeChamp)
    LongueurDeReponse=FinDeReponse-FinDeChamp
    CetteReponse.S= rtrim ( ltrim ( mid (MesLignesDeSoluce.S(),FinDeChamp.w,LongueurDeReponse)))
   Else
    CetteReponse= ""
   EndIf
EndMacro



Procedure OpenSoluce(where$,prefixe.S) ;réference les solutions de Q.S(0,?) d'après un fichier *soluce.txt
  NewList MesLignesDeSoluce.S()
   setcurrentdirectory (where$)
   If readfile ( #myfile , prefixe.S+ "soluce.txt" )
     While eof ( #myfile ) = 0
       addelement (MesLignesDeSoluce.S())
      MesLignesDeSoluce.S()= readstring ( #myfile )
       ;MessageRequester("Solution de "+prefixe,MesLignesDeSoluce.s())
       For questions=1 To 9
        LaChaine.S= "Q" + str (questions)+ "|" ; si les questions 1 à 9 sont nommées Q1 à Q9
        LaPosition.w= findstring (MesLignesDeSoluce.S(),LaChaine,1)
         If Not LaPosition
          LaChaine.S= "Q0" + str (questions)+ "|" ; sinon si les questions 1 à 9 sont nommées Q01 à Q09
          LaPosition.w= findstring (MesLignesDeSoluce.S(),LaChaine,1)
         EndIf
         If LaPosition
          CeChampSoluce(LaChaine)
          deb ( "CetteSoluce=" + CetteReponse)
          Q.S(0,questions)=CetteReponse
         Else
          Q.S(0,questions)= "None"
         EndIf
       Next
       For questions=10 To 99
        LaChaine.S= "Q" + str (questions)+ "|"
        LaPosition.w= findstring (MesLignesDeSoluce.S(),LaChaine,1)
         If LaPosition
          CeChampSoluce(LaChaine)
          deb ( "CetteSoluce=" + CetteReponse)
          Q.S(0,questions)=CetteReponse
         Else
          Q.S(0,questions)= "None"
         EndIf
       Next
      nbreponses=0
       For questions=1 To 99
         If Q.S(0,questions)<> "None"
          nbreponses=nbreponses+1
         EndIf
       Next
     Wend
     closefile ( #myfile )
   Else
     messagerequester ( readpreferencestring ( "messageinfo" , "Information" ), readpreferencestring ( "noopen" , "Impossible d'ouvrir le fichier :" )+ " " +prefixe.S+ "soluce.txt" )
   EndIf
   Debug "prefixe : " + prefixe + " ; nbreponses <> None : " + str (nbreponses)
   ProcedureReturn nbreponses
EndProcedure

Macro CeChamp(CetteChaine)
  CettePosition.w= findstring (MesLignes.S(),CetteChaine,1)
   If CettePosition
    FinDeChamp.w=CettePosition+ len (CetteChaine)
    FinDeReponse.w= findstring (MesLignes.S(), "|" ,FinDeChamp)
    LongueurDeReponse=FinDeReponse-FinDeChamp
    CetteReponse.S= rtrim ( ltrim ( mid (MesLignes.S(),FinDeChamp.w,LongueurDeReponse)))
     Select CetteReponse
       Case "inconnu" , "Inconnu" , "---" , "----" , "autre" , "autres" , "Autre" , "Autres"
        CetteReponse= ""
     EndSelect
   Else
    CetteReponse= ""
   EndIf
EndMacro


Procedure ReadLocale(where$,QuelPrefixe.S,maxQuestions.l)
  NewList MesLignes.S()
   setcurrentdirectory (where$)
  
   If examinedirectory ( #mylocaldir , where$, QuelPrefixe.S+ "*.txt" )
     While nextdirectoryentry ( #mylocaldir )
       If directoryentrytype ( #mylocaldir ) = #PB_DirectoryEntry_File
        LeFichier.S= directoryentryname ( #mylocaldir )
        CeSuffixe$= mid (LeFichier.S, len (LeFichier.S)-7,4)
        sjour$= left (CeSuffixe$,2)
        smois$= right (CeSuffixe$,2)
        MaDate.l = val (smois$)*100+ val (sjour$)
         If MaDate>=suffixe
           If readfile ( #myfile , LeFichier.S) ; Si le fichier peut être lu , on continue...
             While eof ( #myfile ) = 0 ; Boucle tant que la fin du fichier n'est pas atteinte. (Eof = 'End Of File')
               addelement (MesLignes()) ; Chaque ligne est un utilisateur testé
              MesLignes()= readstring ( #myfile )
              CeChamp( "prenom|" )
               If CetteReponse= ""
                CeChamp( "fname|" )
               EndIf
              Prenom.S=CetteReponse
              CeChamp( "|nom|" )
               If CetteReponse= ""
                CeChamp( "lname|" )
               EndIf
              Nom.S= ucase (CetteReponse)
               If Nom.S= "SOLUTION"
                NewSolution= messagerequester ( readpreferencestring ( "titlenewsolution" , "Nouvelle Solution" ),Prenom.S+ " " + readpreferencestring ( "textenewsolution" , "propose une nouvelle solution pour" )+ " " +QuelPrefixe, #PB_MessageRequester_YesNo )
                 ;{
                 If NewSolution=6
                   If renamefile (where$+ "..\" +QuelPrefixe.S+ "soluce.txt" ,where$+ "..\" +QuelPrefixe.S+ "soluce_du" + " " + str ( dayofyear ( date ))+ ".txt" )
                    copyedSoluceFile= messagerequester ( readpreferencestring ( "messageinfo" , "Information" ), readpreferencestring ( "solucebkp1" , "Le fichier" )+ " " + QuelPrefixe.S+ "soluce.txt " + readpreferencestring ( "solucebkp2" , "a été renommé en" ) + " " + QuelPrefixe.S+ "soluce_du_" + str ( dayofyear ( date ))+ ".txt" )
                   EndIf
                   Debug where$+ "..\" +QuelPrefixe.S+ "soluce.txt"
                   If createfile ( #myotherfile ,where$+ "..\" +QuelPrefixe.S+ "soluce.txt" )
                     Debug "fichier créé"
                     writestringn ( #myotherfile , MesLignes())
                    newSoluceFile= messagerequester ( readpreferencestring ( "messageinfo" , "Information" ), readpreferencestring ( "newfile" , "Il y a un nouveau fichier de solution :" )+ " " + QuelPrefixe.S+ "soluce.txt" )
                     closefile ( #myotherfile )
                     Debug "fichier fermé"
                   Else
                     messagerequester ( "Warning" , "Impossible de créer le fichier :" + " " +where$+ "..\" +QuelPrefixe.S+ "soluce.txt" )
                   EndIf
                EndIf ;}
               EndIf
              CeChamp( "function|" )
              Function.S=CetteReponse
               If CetteReponse<> ""
                Function.S= readpreferencestring ( "function" , "Fonction:" )+Function.S
               EndIf
              CeChamp( "title|" )
              Title.S=CetteReponse
               If CetteReponse<> ""
                Title.S= readpreferencestring ( "title" , "Titre:" )+Title.S
               EndIf
              CeChamp( "mail|" )
              Mail.S= trim (CetteReponse)
              CeChamp( "phone|" )
              Phone.S=CetteReponse
               If CetteReponse<> ""
                Phone.S= readpreferencestring ( "phone" , "Tél:" )+ "(" +Phone.S+ ")"
               EndIf
              CeChamp( "company|" )
              Company.S=CetteReponse
               If CetteReponse<> ""
                Company.S= readpreferencestring ( "company" , "Société:" )+Company.S
               EndIf
              CeChamp( "company_type|" )
              CompanyType.S=CetteReponse
              CeChamp( "activity|" )
              Activity.S=CetteReponse
               If CetteReponse<> ""
                Activity.S= readpreferencestring ( "activity" , "Activité:" )+Activity.S
               EndIf
              CeChamp( "employees|" )
              Employees.S=CetteReponse
               If Employees.S<> ""
                Employees.S=Employees+ " " + readpreferencestring ( "empl" , "employés" )
               EndIf
              CeChamp( "adress1|" )
              Adress1.S=CetteReponse
              CeChamp( "adress2|" )
              Adress2.S=CetteReponse
              CeChamp( "adress3|" )
              Adress3.S=CetteReponse
              CeChamp( "city|" )
              City.S=CetteReponse
              CeChamp( "zip|" )
              Zip.S=CetteReponse
              CeChamp( "product|" )
              Product.S=CetteReponse
               If Product.S<> ""
                Product.S= readpreferencestring ( "product" , "Utilisant le produit" )+ " : " +Product.S
               EndIf
              CeChamp( "country|" )
              Country.S=CetteReponse
              LaDate.S= mid (LeFichier.S, len (QuelPrefixe.S)+1,4)
              LeTest.S= left (QuelPrefixe.S, len (QuelPrefixe)-1)
              LeScore.l=0
               ;{
               For questions=1 To 9
                LaChaine.S= "Q" + str (questions)+ "|" ; si les questions 1 à 9 sont nommées Q1 à Q9
                LaPosition.w= findstring (MesLignes.S(),LaChaine,1)
                 If Not LaPosition
                  LaChaine.S= "Q0" + str (questions)+ "|" ; sinon si les questions 1 à 9 sont nommées Q01 à Q09
                  LaPosition.w= findstring (MesLignes.S(),LaChaine,1)
                 EndIf
                 If LaPosition
                  CeChamp(LaChaine)
                  Q.S(1,questions)=CetteReponse
                  deb ( "Q" + str (questions)+ " Reponse: " + Q.S(1,questions) + "/" +Q.S(0,questions)+ " :Soluce" )
                   If Q.S(1,questions)=Q.S(0,questions)
                    LeScore.l+1
                   EndIf
                 Else
                  Q.S(1,questions)= ""
                 EndIf
               Next
               For questions=10 To 99
                LaChaine.S= "Q" + str (questions)+ "|"
                LaPosition.w= findstring (MesLignes.S(),LaChaine,1)
                 If LaPosition
                  CeChamp(LaChaine)
                  Q.S(1,questions)=CetteReponse
                  deb ( "Q" + str (questions)+ " Reponse: " + Q.S(1,questions) + "/" +Q.S(0,questions)+ " :Soluce" )
                   If Q.S(1,questions)=Q.S(0,questions)
                    LeScore.l+1
                   EndIf
                 Else
                  Q.S(1,questions)= ""
                 EndIf
               Next
               ;}
              LeVraiScore.f=LeScore.l/maxQuestions.l*100
              deb( "Bonnes Reponses : " + str (LeScore)+ " / Nb de Questions : " + str (maxQuestions))
              deb( "%age de succès : " + str (LeVraiScore))
               ;{
               If Nom.S<> "" Or Prenom.S<> ""
                
                Nom.S= " " +Nom.S
                MainChaine$=MainChaine$+ str (LeVraiScore.f)+ "% ," +LeTest.S+ "," +LaDate.S + ","
                MainChaine$=MainChaine$+Prenom.S+Nom.S+ "," +Mail.S+ "," +Phone.S+ " ," +Function.S+ "," +Title.S
                MainChaine$=MainChaine$+ "," +CompanyType.S+ "," +Activity.S+ "," +Employees+ "," +Product.S
                MainChaine$=MainChaine$+ " ," +Company.S+ "," +Adress1.S+ "," +Adress2.S+ "," +Adress3+ "," +City.S+ "," +Zip.S+ "," +Country.S+ chr (13)
              EndIf ;}
             Wend
             closefile ( #myfile ) ; Ferme le fichier précédemment ouvert
           Else
             messagerequester ( "Information" , "Impossible d'ouvrir le fichier : " +LeFichier.S)
           EndIf
          
           clearlist (MesLignes()) ; on efface MesLignes pour le fichier suivant
         EndIf
       Else
         messagerequester ( "Information" ,LeFichier.S + " n'est pas un fichier !" )
       EndIf
      
     Wend
    
   EndIf
  
  
EndProcedure

Procedure FindPrefixe(here$)
  NewList MesPrefixes.S()
  NewList MesFichiers.S()
  LeRepertoire$=here$+ "treated\"
   setcurrentdirectory (LeRepertoire$)
   If examinedirectory ( #mylocaldir , LeRepertoire$, "*.txt" )
     While nextdirectoryentry ( #mylocaldir )
       If directoryentrytype ( #mylocaldir ) = #PB_DirectoryEntry_File
         addelement (MesFichiers()) ;cree la liste des fichiers à traiter
        MesFichiers()= directoryentryname ( #mylocaldir )
       EndIf
     Wend
     sortlist (MesFichiers(), #PB_Sort_Ascending ) ;trie la liste des fichiers pour regrouper les prefixes
     ForEach MesFichiers()
      MonPrefixe.S= left (MesFichiers(), len (MesFichiers())-8 )
       If ListSize(MesPrefixes())=0
         addelement (MesPrefixes()) ;cree la liste des différents prefixes des fichiers à traiter
        MesPrefixes()=MonPrefixe.S
       ElseIf MonPrefixe.S<>MesPrefixes()
         addelement (MesPrefixes())
        MesPrefixes()=MonPrefixe.S
       EndIf
     Next
    nbPrefixes.b=ListSize(MesPrefixes())
     finishdirectory ( #mylocaldir )
   EndIf
  
   ForEach MesPrefixes() ;pour chaque préfixe de fichier
    MonPrefixe.S=MesPrefixes()
    nbQuestions.w=OpenSoluce(here$,MonPrefixe.S) ;on appelle la boucle qui crée le tableau de solution
     ; on en récupère le Nb de questions pour cette soluce
    ReadLocale(LeRepertoire$,MonPrefixe.S,nbQuestions.w) ;on va traiter les fichiers ayant ce prefixe
   Next
  
EndProcedure


Dernière modification par kerkael le mar. 26/mai/2009 8:42, modifié 1 fois.
kerkael
Messages : 97
Inscription : mer. 03/sept./2008 21:08

Message par kerkael »

Fichier 4/5 - TNA_saveas.pb 146 lignes

Procedure saveFileas(dequoi$)
   hidewindow ( #Window_0 ,1)
   Debug dequoi$
  backupOK=0
Structure ftype
  intitule.s
  format.s
  formatpref.s
EndStructure

;{ Définitions;
Dim myCBGchoice.ftype(4)
myCBGchoice(0)\intitule= "CSV (délimité par virgule) (*.csv)"
myCBGchoice(0)\format= "*.csv"
myCBGchoice(0)\formatpref= ".csv"
myCBGchoice(1)\intitule= "Page Web (*.htm; *.html)"
myCBGchoice(1)\format= "*.htm;*.html"
myCBGchoice(1)\formatpref= ".htm"
myCBGchoice(2)\intitule= "Fichiers texte (*.txt; *.text)"
myCBGchoice(2)\format= "*.txt;*.text"
myCBGchoice(2)\formatpref= ".txt"
myCBGchoice(3)\intitule= readpreferencestring ( "allfiles" , "Tous les fichiers" )
myCBGchoice(3)\format= "*.*"
myCBGchoice(3)\formatpref= ""
;}

largeur=430
If openwindow ( #Window_saveas , 0, 0, largeur, 360, readpreferencestring ( "Saveas" , "Enregistrer sous" ), #PB_Window_ScreenCentered )
   ;{ Installation des gadgets
  myECG= explorercombogadget ( #PB_Any ,10,10,240,25, getcurrentdirectory ())
  myETG= explorertreegadget ( #PB_Any ,10,45,largeur-20,250, getcurrentdirectory ())
  myTGfile= textgadget ( #PB_Any ,10,305,90,20, readpreferencestring ( "filename" , "Nom du fichier :" ))
  mySGfile= stringgadget ( #PB_Any ,110,300,largeur-220 ,20, "FileName" )
  myBGsave= buttongadget ( #PB_Any ,largeur-90,300,80,20, readpreferencestring ( "Save" , "Enregistrer" ))
  myTGtype= textgadget ( #PB_Any ,10,330,100,20, "Type :" )
  myCBG= comboboxgadget ( #PB_Any ,110,325,largeur-220 ,20)
  myBGcancel= buttongadget ( #PB_Any ,largeur-90,325,80,20, readpreferencestring ( "Cancel" , "Annuler" ))
   For dumpvar=0 To 3
     addgadgetitem (myCBG, dumpvar, myCBGchoice(dumpvar)\intitule)
   Next
   setgadgetstate (myCBG,3)
   ;}
  
   ;{ Boucle Principale
   Repeat
    EventID = waitwindowevent ()
     If eventwindow () = #Window_saveas
     Select EventID
       Case #PB_Event_CloseWindow
        Quitter=1
       Case #PB_Event_Gadget
       Select eventgadget ()
         Case myECG ;si on change le repertoire depuis l'ExploCombo
           ;{
           Select eventtype ()
             Case #PB_EventType_LeftClick
              dumpvar= getgadgetstate (myCBG) ;quel choix de type de fichier depuis le ComboBox
              mytype$=myCBGchoice( getgadgetstate (myCBG))\format ;on récupère le type de fichier depuis le tableau
              mydir$= getgadgettext (myECG) ;on récupère le repertoire depuis l'ExploCombo
              myfulldir$=mydir$+mytype$ ;association repertoire + extension
               setgadgettext (myETG,mydir$)
           EndSelect
           ;}
          
         Case myCBG ; si on change le type de fichier depuis ComboBox
           ;{
          dumpvar= getgadgetstate (myCBG) ;quel choix de type de fichier depuis le ComboBox
          mytype$=myCBGchoice( getgadgetstate (myCBG))\format ;on récupère le type de fichier depuis le tableau
           If getgadgetstate (myETG)=2
            mydir$= getgadgettext (myETG) ;on récupère le repertoire depuis l'ExploCombo
           Else
            mydir$= getpathpart ( getgadgettext (myETG))
           EndIf
          myfulldir$=mydir$+mytype$ ;association repertoire + extension
           setgadgettext (myETG,myfulldir$) ;Change l'affichage de l'explorerListGadget avec la bon repertoire et la bonne extension
           ;}
          
         Case myETG
           ;{
           Select eventtype ()
             Case #PB_EventType_LeftClick
               If getgadgetstate (myETG)=1
                myfilename$= getfilepart ( getgadgettext (myETG))
               Else
                myfilename$= ""
                 setgadgettext (myECG, getpathpart ( getgadgettext (myETG)))
               EndIf
               setgadgettext (mySGfile,myfilename$)
           EndSelect
           ;}
          
         Case myBGcancel
           ;{
           hidewindow ( #Window_0 ,0)
          Quitter=1
           ;}
          
         Case myBGsave
           ;{ saveas
          myfilename$= getgadgettext (mySGfile)
          mypathname$= getgadgettext (myECG)
          myfilepart$= trim ( getfilepart (myfilename$))
           If Not findstring (myfilepart$, "*" ,0)
             If Not findstring (myfilepart$, "?" ,0)
               If Not findstring (myfilepart$, ";" ,0)
                 If Not findstring (myfilepart$, "|" ,0)
                   If Not findstring (myfilepart$, ":" ,0)
                    myExtensionpart$= getextensionpart (myfilename$)
                     Debug myExtensionpart$
                     Select myExtensionpart$
                       Case "" , "."
                        dumpvar= getgadgetstate (myCBG) ;quel choix de type de fichier depuis le ComboBox
                        myExtensionpart$=myCBGchoice( getgadgetstate (myCBG))\formatpref ;on récupère le type de fichier depuis le tableau
                         Debug myfilepart$ + " " + myExtensionpart$
                       Default
                        myfilepart$= left (myfilepart$, len (myfilepart$)- len (myExtensionpart$))
                         Debug myfilepart$ + " " + myExtensionpart$
                     EndSelect
                     If myfilepart$<> ""
                      myfilename$=mypathname$+myfilepart$+ myExtensionpart$
                       Debug myfilename$
                       If createfile ( #thatfile ,myfilename$)
                         writestring ( #thatfile ,dequoi$)
                         closefile ( #thatfile )
                         messagerequester ( readpreferencestring ( "messageinfo" , "Information" ), readpreferencestring ( "saveasok" , "Fichier sauvegardé :" )+ chr (13)+myfilename$ )
                         hidewindow ( #Window_0 ,0)
                        Quitter=1
                       Else
                         messagerequester ( readpreferencestring ( "messagewarning" , "Avertissement" ), readpreferencestring ( "nosaveas" , "Sauvegarde impossible !" ))
                       EndIf
                     EndIf
                   EndIf
                 EndIf
               EndIf
             EndIf
           EndIf
           ;}
       EndSelect
   EndSelect
EndIf
Until Quitter
   
closewindow ( #Window_saveas )
   
EndIf
EndProcedure
Dernière modification par kerkael le mar. 26/mai/2009 8:43, modifié 1 fois.
kerkael
Messages : 97
Inscription : mer. 03/sept./2008 21:08

Message par kerkael »

Fichier 5/5 - langues.pref - 165 lignes


[FR]
About=A Propos de TNA
activity=Activité:
allfiles=Tous les fichiers
by=par
Cancel=Annuler
company=Société:
confirmdelete=Êtes-vous sûr de vouloir supprimer les fichiers TNA du serveur ?
confirmdelete2=Êtes-vous sûr de vouloir supprimer les fichiers locaux ?
copy=Copier vers le Presse-papier...
copyed=Le texte de la fenêtre principale est dans le presse-papier.
de=de
Download=Descendre les fichiers TNA
du=du
empl=employés
enteteapropos=A PROPOS DE TNA ...
entetedownload=TELECHARGEMENT DES FICHIERS TNA DEPUIS LE ...
entetefdelete=SUPPRIMER LES FICHIERS TNA DU SERVEUR FTP
enteteftpset=MODIFICATION DES PARAMETRES FTP
enteteftptest=TEST DE CONNEXION FTP
enteteftpview=PARAMETRES FTP ACTUELS
enteteftreat=TRAITER LES FICHIERS TNA DESCENDUS LOCALEMENT DEPUIS LE ...
entetehelpme=AIDE A L'UTILISATION
enteteldelete=SUPPRIMER LES FICHIERS LOCAUX
entetesaveas=SAUVEGARDER LES RESULTATS VERS UN FICHIER
enteteupload=CHARGER DES FICHIERS SUR LE SERVEUR FTP
FDelete=Supprimer les fichiers du serveur FTP !
Fields=Liste des Champs
filename=Nom du fichier :
FTPSet=Modifier les Paramètres FTP
FTPTest=Tester la Connexion
FTPView=Voir les Paramètres FTP
ftreat=Traiter les TNA descendus
function=Fonction:
FUpload=Remonter les fichiers vers le serveur FTP !
Help=Aide
Helpme=Aide...
hquestions=* Q1 à Q99 ou Q01 à Q99
jour=jour
Language=Langue
ldelete=Supprimer les fichiers locaux !
localdeleteok=Les fichiers locaux suivants ont été supprimés :
messageinfo=Information
messagewarning=Avertissement
mois=mois
nbofdele=Nombre de fichiers effacés :
newfile=Il y a un nouveau fichier de solution :
noconnexion=Connexion impossible !
nodelete=Demande de suppression non confirmée par l'utilisateur.
nodeletion=Fichier impossible à effacer
nolocaldelete=Aucun fichier supprimé
noopen=Impossible d'ouvrir le fichier :
nosaveas=Sauvegarde impossible !
or =ou
phone=Tél:
product=Utilisant le produit
Quit=Quitter
saisiehelpme=Voir aussi la liste des champs
saisieldelete=Les fichiers de solution ne sont pas concernés par cet effacement.
saisiesaveas=Le fichier peut être sauvé sous format .csv pour traitement par excel
saisieupload=Depuis le répertoire .\treated
Save=Enregistrer
Saveas=Enregistrer sous...
saveasok=Fichier sauvegardé :
solucebkp1=Le fichier
solucebkp2=a été renommé en
textconnexionwait=Connexion en cours ...
textedeleteok=Nombre de fichiers supprimés
textedownloadok=Fichiers correctement téléchargés
textedownloadwait=Veuillez patienter le temps du téléchargement ...
textenewsolution=propose une nouvelle solution pour
textftpko=Connexion impossible avec
textftpok=Test de connexion validé pour
textftpviewok=Contenu du fichier :
textftpviewok=Fichier des paramètres FTP introuvable :
title=Titre:
to

help00=Le programme TNA.exe permet d'évaluer les réponses données à des tests
help01=tests passés sur le web, et stockées sur un serveur FTP.
help10=MODE D'EMPLOI
help11=1.- Fichier -> Descendre les fichiers TNA
help12= Spécifier depuis quelle date , pour ne pas tout télécharger.
help13=2.- Fichier -> Traiter les TNA descendus
help14= Spécifier depuis quelle date , pour ne pas tout traiter à nouveau.
help15=3.- Fichier -> Enregistrer sous...
help16= L'affichage présent des derniers fichiers traités sera sauvegardé sous un fichier texte.
help20=PRE-REQUIS
help21=- Le fichier ftp_settings accompagnant le programme TNA.exe contient les identifiants
help22=du serveur FTP : serveur, utilisateur, et mot de passe.
help23=- Pour assurer la sécurité su serveur FTP, le mot de passe est crypté.
help24=- Pour modifier les paramètres FTP, il faut passer par l'application, Menu 'FTP -> Modifier les paramètres'.
help240=- On peut tester les paramètres et la bonne santé du serveur par le menu 'FTP -> Tester la Connexion'.
help25=- Les fichiers TNA à évaluer sont dans le répertoire ./tna du serveur FTP.
help26=- Le répertoire depuis lequel TNA.exe est lancé doit contenir un sous-répertoire : treated
help27=ainsi que les fichiers de solution des tests.
help28=- Les fichiers TNA générés par l'outil Web et les fichiers de solution portent un nom particulier :
help29= - Pour les fichiers de test à évaluer: prefixe + date + .txt
help30=avec prefixe quelconque, date au format JJMM, et extention .txt obligatoire
help31= - Pour les fichiers de solution : prefixe + soluce + .txt
help32=avec le même préfixe que le fichier à tester, le mot soluce en toutes lettres, et extention .txt obligatoire
help33=Une telle nomenclature permet d'avoir plusieurs tests différents, puisque chacun a sa solution.
help34=Il est donc indispensable que le générateur de ces fichiers par le web utilise cette nomenclature en sortie comme Nom de fichier.
help35=- L'outil web ayant généré les fichiers de sortie doit utiliser le séparateur de champ | (pipe).
help36=- Les réponses attendues sont sous forme d'un chiffre ou d'une lettre après le nom du champ.
help37= - exemple : Q1|A|Q2|5 ... ou bien Q01|A|Q02|B ... La lettre Q est en majuscule !
help38=- De 1 à 99 questions sont possible, mais chaque réponse ne repose que sur 1 caractère.
help39=- La liste des autres champs traités est disponible sous le menu 'Aide -> Liste des Champs'.
help40=GENERER LA SOLUTION
help41=- Si les fichiers de solution n'existent pas localement, on peut les générer à partir d'un TNA.
help42=Pour cela, il suffit de passer le TNA, en donnant toutes les bonnes réponses, en renseignant le champ 'nom' avec le mot 'solution', et en indiquant son prénom.
help43=- Le traitement suivant des fichiers TNA proposera de créer un fichier solution à partir de ces réponses.
help44=Et tout traitement à venir utilisera ces nouvelles réponses.
help50=MAINTENANCE ET NETTOYAGE
help51=- Le Menu 'FTP -> Supprimer les fichiers du serveur FTP' permet de faire le ménage sur le serveur.
help52=Si cela n'est pas fait de temps en temps, les fichiers TNA vont s'accumuler, et seront ré-évalués à chaque fois.
help53=Attention ! Tous les fichiers du répertoire ./tna du serveur FTP seront supprimés !
help54=Si on souhaite faire machine arrière, on peut toujours remonter les fichiers que l'on avait déjà descendus par le menu :
help55='FTP -> Remonter les fichiers ...' qui n'est accessible qu'après effacement.
help56=Dans ce cas, tous les fichiers locaux du répertoire ./treated sont envoyés vers le répertoire ./tna du serveur FTP.
help57=- Le Menu 'Fichier -> Supprimer les fichiers locaux' permet d'effacer tous les TNA présents dans le répertoire ./treated local.
help58=Attention ! Si d'autres fichiers que les TNA sont dans ce répertoires, ils seront aussi supprimés !

[EN]
About=About TNA
activity=Activity:
allfiles=All Files
by=by
Cancel=Cancel
company=Company:
confirmdelete=Are you sure you want to delete TNA files from the FTP server ?
confirmdelete2=Do you confirm you want to delete local files ?
copy=Copy to ClipBoard
copyed=The text from main window is now in the clipboard.
de=of
Download=Download TNA files
du=on
empl=employees
enteteapropos=ABOUT TNA ...
entetedownload=DOWNLOAD TNA FILES SINCE ...
entetefdelete=DELETE TNA FILES FROM FTP SERVER
enteteftpset=MODIFYING FTP SETTINGS
enteteftptest=FTP CONNECTION TEST
enteteftpview=CURRENT FTP SETTINGS
enteteftreat=TREAT LOCALY DOWNLOADED TNA FILES SINCE ...
entetehelpme=HELP ON USAGE
enteteldelete=DELETE LOCAL FILES
entetesaveas=SAVE RESULTS INTO A FILE
enteteupload=UPLOAD TNA FILES BACK TO THE SERVER
FDelete=Delete files from FTP server !
Fields=Fields List
filename=File name :
FTPSet=Modify FTP Settings
FTPTest=Test Connection
FTPView=View FTP Settings
ftreat=Treat downloaded TNA
function=Function:
FUpload=Upload files back to the FTP server !
Help=Help
Helpme=Help...
hquestions=* Q1 To Q99 Or Q01 To Q99
jour= day
Language=Language
ldelete=Delete local files !
localdeleteok=Following local files have been deleted :
messageinfo=Information
messagewarning=Warning
mois= month
nbofdele=Number of deleted files :
New = New
newfile=There is a new solution file :
noconnexion=No Connection !
nodelete=Deletetion not confirmed by user.
nodeletion=File impossible to delete
nolocaldelete=No local file has been deleted
noopen=Impossible to open file :
nosaveas=File impossible to save !
or = or
phone=Phone:
product=Using product
Quit=Quit
saisiehelpme=See fields List too
saisieldelete=Solution files are Not concerned by this deletion.
saisiesaveas=The file can be saved in .csv format For treatment by excel
saisieupload=from directory .\treated
Save=Save
Saveas=Save As
saveasok=File successfully saved :
solucebkp1=The file
solucebkp2=has been renamed in
textconnexionwait=Connecting ...
textedeleteok=Number of files deleted
textedownloadok=Correctly downloaded files
textedownloadwait=Please wait While downloading ...
textenewsolution=proposes a new solution For
textftpko=Connection impossible with
textftpok=Connection test ok for
textftpviewok=Content of the file :
textftpviewko=FTP settings file impossible To find :
title=Title:
to = to

[CU]

; IDE Options = PureBasic 4.30 (Windows - x86)
; CursorPosition = 135
; FirstLine = 55
; Folding = -
; EnableXP
Dernière modification par kerkael le mar. 26/mai/2009 8:43, modifié 1 fois.
kerkael
Messages : 97
Inscription : mer. 03/sept./2008 21:08

Message par kerkael »

Accessoirement, voici le code PHP de reception du formulaire pour être compatible avec le traitement du QCM.
A sauvegarder sous le nom du fichier appelé par votre page ouaib, sur un serveur qui accepte de traiter du ftp. :

Code : Tout sélectionner

<?php
function insert_referer () {
  echo $_SERVER['HTTP_REFERER'];
}


	$used_method="POST";			
	$tableau_recu=&$_POST;
	$today = date("dm"); 
	$nomfich="./tna/prefixe_" . $today . ".txt";
	$inF = fopen($nomfich,"a");	/*name the output file here*/
	while (list($name, $value) = each($tableau_recu)) 	/*write data*/
	{
		fputs($inF,$name . "|" . $value . "|") ;
	}
	fputs($inF,"\n");
	
	fclose($inF); 
?>


<html>
<BODY BGCOLOR="#FFFFFF">

<p align="center">

<img src="./logo.jog" width="326" height="37">
<p align="center"><font size="4"><b><i>TNA</i></b></font>
<br><br><br><br>
<b>Nous vous remercions de votre participation.</b></p>


</BODY>
</html>
kerkael
Messages : 97
Inscription : mer. 03/sept./2008 21:08

Message par kerkael »

Une correction pour traiter de vraies questions QCM.
Dans le cas où la page web utilise des formulaires de type case à cocher, et que plusieurs choix sont possibles, c'est le PHP qui fera le traitement de ces multiples choix en accolant les réponses.
Exemple ici dans le cas de la question Q47, résultante des cases à cocher (formulaires) Q47a, Q47b, Q47c, Q47d, Q47e, donnant respectivement en sortie A,B,C,D,E :

$tableau_recu['Q47']=$tableau_recu['Q47a'].$tableau_recu['Q47b'].$tableau_recu['Q47c'].$tableau_recu['Q47d'].$tableau_recu['Q47e'];

Ainsi, si le QCM prévoyait comme réponse à la question 47, à la fois les réponses A C E, le champ envoyé au fichier TNA contient Q47|ACE.

Les champs Q47a,Q47b ... sont aussi envoyés au fichier TNA, mais ils ne seront pas traités, puisque le code, ci-dessus, s'attend à trouver Q1à Q99, mais pas de Q47a.

Reste au rédacteur de la solution de correctement renseigner ses réponses A,C,E pour que celui qui passe le test soit correctement évalué.

(bon, c'est du code PHP qui n'a pas grand chose à faire dans ce forum, mais il accompagne le code PB de traitement des données.)

Code : Tout sélectionner

<?php
function insert_referer () {
  echo $_SERVER['HTTP_REFERER'];
}


	$used_method="POST";			
	$tableau_recu=&$_POST;
	$today = date("dm"); 
	$nomfich="./tna/prefixe_" . $today . ".txt";
	$inF = fopen($nomfich,"a");	/*name the output file here*/

$tableau_recu['Q47']=$tableau_recu['Q47a'].$tableau_recu['Q47b'].$tableau_recu['Q47c'].$tableau_recu['Q47d'].$tableau_recu['Q47e'];

	while (list($name, $value) = each($tableau_recu)) 	/*write data*/
	{
		fputs($inF,$name . "|" . $value . "|") ;
	}
	fputs($inF,"\n");
	
	fclose($inF); 
?>


<html>
<BODY BGCOLOR="#FFFFFF">

<p align="center">

<img src="./logo.jog" width="326" height="37">
<p align="center"><font size="4"><b><i>TNA</i></b></font>
<br><br><br><br>
<b>Nous vous remercions de votre participation.</b></p>


</BODY>
</html>
Répondre