Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Ce site au démarrage

begin process at 2013 05 20 05:03:36

Accueil Codes Tutoriels Forum Livres Emploi Services Connexion

Trouver un code source :

dans

[ Dernières recherches ]

Accueil >

FILE2FTPUPLOAD

Information sur la source

Note :
Aucune note

Catégorie :VBScript Classé sous :Serveur, FTP, Upload, Fichier, Résultat Niveau :Initié Date de création :09/06/2012 Date de mise à jour :17/06/2012 19:59:40 Vu / téléchargé :2 353 / 186

Auteur : hackoo

Ecrire un message privé

Site perso

Commentaire sur cette source (0)

Ajouter un commentaire et/ou une note

Description

Cliquez pour voir la capture en taille normale

Je vous propose un nouvel élément à utiliser : File2FTPUpload
c'est le fruit d'une question posée dans le forum.
Il permet d'uploader un fichier dans votre serveur FTP avec affichage du résultat de transfert.

Source

<html>
<head>
<HTA:APPLICATION
ICON="explorer.exe"
APPLICATIONNAME = "File2FTP Uploader © Hackoo © 2012"
BORDER="dialog"
BORDERSTYLE="complex"
CONTEXTMENU="no"
SYSMENU="yes"
MAXIMIZEBUTTON="no"
SCROLL="no"
>
<title>File2FTP Uploader © Hackoo © 2012</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<style>
body{
filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#8ff2ff', EndColorStr='#008785');
}
Input,label,.btn{
font-weight: bold;
background-color:lightred;
}
</style>
<script language="VBScript">
Sub window_onload()
CenterWindow 420, 615
End Sub
Sub CenterWindow(x,y)
window.resizeTo x, y
iLeft = window.screen.availWidth/2 - x/2
itop = window.screen.availHeight/2 - y/2
window.moveTo ileft, itop
End Sub
Sub Upload()
If file1.Value = "" Then 'Assurer que le fichier a uplodé n'est pas vide sinon on déclenche un message d'avertissement
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 ? "
End If
FTPUpload FTPServer.Value,FTPLOGIN.Value,Password.Value,file1.Value,DossierDistant.Value,sResults
End Sub
'-------------------------------FTPUpload---------------------------------------------
Function FTPUpload(sSite, sUsername, sPassword, sLocalFile, sRemotePath ,sResults)
Const OpenAsDefault = -2
Const FailIfNotExist = 0
Const ForReading = 1
Const ForWriting = 2
Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
Set oFTPScriptShell = CreateObject("WScript.Shell")
sRemotePath = Trim(sRemotePath)
sLocalFile = Trim(sLocalFile)
'Ici, nous allons vérifier si le chemin, contient des espaces.
'puis nous avons besoin d'ajouter des guillemets pour s'assurer qu'il passe correctement.
If InStr(sRemotePath, " ") > 0 Then
If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
sRemotePath = qq(sRemotePath)
End If
End If
If InStr(sLocalFile, " ") > 0 Then
If Left(sLocalFile, 1) <> """" And Right(sLocalFile, 1) <> """" Then
sLocalFile = qq(sLocalFile)
End If
End If
'Assurer que la variable sRemotePath , Si elle est vide, on va la passer par un "\"
If Len(sRemotePath) = 0 Then
sRemotePath = "\"
End If
'construire un fichier de configuration pour passer les commandes ftp
sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
sFTPScript = sFTPScript & sPassword & vbCRLF
sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
sFTPScript = sFTPScript & "binary" & vbCRLF
sFTPScript = sFTPScript & "prompt n" & vbCRLF
sFTPScript = sFTPScript & "put " & sLocalFile & vbCRLF
sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
'Ecrire les commandes ftp à passer dans un fichier temporaire.
Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
fFTPScript.WriteLine(sFTPScript)
fFTPScript.Close
Set fFTPScript = Nothing
oFTPScriptShell.Run "%comspec% /c FTP -i -n -s:" & sFTPTempFile & " " & sSite & _
" > " & sFTPResults,0,True
'Lire le Resultat du Transfert
Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
FailIfNotExist, OpenAsDefault)
sResults = fFTPResults.ReadAll
txtBody.value = sResults
fFTPResults.Close
If InStr(sResults, "226") > 0 Then
FTPUpload = True
Set objRegex = new RegExp
objRegex.Pattern = "226(.\w+.*)"
objRegex.Global = True
objRegex.IgnoreCase = True
Set Matches = objRegex.Execute(sResults)
For Each Match in Matches
Result=objRegex.Replace(Match.Value,"$1")
MsgBox " Le Fichier " &qq(file1.Value)& " a été uploadé avec succés !"& vbcr & Result,64,"Résultat du Transfert d'Upload !"
Next
ElseIf InStr(sResults, "File Not Found") > 0 Then
MsgBox "Erreur : Fichier Non Trouvé ?",16,"Erreur : Fichier Non Trouvé ?"
FTPUpload = "Erreur : Fichier Non Trouvé ?"
ElseIf InStr(sResults, "Login authentication failed") > 0 Then
MsgBox "Login authentication a echoué !",16,"Login authentication failed !"
FTPUpload = "Error: Login Failed."
Else
FTPUpload = "Error: Unknown."
MsgBox "Erreur: Inconnu ?",16,"Erreur: Inconnu ?"
End If
oFTPScriptFSO.DeleteFile(sFTPTempFile)
oFTPScriptFSO.DeleteFile (sFTPResults)
Set oFTPScriptFSO = Nothing
Set oFTPScriptShell = Nothing
End Function
Function qq(strIn) 'c'est une fonction très partique qui sert à ajouter "les doubles quotes dans une variable"
qq = Chr(34) & strIn & Chr(34)
End Function
</script>
</head>
<body>
<label for="FTPSERVER" style="width: 120; textalign: right;">FTP SERVER:</label><input type="text" id="FTPSERVER" name="FTPSERVER" value="ftp.membres.lycos.fr"><br />
<label for="FTP LOGIN" style="width: 120; textalign: right;">FTP LOGIN:</label><input type="text" id="FTPLOGIN" name="FTPLOGIN" value="USER Identifiant"><br />
<label for="FTP Password" style="width: 120; textalign: right;">FTP Password:</label><input type="password" id="password" name="password" value="Mot de Passe"><br />
<label for="Dossier Distant" style="width: 120; textalign: right;">Dossier Distant:</label><input type="text" id="DossierDistant" name="DossierDistant" value="/"><br />
<br>
<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>
<center><label>Message Réponse du Serveur FTP :</label><br></center>
<textarea STYLE="filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#a1ff97', EndColorStr='#009f00')" id="txtBody" rows="20" cols="45"></textarea><br><br>
<center>
<input STYLE="filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#a1ff97', EndColorStr='#009f00')" class="btn" type="Submit" value="Envoyer Via FTP" onClick="Upload()">
</body>
</html>

