Pure Posteur

Chris · Message par **Chris** » dim. 28/oct./2007 20:44

C'est un tout petit prog (plutôt mal foutu, je vous l'accorde, mais... tout petit), pour poster des petits fichiers sur votre 'ftp.

Si l'opération réussit, il vous met l'adresse de téléchargement dans le presse-papiers pour la coller directement dans le forum.

Il crée également un lien sur la fenêtre principale afin de vous permettre de tester si le lien est valide ou non. (Si vous cliquez sur le lien, et que votre navigateur vous propose de télécharger le fichier, vous avez gagné. Sinon...).

Dans les options, il faut renseigner les champs suivants.

Adresse du 'ftp. : C'est l'adresse complète du dossier ou doit être envoyé le fichier. Exemple:"perso-ftp.monserveur.fr/mondossier/mesprogrammes/".

Le programme ne crée pas les dossiers. Veillez à ce qu'ils existent déjà sur le serveur.

Port : Normalement, 21.

Nom d'utilisateur et Mot de passe : Pas besoin d'explication

Racine du site Mettez l'adresse de la page d'accueil de votre site. Exemple : "http://monsite.fr/"

Code : Tout sélectionner

;- PurePosteur : Logiciel pour poster de petits fichiers sur votre 'ftp.
;-
;- Une fois le fichier envoyé, l'adresse de téléchargement est copiée dans le
;- presse-papier, ce qui permet de la coller directement dans un forum, par exemple.
;-
;- Codé par Chris avec PB v4.02
;- Procédures de transfert Ftp prises dans CodeArchiv.
;- Auteur : Paul (updated For PB4.00 by blbltheworm)
;- English forum: http://www.purebasic.fr/english/viewtopic.php?t=8971&highlight=
;-
;-

Enumeration
  #Window_0
  #Window_1
EndEnumeration

Enumeration
  ; Fenêtre principale
  #Btn_Cancel
  #Btn_Go
  #Btn_File
  #Str_Port
  #Str_File
  #Link
  
  ; Fenêtre d'options
  #Btn_Opt_Cancel
  #Btn_Opt_Save
  
  #Str_Opt_Pass
  #Str_Opt_UserName
  #Str_Opt_Address
  #Str_Web
  
  #Txt_0
  #Txt_1
  #Txt_2
  #Txt_3
  #Txt_4
  #Txt_5
  #Txt_6
EndEnumeration

Enumeration
  #MainMenu
EndEnumeration

Enumeration
  #M_Options
  #M_Quit
  #M_About
EndEnumeration

#INTERNET_OPEN_TYPE_DIRECT  = 1
#INTERNET_FLAG_PASSIVE      = $08000000
#INTERNET_DEFAULT_FTP_PORT  = 21
#FTP_TRANSFER_TYPE_BINARY   = $00000002

