|
转载:
2 U' c* M2 S: L8 p% n来教你如何在vb里嵌入汇编!: [% g3 ` ^' ?/ C
作者: wl3000wl
0 o; M1 r) g; i6 }8 W) T! n* I本贴绝对值得你珍藏.
$ E2 g5 `6 M8 p# W. M3 Y下面的例子完全用VB进行ASM编程的示例,本例获得CPU ID.. ?6 u' t( D6 f0 |+ B
工程文件分为一个form1.frm 和一个模块module1.bas
" ]1 q" O+ B' ?+ n; B1 |4 H----------------------form1.frm的源文件---------------------) t. N" Y7 H+ D: u) U* O
VERSION 5.002 B- ^$ P4 I. k: C- h3 j9 T& j) `
Begin VB.Form Form1
' S- d8 J* j' r Caption = "Form1"
% E7 g& B; B- g3 C8 P7 j ClientHeight = 1965
9 V, y/ D0 L" w' g; h( D ClientLeft = 608 v2 y* p/ `. y+ [* O, u" w- K, m9 b6 u
ClientTop = 345# \3 y M# S. w( H* a% G/ d/ u
ClientWidth = 3105
7 K5 ]( }' ^- y# X9 e, g LinkTopic = "Form1"" c, E I7 g6 r I2 w
ScaleHeight = 1965) d" k, R7 E2 ^
ScaleWidth = 3105% Q5 V- y% ]5 u
StartUpPosition = 2 'Bildschirmmitte
: \% |% H. P3 c! M4 r2 a% b# Z( }, O Begin VB.CommandButton Command1
2 D% j3 q$ R/ k0 F4 | Caption = "Get CPU Name"
' ~; L9 i- n6 v Height = 4951 y8 t8 R6 x h. Z
Left = 840/ B+ a! y& t$ r# I3 D' H
TabIndex = 0; ?+ o. B1 T/ q- \3 K0 @3 J
Top = 3152 j, G4 v7 `2 E, v% f4 _1 }
Width = 1425' y* o' ~# o3 V9 v6 i
End5 d4 B, L) v8 [0 U/ A0 \6 D1 O
Begin VB.Label Label2
, I7 p& {3 Z6 x% ^ Alignment = 2 'Zentriert/ X2 m# u- k& _, P! j& R
AutoSize = -1 'True
, [" a" ?. ^8 w BeginProperty Font
$ r& x5 x& i/ |3 s4 P6 |0 p% H6 f Name = "MS Sans Serif"3 G3 {' P, R2 s; k2 N2 n
Size = 9.75
. E1 f# @" S8 N) S/ z Charset = 0; Z+ Q2 A- i3 x# t3 D+ ~
Weight = 400
& Z9 { O, f4 J3 y Underline = 0 'False5 R7 m. W0 Z* ~; N1 U, M
Italic = 0 'False7 A! C- R- P* V: L& j
Strikethrough = 0 'False
. g: f# m/ W, p0 S8 j0 t EndProperty
1 M5 A5 R" y+ { Height = 240: \3 y+ E+ h1 }& X9 x+ J
Left = 1515
5 c s2 H z2 s6 L/ w* C TabIndex = 2 c7 n8 v3 Y; }; Z% A
Top = 1065
; l7 F3 N* e, P, ?, G( ]- U# x Width = 60
7 W$ g# ]! }! q* _1 { End B; C) X8 o# u" c4 r2 [" k
Begin VB.Label Label1 / m4 _8 H/ {. U/ ?1 a
Alignment = 2 'Zentriert) ~# k' M- z2 u% g5 M3 t
AutoSize = -1 'True
$ Y. O; q" n/ |8 W3 ?8 T6 {: T BeginProperty Font + g5 t8 U& T3 K2 A/ t, r
Name = "Arial") E& R1 V9 V* C7 B4 Z6 L
Size = 12
( Z# u% k( @; z* M Charset = 0
1 ^% O ?) A4 j Weight = 700
3 o8 T8 I5 i2 b, c Underline = 0 'False! O5 Z M! ~5 o, n$ d
Italic = 0 'False# R7 b+ a6 u, I
Strikethrough = 0 'False8 K1 L# Z" W0 ^7 \9 B
EndProperty# l% E/ ^) \# R5 f! L
Height = 285
* ?' i; G3 d" {# `0 V Left = 1515' u8 \$ E+ ]" R, L1 C
TabIndex = 1
4 j5 c! e4 I' ?% n1 G. Z* C Top = 13508 |# T2 ^1 Y& _2 F- Y
Width = 75
( r$ }( \8 B- n# s. r' n P End% @- W8 ^1 C7 X% [' |% a5 ]5 w
End
+ r2 v) U8 V9 |7 I7 z, h& p [Attribute VB_Name = "Form1"
6 @" H9 A8 j1 s" q+ ^ s+ Q9 |Attribute VB_GlobalNameSpace = False
( `! O6 b, ]' X0 |Attribute VB_Creatable = False
4 G6 l% o% A! Q5 M9 EAttribute VB_PredeclaredId = True
. D7 t; e" L, c/ OAttribute VB_Exposed = False
) v3 p# o' X0 n( \Option Explicit- {; Z1 ^$ a A& S2 S
4 ` r( j8 |. z8 f) c9 }! o3 ?
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)0 e& T. A/ B7 M
. _/ v! h& Z( B) K- H- ?) i F
Label1 = ""3 e, i a' ?# R6 W
Label2 = "". z1 N$ u" `% G' d) @ K
. ]& r5 f# @ I' Y) T
End Sub" m. D" @) r/ w6 z
( J, A$ c; M. }& z% IPrivate Sub Command1_Click()' h4 o' N, G( t
, `4 w3 W# p/ E/ e6 T Label1 = GetCpuName() & " CPU"4 D" y& Q' M* b$ [. ^, ]" h, b, S
Label2 = "You have a" & IIf(InStr("AEIOU", Left$(Label1, 1)), "n", "")
# g/ n7 ]6 A* o5 J! K5 ^$ m# x8 C& T$ }& j' G2 L7 j
End Sub
' g* B" @7 }; f------------------------------end---------------------------------
$ T+ m; u" s" v' D! h8 X. I& J5 g! M5 U( B4 ?: T* M' ]3 v; z
2 ^; M& Y6 S) w. k3 O' q
/ r; G* b% @/ N4 {8 X/ J( f( Z, O" n9 r# E4 z7 c* Z: F6 y
/ C/ \( u9 }, m% q$ U下面是modu1e.bas的源代码
6 @3 N8 q( B% P$ w4 @9 I& k4 I: T: t# u& _' i8 J1 b; H5 C
----------------------module1.bas的源文件--------------------------
! c' b# I+ {. ~, [4 J( [+ v7 kOption Explicit
! D! ]3 |' o' J4 T' a+ q'3 E# T' M5 @8 U1 u' W5 H/ u
'This shows how to incorporate machine code into VB
p7 ]) x& ?5 f'''''''''''''''''''''''''''''''''''''''''''''''''''
$ ]4 E3 C( @! t2 p: Z# K'The example fills the array with a few machine instructions and then copies
* A2 |! D# p" [% ~'them to a procedure address. The modified procedure is then called thru8 o1 m0 q1 Z9 ]6 W
'CallWindowProc. The result of this specific machine code is your CPU Vendor Name." S) g; w( |6 R
'9 _. t, w$ A3 G0 @
'##########################################################################% T; \, H+ R! `+ B" S5 ]% W
'Apparently it gets a Stack Pointer Error, but I don't know why; if anybody4 {! Z5 q0 S1 B( R! R) u/ c
'can fix that please let me know... UMGEDV@AOL.COM
* l# K: j( `$ J& ?'The Error is not present in the native compiled version; so I think it got, h1 l% y( C) Z" y4 O
'something to do with the P-Code Calling Convention (strange though)...
! z" p. A% ^- F2 K' y6 [* v'##########################################################################
$ s- q4 v0 D+ H': n; a4 U- u7 F/ l7 N+ b
'Sub Dummy serves to reserve some space to copy the machine instructions into.
6 }6 B. l2 B8 v5 b$ H! b$ f2 I'
6 g$ v2 v d* n* ]8 A$ ['
: h+ N% w" k' J/ `8 I$ x* l( ]'Tested on Intel and AMD CPU's (uncompiled and compiled)
4 T c N4 v' ~0 z7 Q8 t. q'
9 X2 J" B; `9 n7 J/ p' A; C# G'
2 I) j" o3 m) [! E: @9 l5 e* d: vPrivate Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long: Q( L" T# h! ]' H9 `3 [& |' [* Z
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)( A$ K& @% E! {- b; @+ M
Private x As Long5 ?- x. ?* g0 v; B
3 m. X* Y5 w+ e# l }Public Function GetCpuName() As String
% }& M! s; L! l7 e
9 s( w6 ]9 ]0 `! z, ~" ^2 s Dim MachineCode(0 To 35) As Byte
: ~% E. l- B* q" j% g Dim VarAddr As Long5 e/ K0 w4 l5 C5 h1 F
Dim FunctAddr As Long- d% q# _7 E& E# t% @2 c
Dim EAX As Long
9 |6 w& L! D: Z5 M Dim CPUName(1 To 12) As Byte
. Q/ n: E$ q2 B; D% z1 r/ s7 ~
* U4 H- D" o% E/ Q) S 'set up machine code j( t2 Z' d+ H4 h* G% Z4 W5 K" J0 X1 [
/ k1 t/ J3 g5 b; K1 p0 ]
MachineCode(0) = &H55 'push ebp
" r, G. [) V9 L& \# e r 4 x1 g' n5 f) {
MachineCode(1) = &H8B 'move ebp,esp) V9 _, r0 Q$ n( {% N
MachineCode(2) = &HEC% |4 O, A) M3 I( d. e. A; N
9 c7 n. S4 N( o7 h8 r9 U% f7 F MachineCode(3) = &H57 'push edi" b- {" h4 G% c) J/ c5 x7 T5 B
/ ]. H" o/ a v7 E6 P7 L X& n6 a MachineCode(4) = &H52 'push edx. C' R9 Z" @8 G0 w
. u/ G" l$ e9 S* Y/ R MachineCode(5) = &H51 'push ecx
2 S% F/ `4 L3 s4 {7 u/ b" P & L4 q* }2 x4 w$ O; \
MachineCode(6) = &H53 'push ebx( [* q7 k2 _6 }. d8 ?8 S
: V+ f. Z2 b" r: N
MachineCode(7) = &H8B 'move eax,dword ptr [ebp+8]
# T4 O; i$ d5 @; a0 n# f' t MachineCode(8) = &H45
- M" w+ {' F3 u. E3 T MachineCode(9) = &H8
9 V' J/ [) A; U - w' Y6 e: R: E4 {3 W: A
MachineCode(10) = &HF 'cpuid
* H) v) A! A- n3 F3 r MachineCode(11) = &HA27 A* x- {5 a; h% F5 L1 q
" W( A% c' U7 A1 A! l. N2 Z6 Q8 c. B MachineCode(12) = &H8B 'mov edi,dword ptr [ebp+12]
" H6 z$ f5 ]' o' v% p) w' V MachineCode(13) = &H7D
: g, w$ u/ L9 A" _& r2 Z+ I: S% ?" T MachineCode(14) = &HC* ^! [' K0 d; k0 Y: C
. Q0 B; }! d4 T2 M* b/ }9 k* X( A
MachineCode(15) = &H89 'move dword ptr [edi],ebx
0 C9 N; @8 y& ~ MachineCode(16) = &H1F
& E y! S! _2 I1 V $ y# E6 k9 m2 ]2 y4 H" A
MachineCode(17) = &H8B 'mov edi,dword ptr [ebp+16]
- j. f& E |- Z4 b; T MachineCode(18) = &H7D! a) `" u& c! s* `: N
MachineCode(19) = &H10# X) v' P3 `4 X" b2 f% \
) z) N- b' [0 x0 @ MachineCode(20) = &H89 'move dword ptr [edi],ecx$ A P6 a- j( Y4 y7 O R. z
MachineCode(21) = &HF7 ~' B; d; _7 H- _: P3 S$ v9 C! d& ]! \
8 ^' Q0 j& @0 J9 U8 X- Z, ^ MachineCode(22) = &H8B 'mov edi,dword ptr [ebp+20]6 t) J+ Z0 b& F( T4 c- V7 W
MachineCode(23) = &H7D
/ y, l& p7 ]5 x2 d/ a# X+ g5 ^- v MachineCode(24) = &H14; X" H3 [9 C0 ~( S
& O8 q( d& f$ F A) ]0 ?9 m MachineCode(25) = &H89 'move dword ptr [edi],edx% [" B+ x1 Y5 z& f2 g1 q
MachineCode(26) = &H17
$ r3 w. g: S. H9 D4 n 1 O: U- V ~! q" z: W+ {9 I
MachineCode(27) = &H58 'pop ebx6 r. M# q) @! t3 m0 k% a, H, W9 y
; ~% C6 k8 C- G2 c/ [4 I% g MachineCode(28) = &H59 'pop ecx
( `: k% Q5 l$ A# f. q" H, S2 |; U+ W( ^. A9 t; ]
MachineCode(29) = &H5A 'pop edx2 \* A& \% _" H* i7 L& o
- g, M- r) t1 H+ Y7 ?$ e4 p
MachineCode(30) = &H55 'pop edi+ @- o/ v4 g+ x4 O' |
x2 @1 j D. J; A
MachineCode(31) = &HC9 'leave
/ y3 m$ L2 U% F& ~9 D3 y# D
3 N$ O, b3 Q- p% y& M MachineCode(32) = &HC2 'ret 16 I tried everything from 0 to 24
. n5 f0 `! I2 T7 s6 k7 Q9 {. E/ e MachineCode(33) = &H10 ' but all produce the stack error: P+ k! Q* ? t3 V
MachineCode(34) = &H0( p B1 F6 a, j" L. P/ |- O& P
z" Z& L2 U. N% g2 `- c 'tell cpuid what we want
1 Y4 ?# A1 ~) s; ~2 |+ U EAX = 05 y4 Q: Y% [: l( A) c) m
! A+ l. r1 i( } R6 c2 k9 n 'get address of Machine Code7 A+ `" }" i2 K# i: y% h
VarAddr = VarPtr(MachineCode(0)): d+ H. p& @& Y% e1 B( q
1 X0 w: O; g4 g2 y* R* F
'get address of Sub Dummy
$ @* P$ y6 F) [: [7 M FunctAddr = GetAddress(AddressOf Dummy)
" q0 b5 E8 k; c. ~* r0 W 1 d7 n( m0 h: B. @! X# @- o
'copy the Machine Code to where it can be called4 |9 d8 t- c V. P( ?+ `! g
CopyMemory ByVal FunctAddr, ByVal VarAddr, 35 '35 bytes machine code, c+ C5 U$ h( o( O* g
9 [& i3 [- k: @0 `
'call it: Q. g, g5 B: G7 W1 J
On Error Resume Next 'apparently it gets a stack pointer error when in P-Code but i dont know why
6 r) e2 W. k% T- c/ e" _9 W CallWindowProc FunctAddr, EAX, VarPtr(CPUName(1)), VarPtr(CPUName(9)), VarPtr(CPUName(5))
" j" E& j6 [! f ]9 } 'Debug.Print Err; Err.Description G4 Y% R6 W- I2 y/ x
'MsgBox Err & Err.Description
5 V5 r4 m( O4 Q0 k On Error GoTo 03 G1 u/ y4 v t' Q* f
/ Q3 l! ]9 J$ e3 l; R+ L GetCpuName = StrConv(CPUName(), vbUnicode) 'UnicodeName9 x4 r$ Z. E' r2 I; G! P
+ f4 \. t* t/ D y0 Q' ~% w+ _End Function
7 ^& M! ?3 c4 E0 I- q: u4 X6 f* Q$ E2 u- g, p& }- h& L0 T! r
Private Function GetAddress(Address As Long) As Long
k3 }4 `+ o( v- F, z8 L$ d, k0 c7 W
: {; F! \ n) x' U2 E. V; S GetAddress = Address* q" ^; S/ w# i
6 t7 k+ |; H7 B4 lEnd Function7 [% r5 |' @' T" V
) p/ s: p! }1 IPrivate Sub Dummy()6 I9 J6 k+ W1 j! l* _6 p
$ _$ q) `5 |; I3 _
'the code below just reserves some space to copy the machine code into, j) ~0 x% T/ s6 T
'it is never executed
/ \. n* a1 @# f$ l0 [6 o8 y1 z4 {# X- ]( X' C9 U' N( @# N: p
x = 0% Q, j4 g, n+ z/ g
x = 1
* H" o6 J8 p1 E7 W6 @! d; j x = 27 }. H5 L% J* h# C( ]
x = 3, k. z/ ^# [* Y+ b8 s% q8 V% E
x = 4; s) ]. C( a. X3 K2 |# q$ m
x = 5
3 `( n- f1 b/ t- ` x = 63 `0 i U- I* J& u2 ?1 C2 ^! Z
x = 78 L3 D/ [% H) ^; G7 w1 w
x = 8
8 @& ]. y& D0 u2 Q; C8 V x = 9
# U; o. {9 g' G8 a- d x = 108 i6 } C V! x" Y. V6 @
x = 0
8 Z; I# X2 N# I+ e, h0 y3 ] x = 19 e3 ^3 r0 X1 v! Z
x = 21 A4 i P, n' V3 f- @9 h# H; r) E
x = 3
4 s+ p# f C: N3 D$ C6 \ x = 4% p! P6 I$ m. M3 h+ H
x = 5) n( Q ` k s/ i" V' a" G9 v
x = 6# x1 V' a* h) B, N1 s7 k8 u, a
x = 7
, \; z5 b7 Q7 q- j( v; w! [ x = 8
2 }2 J/ Y& Y1 ?% O! z x = 9
3 @) j, n+ D$ {' { x = 10
# u* s; T- d8 I 0 r$ y9 Z1 c& _! ]# l# i1 |
End Sub p: L& U4 L: M2 W% F8 |
------------------------------end--------------------------------------; R- W+ K! N$ t# J8 a) b
% @1 R' K: u# c4 ]# H" Y$ E( o
8 @/ d4 U8 e, G2 A- l; L a. M* u0 q1 K: A
|
|