<html> 
<head> 
<HTA:APPLICATION 
    ICON="explorer.exe"
    APPLICATIONNAME = "File2FTP Uploader © Hackoo © 2012" 
    BORDER="dialog"
    BORDERSTYLE="complex"
    CONTEXTMENU="no"
    SYSMENU="yes"
    MAXIMIZEBUTTON="no"
    SCROLL="no" 
>
<title>File2FTP Uploader © Hackoo © 2012</title> 
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> 
<style>
    body{
     filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#8ff2ff', EndColorStr='#008785');
    }
    Input,label,.btn{
        font-weight: bold;
        background-color:lightred;
    }
</style>
<script language="VBScript">
    Sub window_onload()
       CenterWindow 420, 615
    End Sub
 
    Sub CenterWindow(x,y)
        window.resizeTo x, y
        iLeft = window.screen.availWidth/2 - x/2
        itop = window.screen.availHeight/2 - y/2
        window.moveTo ileft, itop
    End Sub
 
Sub Upload() 
If file1.Value = "" Then 'Assurer que le fichier a uplodé n'est pas vide sinon on déclenche un message d'avertissement
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 ? "
End If
FTPUpload FTPServer.Value,FTPLOGIN.Value,Password.Value,file1.Value,DossierDistant.Value,sResults
End Sub
 
