1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
| Option Explicit
'*********************Paramètres de Connexion FTP***********************
Dim FTPSERVER,USER,PASSWORD,RemoteFolder
FTPSERVER = "ftp.microsoft.com"
USER = "anonymous"
PASSWORD = "anonymous@anonymous.com"
RemoteFolder = "Softlib" 'un dossier du FTP
'***********************************************************************
Call Lister_Fichiers_FTP(FTPSERVER,USER,PASSWORD,RemoteFolder)
Dim Titre,SearchFile,ListFiles
Titre = "Test d'existence d'un fichier sur un serveur FTP : " & DblQuote(FTPSERVER) & " by Hackoo 2015"
SearchFile = "index.txt"
ListFiles = "TLIST.txt"
If Found(SearchFile,ListFiles) = True Then
MsgBox "Le fichier "& DblQuote(SearchFile) & " existes dans le dossier " & DblQuote(RemoteFolder) &_
" du serveur FTP " & DblQuote(FTPSERVER),vbInformation+vbSystemModal,Titre
Else
MsgBox "Le fichier "& DblQuote(SearchFile) & " n'existes pas dans le dossier " & DblQuote(RemoteFolder) &_
" du serveur FTP " & DblQuote(FTPSERVER),vbCritical+vbSystemModal,Titre
End If
'***********************************************************************
Sub Lister_Fichiers_FTP(FTPSERVER,USER,PASSWORD,RemoteFolder)
Dim fso,ws,output,ScriptFTP,Temp
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
Set fso = CreateObject("Scripting.FileSystemObject")
ScriptFTP = Temp & "\ftp.txt"
Set output = fso.CreateTextFile(Temp & "\ftp.txt",True)
output.WriteLine "open "& FTPSERVER
output.WriteLine USER
output.WriteLine PASSWORD
output.WriteLine "CD " & RemoteFolder
output.WriteLine "ls -h TLIST.txt"
output.WriteLine "bye"
output.Close
ws.Run "%comspec% /c ftp -s:"& ScriptFTP &"",0,True
fso.DeleteFile ScriptFTP
set ws = Nothing
set fso = Nothing
set output = Nothing
End Sub
'***********************************************************************
Function Found(MyString,File)
Dim objRegExpr,FSO,TF,inp,MyFile,colMatches
Found = False
Set objRegExpr = New regexp
objRegExpr.Pattern = MyString
objRegExpr.Global = True
Set FSO=CreateObject("Scripting.FileSystemObject")
Set TF=FSO.OpenTextFile(File,1)
colMatches = 0
inp=TF.ReadAll
Set colMatches = objRegExpr.Execute(inp)
If ColMatches.count = 1 then
Found = True
Else
Found = False
End if
Set colMatches = Nothing
Set objRegExpr = Nothing
End Function
'***********************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'*********************************************************************** |
