PureBasic

Code : Tout sélectionner

Procedure FTP_ouvrir()
  
  gParametres\FTP = OpenFTP(#PB_Any,gParametres\NomServeurFTP, gParametres\NomUtilisateurFTP, gParametres\MotDePasseFTP, gParametres\PortFTP)
  
  If gParametres\FTP = 0
    MessageRequester ("Erreur","Impossible de se connecter au site pour transfert !")
    ProcedureReturn #False
  Else
    ProcedureReturn #True
  EndIf
  
EndProcedure

Procedure FTP_transferer_fichier()
  
  Protected Choix
  Protected NomFichierSite$
  Protected CheminFichier$
  
  NomFichierSite$ = GetFilePart (gParametres\CheminFichierFTP$)
  CheminFichier$ = gParametres\CheminFichierFTP$
  
  SetGadgetText (Text_fichier_transfere, "...")
  
  If FTP_verifier_fichier_existe(GetFilePart (CheminFichier$)) = #True
    Choix = MessageRequester ("Avertissement", "Le fichier '" + GetFilePart (CheminFichier$) + "' existe déjà sur le serveur du site, souhaitez-vous définitivement le remplacer ?", #PB_MessageRequester_YesNo | #PB_MessageRequester_Warning)
    If Choix = #PB_MessageRequester_No
      MessageRequester ("Info","Transfert annulée.", #PB_MessageRequester_Info)
      ProcedureReturn #False
    EndIf
  EndIf
  
    If FTP_ouvrir() = #True
  
      If IsFTP (gPArametres\FTP) <> 0 
    
        If CheminFichier$ <> ""
          
          If FileSize (CheminFichier$) <> - 1
          
            gParametres\MaxProgress = FileSize(CheminFichier$)
            gParametres\REsultat = SendFTPFile(gParametres\FTP,CheminFichier$,#CHEMIN_SITE + NomFichierSite$,#True)
            gParametres\Uploade = 1
            
          Else
            
            MessageRequester ("Erreur","Le fichier à transférer n'a pas été trouvé !", #PB_MessageRequester_Error)
            
          EndIf
          
        Else
          
          MessageRequester ("Erreur","Vous devez choisir un fichier sonore auparavant !", #PB_MessageRequester_Error)
          
        EndIf
        
      EndIf
      
    EndIf
    
  EndProcedure

 Procedure FTP_gerer()
    
    If IsFTP (gPArametres\FTP) <> 0
    
      If gParametres\Uploade = #True
       If FTPProgress(gParametres\FTP) = #PB_FTP_Finished
          SetGadgetState(ProgressBar_transfert_fichier_site,100)
          Afficher_message ("Fichier transféré.")
          SetGadgetText (Text_fichier_transfere, GetFilePart(gParametres\CheminFichierFTP$) + " (" + Donner_taille_fichier (gParametres\CheminFichierFTP$) + ")")
          gParametres\Uploade = #False
          FTP_fermer()
          FTP_lister_fichiers_site()
        Else
          SetGadgetState(ProgressBar_transfert_fichier_site,FTPProgress(gParametres\FTP))
          
           If FTPProgress(gParametres\FTP) = #PB_FTP_Error  
             Afficher_message ("Erreur lors de la transmission du fichier !")
             MessageRequester ("Erreur", "Erreur lors de la transmission du fichier !", #PB_MessageRequester_Error)
             AbortFTPFile(gPArametres\FTP)
            gParametres\Uploade = #False
            FTP_Fermer()
          EndIf
      
        EndIf
      EndIf
      
    EndIf
    
  EndProcedure

Code : Tout sélectionner

EnableExplicit ; toutes les variables doivent êtres déclarées

CompilerIf Not #PB_Compiler_Thread
  CompilerError "'Create threadsafe executable' must be checked."
;;CompilerError "L'option Activer la gestion des thread doit etre activée."
CompilerEndIf

Code : Tout sélectionner

Declare ma_procedure(ma_variable$)
Declare ma_procedure_thread(value=#False)

Procedure ma_procedure(ma_variable$)
  Static thread
  If IsThread(thread)
    ProcedureReturn thread
  Else
    thread = CreateThread(@ma_procedure_thread(), #True)
    ProcedureReturn thread
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure ma_procedure_thread(value=#False)
  Static isRunning.b
  
  If isRunning
    ProcedureReturn -1
  Else
    isRunning = #True
  EndIf
  
  Protected tes_variables ; déclarer en protected toutes les variables a utiliser dans la proc.
  
  ;
  ;Le code de ta procedure est a mettre ici
  ;
  
  isRunning = #False ; en fin de procédure
  
 ;ProcedureReturn une_valeur ne peut-être utilisé dans un Thread
 
  ; Tu peux utiliser une ou plusieurs variables alpha. ou num. pour indiquer le bon déroulement ou pas de ta proc.
  ; Si tu déclares une variable CODE_RETOUR_THREAD = 255 avant de créer ton Thread
  ; Si ta procédure se termine bien (Ex: fichier bien transmis), alors CODE_RETOUR_THREAD = #True
  ; autrement CODE_RETOUR_THREAD = #False ou toute valeur qui peut être utile pour prendre une décision
  ; Tu peux donc tester réguliérement le code de retour de ton Thread
  
EndProcedure

Code : Tout sélectionner

Global.i TH1,TH2,TH3
Global mutex = CreateMutex()
Global.b ThreadOneIsFinished = #False
Global.b ThreadTwoIsFinished = #False
Enumeration 
  #MAIN_FORM
  #BT
  #LST
EndEnumeration

Procedure Exit()
  CloseWindow(#MAIN_FORM)
  End
EndProcedure

Procedure Th1Loop(*data)
  ; All other threads await of this is finished
  LockMutex(mutex)
  For i = 1 To 100
    AddGadgetItem(#LST,0,"Action thread 1 N: "+Str(i))
    N + 1
    Delay(100)
  Next
  ; Treatment is finished the other threads can be runed
  ThreadOneIsFinished = #True
  UnlockMutex(mutex)
  KillThread(TH1)
EndProcedure

Procedure Th2Loop(*data)
  ; All other threads await of this is finished
  LockMutex(mutex)
  For i = 1 To 100
    AddGadgetItem(#LST,0,"Action thread 2 N: "+Str(i))
    N + 1
    Delay(100)
  Next
  ; Treatment is finished the other threads can be runed
  ThreadTwoIsFinished = #True
  UnlockMutex(mutex)
  KillThread(TH2)
EndProcedure

Procedure Th3Loop(*data)
  Repeat 
    If ThreadOneIsFinished And ThreadTwoIsFinished
      MessageRequester("Info","All thread are finished")
      KillThread(TH3)
    Else
      ; Give time to CPU to breath
      Delay(1)
    EndIf
  ForEver
EndProcedure

Procedure BtClick()
  ; Create threads and run those
  TH1 = CreateThread(@Th1Loop(),0)
  TH2 = CreateThread(@Th2Loop(),0)
  TH3 = CreateThread(@Th3Loop(),0)
EndProcedure

Procedure OpenForm()
  OpenWindow(#MAIN_FORM,0,0,800,600,"Threads demo",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  ListViewGadget(#LST,10,10,400,580)
  ButtonGadget(#BT,510,10,100,30,"Run Thread ")

  ; Binding management
  BindEvent(#PB_Event_CloseWindow,@Exit(),#MAIN_FORM)
  BindGadgetEvent(#BT,@BtClick())
EndProcedure

OpenForm()

Repeat 
  WaitWindowEvent()
ForEver