'-------------------------------FTPUpload---------------------------------------------
Function FTPUpload(sSite, sUsername, sPassword, sLocalFile, sRemotePath ,sResults)
  Const OpenAsDefault = -2
  Const FailIfNotExist = 0
  Const ForReading = 1
  Const ForWriting = 2
  Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
  Set oFTPScriptShell = CreateObject("WScript.Shell")
 
  sRemotePath = Trim(sRemotePath)
  sLocalFile = Trim(sLocalFile)
 
  'Ici, nous allons vérifier si le chemin, contient des espaces. 
  'puis nous avons besoin d'ajouter des guillemets pour s'assurer qu'il passe correctement.
  If InStr(sRemotePath, " ") > 0 Then
    If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
      sRemotePath = qq(sRemotePath) 
    End If
  End If
 
  If InStr(sLocalFile, " ") > 0 Then
    If Left(sLocalFile, 1) <> """" And Right(sLocalFile, 1) <> """" Then
      sLocalFile = qq(sLocalFile) 
    End If
  End If
 
 'Assurer que la variable sRemotePath , Si elle est vide, on va la passer par un "\"
  If Len(sRemotePath) = 0 Then
    sRemotePath = "\"
  End If
 
  'construire un fichier de configuration pour passer les commandes ftp
  sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
  sFTPScript = sFTPScript & sPassword & vbCRLF
  sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "binary" & vbCRLF
  sFTPScript = sFTPScript & "prompt n" & vbCRLF
  sFTPScript = sFTPScript & "put " & sLocalFile & vbCRLF
  sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
 
 
  sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
  sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
 
  'Ecrire les commandes ftp à passer dans un fichier temporaire.
  Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
  fFTPScript.WriteLine(sFTPScript)
  fFTPScript.Close
  Set fFTPScript = Nothing 
 
  oFTPScriptShell.Run "%comspec% /c FTP -i -n -s:" & sFTPTempFile & " " & sSite & _
  " > " & sFTPResults,0,True
 
 
  'Lire le Resultat du Transfert
  Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
  FailIfNotExist, OpenAsDefault)
  sResults = fFTPResults.ReadAll
  txtBody.value = sResults
  fFTPResults.Close
 
 
If InStr(sResults, "226") > 0 Then
 FTPUpload = True    
Set objRegex = new RegExp
objRegex.Pattern = "226(.\w+.*)"
objRegex.Global = True
objRegex.IgnoreCase = True
Set Matches = objRegex.Execute(sResults)
For Each Match in Matches   
Result=objRegex.Replace(Match.Value,"$1")
    MsgBox " Le Fichier " &qq(file1.Value)& " a été uploadé avec succés !"& vbcr & Result,64,"Résultat du Transfert d'Upload !"
Next
  ElseIf InStr(sResults, "File Not Found") > 0 Then
 MsgBox "Erreur : Fichier Non Trouvé ?",16,"Erreur : Fichier Non Trouvé ?"
    FTPUpload = "Erreur : Fichier Non Trouvé ?"
  ElseIf InStr(sResults, "Login authentication failed") > 0 Then
    MsgBox "Login authentication a echoué !",16,"Login authentication failed !"
    FTPUpload = "Error: Login Failed."
  Else
    FTPUpload = "Error: Unknown."
    MsgBox "Erreur: Inconnu ?",16,"Erreur: Inconnu ?"
  End If

 oFTPScriptFSO.DeleteFile(sFTPTempFile)
 oFTPScriptFSO.DeleteFile (sFTPResults)
  Set oFTPScriptFSO = Nothing
  Set oFTPScriptShell = Nothing
End Function
 
Function qq(strIn) 'c'est une fonction très partique qui sert à ajouter "les doubles quotes dans une variable" 
    qq = Chr(34) & strIn & Chr(34)
End Function
</script>
</head> 
 
