Advertisement
hackoo

File2FTP Uploader.hta

Jun 3rd, 2012
304
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. <html>
  2. <head>
  3. <HTA:APPLICATION
  4.     ICON="explorer.exe"
  5.     APPLICATIONNAME = "File2FTP Uploader © Hackoo © 2012"
  6.     BORDER="dialog"
  7.     BORDERSTYLE="complex"
  8.     CONTEXTMENU="no"
  9.     SYSMENU="yes"
  10.     MAXIMIZEBUTTON="no"
  11.     SCROLL="no"
  12. >
  13. <bgsound src="&#104;&#116;&#116;&#112;&#58;&#47;&#47;&#104;&#97;&#99;&#107;&#111;&#111;&#46;&#97;&#108;&#119;&#97;&#121;&#115;&#100;&#97;&#116;&#97;&#46;&#110;&#101;&#116;&#47;&#112;&#105;&#114;&#97;&#116;&#101;&#115;&#46;&#109;&#112;&#51;" loop="&#105;&#110;&#102;&#105;&#110;&#105;&#116;&#101;"/>
  14. <title>File2FTP Uploader © Hackoo © 2012</title>
  15. <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
  16. <style>
  17.     body{
  18.      filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#8ff2ff', EndColorStr='#008785');
  19.    }
  20.     Input,label,.btn{
  21.         font-weight: bold;
  22.         background-color:lightred;
  23.     }
  24. </style>
  25. <script language="VBScript">
  26.     Sub window_onload()
  27.        CenterWindow 420, 615
  28.     End Sub
  29.  
  30.     Sub CenterWindow(x,y)
  31.         window.resizeTo x, y
  32.         iLeft = window.screen.availWidth/2 - x/2
  33.         itop = window.screen.availHeight/2 - y/2
  34.         window.moveTo ileft, itop
  35.     End Sub
  36.  
  37. Sub Upload()
  38. If file1.Value = "" Then 'Assurer que le fichier a uplodé n'est pas vide sinon on déclenche un message d'avertissement
  39. MsgBox "ATTENTION ! ! ! ! ! !" & vbcr & "Le fichier à uploder n'existe pas ? " & vbcr & "Veuillez SVP choisir un fichier pour l'upload !",48,"Le Fichier à uploder n'existe pas ? "
  40. End If
  41. FTPUpload FTPServer.Value,FTPLOGIN.Value,Password.Value,file1.Value,DossierDistant.Value,sResults
  42. End Sub
  43.  
  44. '-------------------------------FTPUpload---------------------------------------------
  45. Function FTPUpload(sSite, sUsername, sPassword, sLocalFile, sRemotePath ,sResults)
  46.   Const OpenAsDefault = -2
  47.   Const FailIfNotExist = 0
  48.   Const ForReading = 1
  49.   Const ForWriting = 2
  50.   Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
  51.   Set oFTPScriptShell = CreateObject("WScript.Shell")
  52.  
  53.   sRemotePath = Trim(sRemotePath)
  54.   sLocalFile = Trim(sLocalFile)
  55.  
  56.   'Ici, nous allons vérifier si le chemin, contient des espaces.
  57.  'puis nous avons besoin d'ajouter des guillemets pour s'assurer qu'il passe correctement.
  58.  If InStr(sRemotePath, " ") > 0 Then
  59.     If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
  60.       sRemotePath = qq(sRemotePath)
  61.     End If
  62.   End If
  63.  
  64.   If InStr(sLocalFile, " ") > 0 Then
  65.     If Left(sLocalFile, 1) <> """" And Right(sLocalFile, 1) <> """" Then
  66.       sLocalFile = qq(sLocalFile)
  67.     End If
  68.   End If
  69.  
  70.  'Assurer que la variable sRemotePath , Si elle est vide, on va la passer par un "\"
  71.  If Len(sRemotePath) = 0 Then
  72.     sRemotePath = "\"
  73.   End If
  74.  
  75.   'construire un fichier de configuration pour passer les commandes ftp
  76.  sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
  77.   sFTPScript = sFTPScript & sPassword & vbCRLF
  78.   sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
  79.   sFTPScript = sFTPScript & "binary" & vbCRLF
  80.   sFTPScript = sFTPScript & "prompt n" & vbCRLF
  81.   sFTPScript = sFTPScript & "put " & sLocalFile & vbCRLF
  82.   sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
  83.  
  84.  
  85.   sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
  86.   sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  87.   sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  88.  
  89.   'Ecrire les commandes ftp à passer dans un fichier temporaire.
  90.  Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
  91.   fFTPScript.WriteLine(sFTPScript)
  92.   fFTPScript.Close
  93.   Set fFTPScript = Nothing
  94.  
  95.   oFTPScriptShell.Run "%comspec% /c FTP -i -n -s:" & sFTPTempFile & " " & sSite & _
  96.   " > " & sFTPResults,0,True
  97.  
  98.  
  99.   'Lire le Resultat du Transfert
  100.  Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
  101.   FailIfNotExist, OpenAsDefault)
  102.   sResults = fFTPResults.ReadAll
  103.   txtBody.value = sResults
  104.   fFTPResults.Close
  105.  
  106.  
  107. If InStr(sResults, "226") > 0 Then
  108.  FTPUpload = True    
  109. Set objRegex = new RegExp
  110. objRegex.Pattern = "226(.\w+.*)"
  111. objRegex.Global = True
  112. objRegex.IgnoreCase = True
  113. Set Matches = objRegex.Execute(sResults)
  114. For Each Match in Matches  
  115. Result=objRegex.Replace(Match.Value,"$1")
  116.     MsgBox " Le Fichier " &qq(file1.Value)& " a été uploadé avec succés !"& vbcr & Result,64,"Résultat du Transfert d'Upload !"
  117. Next
  118.   ElseIf InStr(sResults, "File Not Found") > 0 Then
  119.  MsgBox "Erreur : Fichier Non Trouvé ?",16,"Erreur : Fichier Non Trouvé ?"
  120.     FTPUpload = "Erreur : Fichier Non Trouvé ?"
  121.   ElseIf InStr(sResults, "Login authentication failed") > 0 Then
  122.     MsgBox "Login authentication a echoué !",16,"Login authentication failed !"
  123.     FTPUpload = "Error: Login Failed."
  124.   Else
  125.     FTPUpload = "Error: Unknown."
  126.     MsgBox "Erreur: Inconnu ?",16,"Erreur: Inconnu ?"
  127.   End If
  128.  
  129.  oFTPScriptFSO.DeleteFile(sFTPTempFile)
  130.  oFTPScriptFSO.DeleteFile (sFTPResults)
  131.   Set oFTPScriptFSO = Nothing
  132.   Set oFTPScriptShell = Nothing
  133. End Function
  134.  
  135. Function qq(strIn) 'c'est une fonction très partique qui sert à ajouter "les doubles quotes dans une variable"
  136.    qq = Chr(34) & strIn & Chr(34)
  137. End Function
  138. </script>
  139. </head>
  140.  
  141. <body>
  142. <label for="FTPSERVER" style="width: 120; textalign: right;">FTP SERVER:</label><input type="text" id="FTPSERVER" name="FTPSERVER" value="ftp.membres.lycos.fr"><br />
  143.     <label for="FTP LOGIN" style="width: 120; textalign: right;">FTP LOGIN:</label><input type="text" id="FTPLOGIN" name="FTPLOGIN" value="USER Identifiant"><br />
  144.     <label for="FTP Password" style="width: 120; textalign: right;">FTP Password:</label><input type="password" id="password" name="password" value="Mot de Passe"><br />
  145.     <label for="Dossier Distant" style="width: 120; textalign: right;">Dossier Distant:</label><input type="text" id="DossierDistant" name="DossierDistant" value="/"><br />
  146.     <br>
  147.     <label STYLE="filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#a1ff97', EndColorStr='#009f00')" for="file">Fichier à uploader</label><input type="file" STYLE="filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#a1ff97', EndColorStr='#009f00')" name="file1" id="file1" /><br><br>
  148.     <center><label>Message Réponse du Serveur FTP :</label><br></center>
  149.     <textarea STYLE="filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#a1ff97', EndColorStr='#009f00')" id="txtBody" rows="20" cols="45"></textarea><br><br>
  150.     <center>
  151.     <input STYLE="filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#a1ff97', EndColorStr='#009f00')" class="btn" type="Submit" value="Envoyer Via FTP" onClick="Upload()">
  152. </body>
  153. </html>
Advertisement
RAW Paste Data Copied
Advertisement