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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
| Ip_Publique()
'************************************************************
'Ici Juste vous modifiez juste les trois premiers paramètres de votre connexion FTP
FTPUpload "83.xxx.xxx.xxx","Votre Login","Votre mot de passe","c:\script\monip.txt","/",sResults
'************************************************************
Sub Ip_Publique
Dim Titre,URL,ie,objFSO,Data,OutPut,objRegex,Match,Matches
Titre = "Adresse Ip Publique !"
URL = "http://monip.org"
Set ie = CreateObject("InternetExplorer.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
ie.Navigate (URL)
ie.Visible=false
DO WHILE ie.busy
wscript.sleep 100
LOOP
Data = ie.document.documentElement.innertext
Set OutPut = objfso.OpenTextFile("c:\script\monip.txt",8,True)
ie.Quit
Set ie = Nothing
Set objRegex = new RegExp
objRegex.Pattern = "\b([0-9]{1,3}\.){3}[0-9]{1,3}\b"
objRegex.Global = False
objRegex.IgnoreCase = True
Set Matches = objRegex.Execute(Data)
For Each Match in Matches
MsgBox "Mon IP Publique est : " & vbCr & Match.Value ,64,Titre
OutPut.WriteLine string(40,"-") & vbcr &" Nous sommes le "& Now & vbcr & string(40,"-") & vbcr & " Mon IP Publique est : "& Match.Value & vbcr & string(40,"*")
Next
Call OpenLog("c:\script\monip.txt")
End Sub
Sub OpenLog(File)
Dim ws
Set ws = CreateObject("wscript.shell")
ws.run "Notepad " & File,1,True
Set ws = Nothing
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)
'Vérifier si le chemin, contient des espaces.il faut 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
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 ""c:\script\monip.txt"" 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
'Fonction Pour Ajouter "les doubles quotes dans une variable"
Function qq(strIn)
qq = Chr(34) & strIn & Chr(34)
End Function |