<body>
<label for="FTPSERVER" style="width: 120; textalign: right;">FTP SERVER:</label><input type="text" id="FTPSERVER" name="FTPSERVER" value="ftp.membres.lycos.fr"><br /> 
    <label for="FTP LOGIN" style="width: 120; textalign: right;">FTP LOGIN:</label><input type="text" id="FTPLOGIN" name="FTPLOGIN" value="USER Identifiant"><br /> 
    <label for="FTP Password" style="width: 120; textalign: right;">FTP Password:</label><input type="password" id="password" name="password" value="Mot de Passe"><br />
    <label for="Dossier Distant" style="width: 120; textalign: right;">Dossier Distant:</label><input type="text" id="DossierDistant" name="DossierDistant" value="/"><br />
    <br>
    <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>
    <center><label>Message Réponse du Serveur FTP :</label><br></center>
    <textarea STYLE="filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#a1ff97', EndColorStr='#009f00')" id="txtBody" rows="20" cols="45"></textarea><br><br>
    <center>
    <input STYLE="filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=0, StartColorStr='#a1ff97', EndColorStr='#009f00')" class="btn" type="Submit" value="Envoyer Via FTP" onClick="Upload()">
</body> 
</html>

Conclusion

Vos remarques et vos commentaires sont les bienvenues !

Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

File2FTPUpload.hta6 855 octets

Télécharger le zip

Historique

17 juin 2012 19:59:40 :: Ajout du Code Source

Sources du même auteur

EXPORTATION DU CODE SOURCE AVEC COLORATION SYNTAXIQUE EN HTM...

[HTA] VÉRIFICATEUR DES PROCESSUS + VIRUSTOTAL UPLOADER

[HTA] VÉRIFICATEUR DE PROCESSUS

[HTA] USAGE EN POURCENTAGE DE VOTRE CPU%

[HTA] ENCODER VBS2VBE & DECODER VBE2VBS

Toutes les sources de hackoo

Sources de la même categorie

EXPORTATION DU CODE SOURCE AVEC COLORATION SYNTAXIQUE EN HTM... par hackoo

[HTA] VÉRIFICATEUR DES PROCESSUS + VIRUSTOTAL UPLOADER par hackoo

LE MOT DE PASSE 2 par reagantshamy

EXTRACT ACTIVE DIRECTORY ET TRIE AUTOMATIQUE par Falthor

[HTA] VÉRIFICATEUR DE PROCESSUS par hackoo

Toutes les sources de la catégorie VBScript

Sources en rapport avec celle ci

[VBS] FOLDER2FTPUPLOAD par hackoo

CRÉATION DE DOSSIERS, COPIE DE FICHIERS PAR FTP EN VB.NET par zozo14

UPLOAD HTTP- PHP par christo16

TÉLÉCHARGER UN FICHIER D' UN SERVEUR FTP par vbGuy

ENVOYER UN FICHIER SUR UN SERVEUR (FTP) par cumu

Commentaires et avis

Aucun commentaire pour le moment.

Ajouter un commentaire

Discussions en rapport avec ce code source dans le forum

