CopyMemory函数的应用两则

例则1：利用VB调用windows api函数来编写比较复杂的程序时，大家比较普遍遇到

的问题是很多API函数中使用到了指针调用，而VB本身并不支持指针的调用，所以在使

用了有些API之后，获得的只是指向想要获取的数据的32位指针，而无法得到具体的数

据，看下面的例子：

在Windows API中有一个Choosefont函数，这个函数可以弹出字体选择对话框让用户选择字体并且返回选择的字体类型、大小

等信息，这个函数在Windows API Help中是这样定义的：

BOOL ChooseFont(

LPCHOOSEFONT lpcf // pointer to structure with initialization data

);

参数lpcf是一个指向一个CHOOSEFONT结构的指针，而CHOOSEFONT结构的定义是这样的：

typedef struct { // cf

DWORD lStructSize;

HWND hwndOwner;

HDC hDC;

LPLOGFONT lpLogFont;

INT iPointSize;

DWORD Flags;

DWORD rgbColors;

LPARAM lCustData;

LPCFHOOKPROC lpfnHook;

LPCTSTR lpTemplateName;

HINSTANCE hInstance;

LPTSTR lpszStyle;

WORD nFontType;

WORD ___MISSING_ALIGNMENT__;

INT nSizeMin;

INT nSizeMax;

} CHOOSEFONT;

其中的成员lpLogFont又是一个指向一个LOGFONT结构的指针，而该指针指向的

LOGFONT结构的内存缓冲区中保存的正是用户选择的字体的信息，如果按照正常的VB

调用Windows API的方式，我们获得的只是一个32位的整型指针。那么在这里就要使用

到CopyMemory函数了。下面的具体的程序：

建立一个新的工程，将Form1的Name属性改变为Dialog，然后在Form中加入两个

CommandButton控件，Name属性分别改变为cmdShowFont和cmdShowColor，Caption属

性分别改变为“选择字体”和“选择颜色”在Form中加入一个PictureBox控件，将它的

Name属性改变为txtColor，加入一个TextBox控件，将它的Name属性改变为txtResult，

Dialog窗口的窗口界面入图1所示：

然后在Dialog窗口的代码窗口中加入以下的代码：

Option Explicit

Private Sub cmdShowFont_Click()

Dim myfont As CHOOSEFONT

Dim mylog As LOGFONT

Dim ret As Long

Dim lMem As Long

Dim astr As String * 32

Dim bstr As String

Dim i As Integer

lMem = GlobalAlloc(0, 60)

CopyMemoryM2P lMem, mylog.lfHeight, 60

myfont.lpLogFont = lMem

With myfont

.lStructSize = Len(myfont)

.flags = CF_SCREENFONTS Or CF_EFFECTS Or CF_INITTOLOGFONTSTRUCT 'Or CF_ENABLEHOOK

.hwndOwner = Me.hWnd

.iPointSize = 100

End With

ret = CHOOSEFONT(myfont)

If ret <> 0 Then

CopyMemoryP2M mylog.lfHeight, lMem, 60

txtColor.BackColor = myfont.rgbColors

CopyMemoryH2S astr, mylog.lfFaceName(0), 32

Debug.Print mylog.lfCharSet, mylog.lfHeight, mylog.lfWeight, mylog.lfWidth

bstr = Left$(astr, (InStr(astr, Chr(0)))) + vbNullChar

txtResult.Text = "选择的字体为：" + bstr

txtResult.Text = txtResult.Text + "大小为：" + Str(myfont.iPointSize / 10)

End If

GlobalFree lMem

End Sub

Private Sub cmdShowColor_Click()

Dim mycolor As ChooseColor

Dim ret As Long

With mycolor

.lStructSize = Len(mycolor)

.hwndOwner = Me.hWnd

.flags = 0

.lpCustColors = String$(16 * 4, 0)

End With

ret = ChooseColor(mycolor)

If ret <> 0 Then

txtColor.BackColor = mycolor.rgbResult

txtResult.Text = "选择的颜色为：" & mycolor.rgbResult

End If

End Sub

在工程文件中加入一个Modules文件，将文件保存为dlg.bas文件，然后在dlg.bas

文件中加入以下代码：

Option Explicit

Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long

Type ChooseColor

lStructSize As Long

hwndOwner As Long

hInstance As Long

rgbResult As Long

lpCustColors As String

flags As Long

lCustData As Long

lpfnHook As Long

lpTemplateName As String

End Type

Declare Function CHOOSEFONT Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As CHOOSEFONT) As Long

Public Declare Sub CopyMemoryP2M Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal _

hpvSource As Long, ByVal cbCopy As Long)

Public Declare Sub CopyMemoryM2P Lib "kernel32" Alias "RtlMoveMemory" (ByVal hpvDest As Long, _

hpvSource As Any, ByVal cbCopy As Long)

