Discussion :

[rarfaoui]

Bonjour à tous,
je voudrais savoir comment determiner le numero de serie d'un processeuravec du code VB6. Normalement c posssible.
Merci beaucoup pour votre aide
A+

[sozie9372]

J'ai pas essayé mais t'as regardé ca ?
http://vb.developpez.com/sources/?pa...infoprocesseur
C'était dans les sources du site...
+++
Ju

[DarkVader]

Le code ci-dessus est assez limité, par contre il existe une superbe source citée par EBartSoft sur codes-source

'
' O O O
' \__/ \__/
' /=||=||=\ oouuuunnnnnnnnmmmmmmmmmmmmmm' // ||_|| CPUID DEMO ' \\ /\ #\ oouuuunnnnnnnnmmmmmmmmmmmmmmmm' /=( \ )==> Coded by EBArtSoft@ '// \O_\/ Copyright © 2004 '\\ || || email ebartsoft@hotmail.com ' \==||=||==/ oouuuunnnnnnnnmmmmmmmmmmmmmmmmmmmm' ===========
'==== E.B ====
'
' ALL RIGHTS RESERVED ::..
' Permission to use, copy, modify, and distribute this software for
' any purpose and without fee is hereby granted, provided that the
' above copyright notice appear in all copies and that both the copyright
' notice and this permission notice appear in supporting documentation.
'
' THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
' AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
' INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
' FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL WE BE LIABLE
' TO YOU OR ANYONE ELSE FOR ANY DIRECT, SPECIAL, INCIDENTAL, INDIRECT
' OR CONSEQUENTIAL DAMAGES OF ANY KIND, OR ANY DAMAGES WHATSOEVER,
' INCLUDING WITHOUT LIMITATION, LOSS OF PROFIT, LOSS OF USE, SAVINGS
' OR REVENUE, OR THE CLAIMS OF THIRD PARTIES, WHETHER OR NOT WE HAS BEEN
' ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
' ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
' POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As String, ByRef hWnd As Long, ByRef Msg As Long, ByRef wParam As Long, ByRef lParam As Long) As Long
 
 
Private Function GetCPUID() As String
    Dim Asm As String
    Dim eax As Long
    Dim ebx As Long
    Dim ecx As Long
    Dim edx As Long
    Dim Low As Long
    Asm = Asm & Chr(&H56) '56 push esi
    Asm = Asm & Chr(&H55) '55 push ebp
    Asm = Asm & Chr(&H8B) & Chr(&HEC) '8B EC mov ebp,esp
    Asm = Asm & Chr(&H8B) & Chr(&H75) & Chr(&HC) '8B 75 0C mov esi,dword ptr [ebp+0Ch]
    Asm = Asm & Chr(&H8B) & Chr(&H6) '8B 06 mov eax,dword ptr [esi]
    Asm = Asm & Chr(&HF) & Chr(&HA2) '0F A2 cpuid
    Asm = Asm & Chr(&H8B) & Chr(&H75) & Chr(&HC) '8B 75 0C mov esi,dword ptr [ebp+0Ch]
    Asm = Asm & Chr(&H89) & Chr(&H6) '89 06 mov dword ptr [esi],eax
    Asm = Asm & Chr(&H8B) & Chr(&H75) & Chr(&H10) '8B 75 10 mov esi,dword ptr [ebp+10h]
    Asm = Asm & Chr(&H89) & Chr(&H1E) '89 1E mov dword ptr [esi],ebx
    Asm = Asm & Chr(&H8B) & Chr(&H75) & Chr(&H14) '8B 75 14 mov esi,dword ptr [ebp+14h]
    Asm = Asm & Chr(&H89) & Chr(&HE) '89 0E mov dword ptr [esi],ecx
    Asm = Asm & Chr(&H8B) & Chr(&H75) & Chr(&H18) '8B 75 18 mov esi,dword ptr [ebp+18h]
    Asm = Asm & Chr(&H89) & Chr(&H16) '89 16 mov dword ptr [esi],edx
    Asm = Asm & Chr(&H5D) '5D pop ebp
    Asm = Asm & Chr(&H5E) '5E pop esi
    Asm = Asm & Chr(&HC2) & Chr(&H10) & Chr(&H0) 'C2 10 00 ret 10h
    eax = 1
    CallWindowProc Asm, eax, ebx, ecx, edx
    Low = eax
    eax = 3
    CallWindowProc Asm, eax, ebx, ecx, edx
    GetCPUID = HexVal(Low) & "-" & HexVal(ecx) & "-" & HexVal(edx)
End Function
 
Private Function HexVal(ByVal lngValue As Long) As String
    HexVal = Hex(lngValue)
    If Len(HexVal) < 8 Then HexVal = String(8 - Len(HexVal), "0") & HexVal
    HexVal = Left$(HexVal, 4) & "-" & Right$(HexVal, 4)
End Function

Mais c'est aussi possible en utilisant une référence à WMI Scripting
qui fournit une présentation un peu différente de l'identificateur.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Public Function idProc()
 
    Dim clsSvr As SWbemServices, clsSet As SWbemObjectSet, clsObj As SWbemObject
 
    Set clsSvr = GetObject("winmgmts:")
    Set clsSet = clsSvr.InstancesOf("Win32_Processor")
    For Each clsObj In clsSet
        For Each clsProp In clsObj.Properties_
            If clsProp.Name = "ProcessorId" Then
                idProc = CStr(clsProp.Value)
                Exit Function
            End If
        Next
    Next
endFunct:
    Set clsObj = Nothing
    Set clsSet = Nothing
    Set clsSvr = Nothing
End Function