Procedure Open_Window_0()
  If OpenWindow(#Window_0, 0, 0, 375, 145, "Pure-Posteur",  #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
    If CreateMenu(#MainMenu, WindowID(#Window_0))
      MenuTitle("Options")
      MenuItem(#M_Options, "Options"+Chr(9)+"Ctrl+O")
      MenuBar()
      MenuItem(#M_Quit, "Quitter")
      MenuTitle("A Propos...")
      MenuItem(#M_About, "à propos...")
    EndIf
    
    If CreateGadgetList(WindowID(#Window_0))
      StringGadget(#Str_File, 5, 25, 345, 20, "")
      TextGadget(#Txt_0, 5, 10, 345, 15, "Fichier à poster")
      ButtonGadget(#Btn_File, 350, 25, 20, 20, "...")
      ButtonGadget(#Btn_Go, 5, 50, 365, 20, "Envoyer")
      TextGadget(#Txt_6, 5, 90, 365, 15, "", #PB_Text_Center)
      HyperLinkGadget(#Link, 5, 105, 365, 20, "", $FF0000, #PB_HyperLink_Underline)
    EndIf
    
    Result = #True
  Else
    Result = #False
  EndIf
  DisableGadget(#Btn_Go, 1)
  
  ProcedureReturn Result
EndProcedure

Procedure Open_Window_1(Ad$,Po$,Us$,Pa$, We$)
  If OpenWindow(#Window_1, 440, 45, 380, 185, "Pure-Posteur --- Options",  0 )
    If CreateGadgetList(WindowID(#Window_1))
      StringGadget(#Str_Opt_Address, 5, 25, 320, 20, "")
      GadgetToolTip(#Str_Opt_Address, "Adresse ftp complète du dossier de destination. (Sans le ''ftp://'')")
      
      StringGadget(#Str_Port, 335, 25, 40, 20, "21", #ES_CENTER)
      GadgetToolTip(#Str_Port, "Numéro du port. (Généralement, 21)")
      
      StringGadget(#Str_Opt_UserName, 5, 75, 180, 20, "")
      GadgetToolTip(#Str_Opt_UserName, "Votre nom d'utilisateur")
      
      StringGadget(#Str_Opt_Pass, 195, 75, 180, 20, "", #PB_String_Password)
      GadgetToolTip(#Str_Opt_Pass, "Votre mot de passe")
      
      StringGadget(#Str_Web, 5, 135, 370, 20, "")
      GadgetToolTip(#Str_Web, "Racine du site ou se trouve le fichier")
      
      ButtonGadget(#Btn_Opt_Save, 5, 160, 180, 20, "Sauver")
      ButtonGadget(#Btn_Opt_Cancel, 195, 160, 180, 20, "Annuler")
      
      TextGadget(#Txt_1, 5, 10, 320, 15, "Adresse du FTP")
      TextGadget(#Txt_2, 5, 60, 180, 15, "Nom d'utilisateur")
      TextGadget(#Txt_3, 195, 60, 180, 15, "Mot de passe")
      TextGadget(#Txt_4, 335, 10, 40, 15, "Port")
      TextGadget(#Txt_5, 5, 120, 370, 15, "Racine du site")
    EndIf
  EndIf
  
  SetGadgetText(#Str_Opt_Address, Ad$)
  SetGadgetText(#Str_Opt_Pass, Pa$)
  SetGadgetText(#Str_Opt_UserName, Us$)
  SetGadgetText(#Str_Port, Po$)
  SetGadgetText(#Str_Web, We$)
  
  SetActiveGadget(#Str_Opt_Address)
EndProcedure

Procedure.l FTPInit() 
  ProcedureReturn InternetOpen_("FTP",1,"","",0) 
EndProcedure 

Procedure.l FTPConnect(hInternet,Server.s,User.s,Password.s,port.l) 
  ProcedureReturn InternetConnect_(hInternet,Server,port,User,Password,1,#INTERNET_FLAG_PASSIVE,0) 
EndProcedure 

Procedure.l FTPUpload(hConnect.l,Source.s,Dest.s) 
  ProcedureReturn FtpPutFile_(hConnect,Source,Dest,#FTP_TRANSFER_TYPE_BINARY,0) 
EndProcedure 

Procedure.l FTPClose(hInternet.l) 
  ProcedureReturn InternetCloseHandle_(hInternet) 
EndProcedure 

Procedure.l FTPSetDir(hConnect.l,Dir.s) 
  ProcedureReturn FtpSetCurrentDirectory_(hConnect,Dir) 
EndProcedure 

Procedure.s Encode(Text$) ; Nooon... Ne vous marrez pas!
  For I = 1 To Len(Text$)
    c$ = Mid(Text$, I, 1) : c = Asc(c$)+ 64 : c$ = Chr(c)
    r$ + c$
  Next
  ProcedureReturn r$
EndProcedure

Procedure.s Decode(Text$); La même, mais à l'envers
  For I = 1 To Len(Text$)
    c$ = Mid(Text$, I, 1) : c = Asc(c$)- 64 : c$ = Chr(c)
    r$ + c$
  Next
  ProcedureReturn r$
EndProcedure

If Open_Window_0()
  If ReadFile(0, "Options.txt")
    M$ = Decode(ReadString(0)) : CloseFile(0)
  EndIf
  
  If M$
    Addr$ = StringField(M$, 1, ";")
    Pass$ = StringField(M$, 2, ";")
    User$ = StringField(M$, 3, ";")
    Port$ = StringField(M$, 4, ";")
    Web$  = StringField(M$, 5, ";")
    
    SetWindowTitle(#Window_0, "Pure-Posteur - ftp://"+Addr$+"/")
  Else
    SetWindowTitle(#Window_0, "Pure-Posteur - Pas de fichier de configuration")
    Open_Window_1("","","","","")
  EndIf
EndIf

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_Menu
      Select EventMenu()
        Case #M_Options
          Open_Window_1(Addr$,Port$,User$,Pass$,Web$)
          
        Case #M_Quit
          Quit = #True
          
        Case #M_About
          MessageRequester("Pure-Posteur", "  Pour poster facilement de petits logiciels sur vos FTP." + Chr(10) + "" + Chr(10) + "Programmé par Chris avec PB 4.02 ... et ses p'tits doigts", #MB_OK)
      EndSelect
      
    Case #PB_Event_Gadget
      Select EventGadget()
        
        ;/ Fenêtre principale
        Case #Btn_Go
          hInternet = FTPInit()
          
          If hInternet
            I = CountString(Addr$, "/")
            Ad$ = StringField(Addr$, 1, "/")
            hConnect = FTPConnect(hInternet, Ad$, User$, Pass$, Val(Port$))
            
            If hConnect
              If I > 0
                For a = 2 To I+1
                  Ad$ = StringField(Addr$, a, "/") : Tmp$ + Ad$+"/"
                  FTPSetDir(hConnect, Ad$+"/")
                Next
              EndIf
              
              If FTPUpload(hConnect, GetGadgetText(#Str_File), GetFilePart(GetGadgetText(#Str_File)))
                F$ = GetGadgetText(#Str_File)
                
                If Web$ <> ""
                  Adresse_Site$ = Web$ + Tmp$ + GetFilePart(F$); : Debug Adresse_Site$
                  
                  SetGadgetText(#Link, Adresse_Site$)
                  SetGadgetText(#Txt_6, "Testez le lien vers le fichier ici;")
                  
                  SetClipboardText(Adresse_Site$)
                  MessageRequester("Transfert", "Le fichier a été envoyé"+Chr(10)+"L'adresse du fichier a été copiée dans le presse-papier")
                Else
                  MessageRequester("Transfert","Le fichier a été envoyé")
                EndIf
                
                SetGadgetText(#Str_File, "")
                DisableGadget(#Btn_Go, 1)
              Else
                MessageRequester("Transfert","Le transfert a échoué")
              EndIf
              
              FTPClose(hInternet)
              
            EndIf
          EndIf
          
        Case #Btn_Cancel
          Quit = 1
          
        Case #Btn_File
          Fichier$ = OpenFileRequester("Fichier à envoyer", "", "Tout type|*.*", 0)
          If Fichier$
            SetGadgetText(#Str_File, Fichier$)
            DisableGadget(#Btn_Go, 0)
          EndIf
          
        Case #Link
          ShellExecute_(WindowID(#Window_0), "Open", Adresse_Site$, "", "", 1)
          
          ;/ Fenêtre Options
        Case #Btn_Opt_Save
          If GetGadgetText(#Str_Opt_Address) <> "" And GetGadgetText(#Str_Opt_Pass) <> "" And GetGadgetText(#Str_Opt_UserName) <> "" And GetGadgetText(#Str_Port) <> "" And GetGadgetText(#Str_Web) <> ""
            If Right(GetGadgetText(#Str_Opt_Address), 1) = "/"
              SetGadgetText(#Str_Opt_Address, Left(GetGadgetText(#Str_Opt_Address), Len(GetGadgetText(#Str_Opt_Address))-1))
            EndIf
            
            If Left(GetGadgetText(#Str_Opt_Address), 6) = "ftp://"
              SetGadgetText(#Str_Opt_Address, Right(GetGadgetText(#Str_Opt_Address), Len(GetGadgetText(#Str_Opt_Address))-6))
            EndIf
            
            If GetGadgetText(#Str_Web) <> ""
              If Right(GetGadgetText(#Str_Web), 1) <> "/"
                SetGadgetText(#Str_Web, GetGadgetText(#Str_Web) + "/")
              EndIf
            EndIf
            
            M$ = GetGadgetText(#Str_Opt_Address)+";"+GetGadgetText(#Str_Opt_Pass)+";"+GetGadgetText(#Str_Opt_UserName)+";"+GetGadgetText(#Str_Port)+";"+GetGadgetText(#Str_Web)
            
            If CreateFile(0, "Options.txt")
              
              T$ = Encode(M$)
              If T$
                WriteString(0,T$)
              EndIf
              
              CloseFile(0)
              
              Addr$ = StringField(M$, 1, ";")
              Pass$ = StringField(M$, 2, ";")
              User$ = StringField(M$, 3, ";")
              Port$ = StringField(M$, 4, ";")
              Web$  = StringField(M$, 5, ";")
              
              SetWindowTitle(#Window_0, "Pure-Posteur - ftp://"+Addr$+"/")
              
            EndIf
          EndIf
          CloseWindow(#Window_1)
          
        Case #Btn_Opt_Cancel
          CloseWindow(#Window_1)
          
      EndSelect
      
    Case #PB_Event_CloseWindow
      Select EventWindow()
        Case #Window_0 : Quit = #True
        Case #Window_1 : CloseWindow(#Window_1):SetActiveWindow(#Window_0)
          
      EndSelect
      
  EndSelect
  
Until Quit
End

lionel_om · Message par **lionel_om** » dim. 28/oct./2007 22:16

Ta fonction Encode risque de poser problème avec les caractères entre 192 et 224. Je pense notamment au caractère 192, qui en ajoutant 64 donne : 256 => 0. Donc la chaîne sera tronquée!

Lio

Chris · Message par **Chris** » dim. 28/oct./2007 23:07

lionel_om a écrit :Ta fonction Encode risque de poser problème avec les caractères entre 192 et 224. Je pense notamment au caractère 192, qui en ajoutant 64 donne : 256 => 0. Donc la chaîne sera tronquée!

Lio

Les fonctions Encode et Decode, faut les virer. C'est une honte, des fonctions comme ça.

Mais j'avais pas le courage de faire quelque chose de correct

PS: D'un autre côté, il y a peu de chances pour que tu trouves des caractères dont le code ASCII est supérieur à 191 dans une adresse ftp, un mot de passe ou un login.