Public Declare Sub CopyMemoryH2S Lib "kernel32" Alias "RtlMoveMemory" (ByVal dst As String, _

src As Any, ByVal SIZE As Long)

Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long

Public Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long

Public Const GMEM_FIXED = &H0

Public Const CF_EFFECTS = &H100&

Public Const CF_SCREENFONTS = &H1

Public Const CF_INITTOLOGFONTSTRUCT = &H40&

Public Const CF_ENABLEHOOK = &H8&

Public Const BOLD_FONTTYPE = &H100

Public Const ITALIC_FONTTYPE = &H200

Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long

Const LF_FACESIZE = 32

Public Const WM_USER = &H400

Public Const WM_CHOOSEFONT_GETLOGFONT = (WM_USER + 1)

Public Type LOGFONT

lfHeight As Long

lfWidth As Long

lfEscapement As Long

lfOrientation As Long

lfWeight As Long

lfItalic As Byte

lfUnderline As Byte

lfStrikeOut As Byte

lfCharSet As Byte

lfOutPrecision As Byte

lfClipPrecision As Byte

lfQuality As Byte

lfPitchAndFamily As Byte

lfFaceName(0 To LF_FACESIZE - 1) As Byte

End Type

Public Type CHOOSEFONT

lStructSize As Long

hwndOwner As Long ' caller's window handle

hdc As Long ' printer DC/IC or NULL

lpLogFont As Long

iPointSize As Long ' 10 * size in points of selected font

flags As Long ' enum. type flags

rgbColors As Long ' returned text color

lCustData As Long ' data passed to hook fn.

lpfnHook As Long ' ptr. to hook function

lpTemplateName As String ' custom template name

hInstance As Long ' instance handle of.EXE that

' contains cust. dlg. template

lpszStyle As String ' return the style field here

' must be LF_FACESIZE or bigger

nFontType As Integer ‘ same value reported to the EnumFonts

' call back with the extra FONTTYPE_

' bits added

MISSING_ALIGNMENT As Integer

nSizeMin As Long ' minimum pt size allowed &

nSizeMax As Long ' max pt size allowed if

' CF_LIMITSIZE is used

End Type

Function CFHookproc(ByVal hDLG As Long, ByVal uiMsg As Long, ByVal wparam As Long, ByVal lparam As Long) As Long

If uiMsg = &H112 Then

Debug.Print wparam, lparam

End If

CFHookproc = 0

End Function

运行上面的程序，点击“选择字体”，然后在弹出的字体选择对话框中选择任意的字体

后点击“确定”按钮，选择的字体和字体大小信息就会出现在txtResult文本框中。

通过上面的程序可以看到，利用CopyMemory函数可以将一个内存指针指向的内存缓

冲区的内容拷贝到VB中定义的字符串数组、数据结构中。

例则2：文本的拷贝

在工程文件的Form1中加入一个CommandButton控件和两个TextBox控件，然后在

Form1的代码窗口中加入以下代码：

Private Declare Sub CopyMemoryH2S Lib "kernel32" Alias _

"RtlMoveMemory" (ByVal dst As String, ByVal _

src As Long, ByVal SIZE As Long)

Private Declare Sub CopyMemoryS2H Lib "kernel32" Alias _

"RtlMoveMemory" (ByVal dst As Long, ByVal src _

As String, ByVal SIZE As Long)

Private Declare Function GlobalAlloc Lib "kernel32" (ByVal _

wFlags As Long, ByVal dwBytes As Long) As Long

Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem _

As Long) As Long

Const GMEM_FIXED = &H0

Private Sub Command1_Click()

Dim mHandle As Long

Dim astr As String * 256

Dim bstr As String * 256

astr = Left$(Text1.Text, 255)

'分配一个300字节的内存块

mHandle = GlobalAlloc(GMEM_FIXED, 300)

'将字符串中的内容拷贝到分配的内存块中

CopyMemoryS2H mHandle, astr, 255

'将内存块的内容拷贝到字符串中

CopyMemoryH2S bstr, mHandle, 255

Text2.Text = bstr

GlobalFree mHandle

End Sub

运行程序，点击Command1，可以看到Text1中的文本内容拷贝到了text2中。

通过上面的两个范例可以看到，通过定义CopyMemory函数的不同变体，可以实现

内存中任意两块区域的拷贝，也可以在Windows中分配的内存和VB中定义的字符串、

数据结构之间互相拷贝，利用这个函数可以实现Windows中一些指针套指针的API调用

同时也简化了一些VB中关于内存的操作。例如在编写文本处理程序时就可以向上面范例

2中所示的一样，使用GlobalAlloc函数分配内存，使用CopyMemory函数在内存、文本控

件之中相互被数据，而不用定义一个个的String来操作数据。