Public Const PAGE_READWRITE = 4&
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const CREATE_ALWAYS = 2
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynA" _
(DesStr As Any, _
SrcStr As Any, _
ByVal MaxLen As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
#If Sampling Then
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Declare Function WriteFile Lib "kernel32" _
(ByVal hFile As Long, _
lPBuffer As Any, _
ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, _
ByVal lpOverlapped As Long) As Long
Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
#End If
#If Sampling Then
Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" _
(ByVal hFile As Long, _
ByVal lpFileMappingAttributes As Long, _
ByVal flProtect As Long, _
ByVal dwMaximumSizeHigh As Long, _
ByVal dwMaximumSizeLow As Long, _
ByVal lpName As String) As Long
#Else
Declare Function OpenFileMapping Lib "kernel32" Alias "OpenFileMappingA" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal lpName As String) As Long
#End If
Declare Function MapViewOfFile Lib "kernel32" _
(ByVal hFileMappingObject As Long, _
ByVal dwDesiredAccess As Long, _
ByVal dwFileOffsetHigh As Long, _
ByVal dwFileOffsetLow As Long, _
ByVal dwNumberOfBytesToMap As Long) As Long
Declare Function UnmapViewOfFile Lib "kernel32" _
(lpBaseAddress As Any) As Long
'
Public Sub InitVar()
DiskFileName = "D:\Article\Mapping\Sample"
MapFileName = DiskFileName & "Map"
Pub_LenDT = Len(Pub_FormatDT)
Pub_LenV = Len(Pub_FormatV)
LenBuffer = 1 Pub_LenDT (Pub_LenV 1) * Pub_LoopN
strBuffer = String(LenBuffer 1, "*")
FileHandle = 0
MapHandle = 0
MapAddress = 0
End Sub 'InitVar
Public Sub CopyToMap(S As String)
If MapAddress <> 0 Then
Call lstrcpyn(ByVal MapAddress, ByVal S, LenBuffer 1)
End If
End Sub
Public Sub GetFromMap(S As String)
If MapAddress <> 0 Then
Call lstrcpyn(ByVal S, ByVal MapAddress, LenBuffer 1)
End If
End Sub
Public Sub CloseMap()
If MapAddress <> 0 Then
Call UnmapViewOfFile(ByVal MapAddress)
MapAddress = 0
End If
If MapHandle <> 0 Then
Call CloseHandle(MapHandle)
MapHandle = 0
End If
If FileHandle <> 0 Then
Call CloseHandle(FileHandle)
FileHandle = 0
End If
End Sub 'CloseMap
#If Sampling Then
Public Sub CreateMap()
Dim w As Long
Call InitVar
FileHandle = CreateFile(DiskFileName, _
GENERIC_WRITE Or GENERIC_READ, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, _
0, _
CREATE_ALWAYS, _
FILE_ATTRIBUTE_NORMAL, _
0)
Call WriteFile(FileHandle, ByVal strBuffer, LenBuffer 1, w, 0)
Call FlushFileBuffers(FileHandle)
MapHandle = CreateFileMapping(FileHandle, _
0, _
PAGE_READWRITE, _
0, _
0, _
MapFileName)
MapAddress = MapViewOfFile(MapHandle, FILE_MAP_WRITE, 0, 0, 0)
End Sub 'CreateMap
#Else
Public Function OpenMap() As Long
Call InitVar
OpenMap = 0
MapHandle = OpenFileMapping(FILE_MAP_WRITE, False, MapFileName)
If MapHandle = 0 Then Exit Function
MapAddress = MapViewOfFile(MapHandle, FILE_MAP_WRITE, 0, 0, 0)
If MapAddress = 0 Then
Call CloseHandle(MapHandle)
MapHandle = 0
End If
OpenMap = MapAddress
End Function 'OpenMap
#End If 'Sampling
Manage.vbp也包含两个文件：Form1.frm，Module1.bas。清单如下：
Form1.frm:
VERSION 5.00
Begin VB.Form Form1
Caption = "Manage"
ClientHeight = 1440
ClientLeft = 48
ClientTop = 288
ClientWidth = 4416
LinkTopic = "Form1"
ScaleHeight = 1440
ScaleWidth = 4416
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton cmdStart
Caption = "Start"
Height = 372
Left = 1560
TabIndex = 1
Top = 240
Width = 972
End
Begin VB.TextBox Text1
Height = 372
Left = 120
TabIndex = 0
Text = "Text1"
Top = 840
Width = 4092
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 60
Left = 0
Top = 0
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!