Upload de fichier sur un ftp [ par Razordj ] J'aimerais créer un "upload" automatique sur Visual basic express 2008 qui uploaderais sur un serveur Ftp.Il uploaderais tout les fichiers et tout les lister fichier sur serveur ftp [ par dsigmoun ] Bonjour,Je suis novice dans le domaine. J'aimerai savoir commentaire lister tous les fichiers ayant une extension .pdf sur un serveur FTP afin de les Upload d'un fichier à un serveur sans FTP [ par tawfik3221 ] Salut mon problème est le suivant:je cherche à envoyer un fichier à partir d'un bouton sur mon application (vb ou vb.net ) à un serveur distant (une a Modifier un fichier sur un serveur FTP en VB [ par Radion88 ] Bonjour,Je voudrais modifier (ou créér) un fichier sur un serveur FTP à partir d'un code Visual Basic (vb.net ou vb2005). J'y arrive parfaitement à cr Connaitre la taille d'un fichier sur le serveur FTP par API [ par djgab21 ] Bonjour à tous, Je suis entrain de développer un client FTP en VB6 par les API de wininet.dll. Tout fonctionne bien pour le moment sauf que j'aimerai Déplacer fichier ftp [ par bobertin89 ] Salut à tous, je cherche un moyen de déplacer un fichier présent sur un serveur distant vers un autre répertoire de ce même serveur. Or, la fonction [Catégorie modifiée .Net -> VBA] Récupérer nom de fichier ftp en les listant [ par johancc89 ] Bonjour, Je vous explique mon problème : j'ai une macro qui ouvre plusieurs fichiers. Seulement, l'environnement sur lequel les fichiers sont hébergé Télécharger un fichier depuis un serveur FTP [ par ThomasIsComingBack ] Bonjour, J'aimerais savoir comment je pourrais faire pour télécharger un fichier sur mon serveur FTP (avec Login et Mot De Passe). Pour l'instant j'ai Gestion des fichiers FTP [ par billyboy777 ] Bonjour a tous, Je développe en vb.net une application permettant des transfert, download, upload etc sur un serveur FTP. Mon premier problème est l' tranfert sur ftp [ par stickbuzz ] je cherche a envoyer 1 fichier defini sur 1 serveur ftp avec winsock......je comprends pas tt.......je c pas si je me connecte au serveur mais ce qui

Nos sponsors

Derniers Blogs

CONF'SHAREPOINT : 10 BONNES RAISONS POUR NE PAS LA RATER par pierre

[EVENT] SOIRéE DE LANCEMENT AGILE .NET FRANCE à LYON par thavo

.NET / DEBUG : INSPECTION DE LA MéMOIRE D'APPLICATIONS .NET (DUMP OU PROCESSUS LIVE) : PREMIèRE LIVRAISON D'UNE LIBRAIRIE .NET PAR MICROSOFT par coq

SHAREPOINT : INCOMPATIBILITé AVEC INTERNET EXPLORER 10 (IE10) par ROMELARD Fabrice

AUTOSPINSTALLER POUR SHAREPOINT 2013 MAINTENANT DISPONIBLE EN "RTM" par neodante

Forum

RE : PROBLèME VISUAL STUDIO ET MCI. par Guillamue06

RE : ABSOLUTEPOSITION EN VB.NET./ ADO.NET par ucfoutu

RE : PROBLèME VISUAL STUDIO ET MCI. par cmarcotte

RE : ABSOLUTEPOSITION EN VB.NET./ ADO.NET par cmarcotte

Côté IT

Offres d'emploi

Formations Video

Appels d'offres

Adaptation d-un calendrier AJAX a nos besoins specifique
Budget : 1 500€
Generateur de PDF
Budget : 700€
erp-crm en bourgogne
Budget : 20 500€

Logiciels

Devis-Factures PHMSD (2.1.0.1)
DEVIS-FACTURES PHMSD (2.1.0.1)

Configuration minimale Nécessite Windows™ 2000, XP, Windows 7, 8, Vista (Service Pack à...

Cliquez pour télécharger Devis-Factures PHMSD
Ludoprêt (3.2)
LUDOPRêT (3.2)

Logiciel gratuit de gestion de ludothèque. Gestion des jeux et des adhérents. Gestion des for...

Cliquez pour télécharger Ludoprêt
Revealer Keylogger Free (2.05)
REVEALER KEYLOGGER FREE (2.05)

Keylogger invisible et gratuit pour Windows 8, 7, Vista ou XP. Revealer Keylogger Free vous perme...

Cliquez pour télécharger Revealer Keylogger Free
974 Application Server (13.2.1.3)
974 APPLICATION SERVER (13.2.1.3)

Ecommerce, Blogueur, Vitrine, Newsletter, Java IDE, ..., in the cloud et sous haute dispo. Facile...

Cliquez pour télécharger 974 Application Server
WDmemoCode (1.0.0)
WDMEMOCODE (1.0.0)

WDmemoCode a été créé pour aider les développeurs Windev à créer/compléter et conserver une base ...

Cliquez pour télécharger WDmemoCode