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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
| Option Explicit On
Imports System
Imports System.Runtime.InteropServices.ComTypes.FILETIME
Imports System.Runtime.InteropServices
Public Class MemoryBlock
Private Const MEM_DECOMMIT = &H4000
Private Const MEM_RELEASE = &H8000
Private Const MEM_COMMIT = &H1000
Private Const MEM_RESERVE = &H2000
Private Const MEM_RESET = &H80000
Private Const MEM_TOP_DOWN = &H100000
Private Const PAGE_READONLY = &H2
Private Const PAGE_READWRITE = &H4
Private Const PAGE_EXECUTE = &H10
Private Const PAGE_EXECUTE_READ = &H20
Private Const PAGE_EXECUTE_READWRITE = &H40
Private Const PAGE_GUARD = &H100
Private Const PAGE_NOACCESS = &H1
Private Const PAGE_NOCACHE = &H200
Private Const n1 = 0&
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal pDest As Long, ByVal pSrc As Long, ByVal ByteLen As Long)
Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function VirtualLock Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long) As Long
Private Declare Function VirtualUnlock Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long) As Long
Private Declare Function IsBadReadPtr Lib "kernel32" (ByVal lp As Long, ByVal ucb As Long) As Long
Private Declare Function IsBadWritePtr Lib "kernel32" (ByVal lp As Long, ByVal ucb As Long) As Long
Private Declare Function IsBadStringPtr Lib "kernel32" Alias "IsBadStringPtrA" (ByVal lpsz As Long, ByVal ucchMax As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpStringDest As String, ByVal lpStringSrc As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
Private m_VirtualMem As Long, lLength As Long
'Returns the handle of the allocated memory
<StructLayout(LayoutKind.Explicit, Size:=80)> Public Structure INTERNET_CACHE_ENTRY_INFO
<FieldOffset(0)> Public dwStructSize As Short
<FieldOffset(4)> Public lpszSourceUrlName As IntPtr
<FieldOffset(8)> Public lpszLocalFileName As IntPtr
<FieldOffset(12)> Public CacheEntryType As Short
<FieldOffset(16)> Public dwUseCount As Short
<FieldOffset(20)> Public dwHitRate As Short
<FieldOffset(24)> Public dwSizeLow As Short
<FieldOffset(28)> Public dwSizeHigh As Short
<FieldOffset(32)> Public LastModifiedTime As System.Runtime.InteropServices.ComInterfaceType
<FieldOffset(40)> Public ExpireTime As System.Runtime.InteropServices.ComInterfaceType
<FieldOffset(48)> Public LastAccessTime As System.Runtime.InteropServices.ComInterfaceType
<FieldOffset(56)> Public LastSyncTime As System.Runtime.InteropServices.ComInterfaceType
<FieldOffset(64)> Public lpHeaderInfo As IntPtr
<FieldOffset(68)> Public dwHeaderInfoSize As Short
<FieldOffset(72)> Public lpszFileExtension As IntPtr
<FieldOffset(76)> Public dwReserved As Short
<FieldOffset(76)> Public dwExemptDelta As Short
End Structure
Public Property Handle() As Long
Get
Handle = m_VirtualMem
End Get
Set(ByVal value As Long)
End Set
End Property
'Allocates a specific amount of bytes in the Virtual Memory
Public Sub Allocate(ByVal lCount As Long)
ReleaseMemory()
Application.DoEvents()
m_VirtualMem = VirtualAlloc(n1, lCount, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
VirtualLock(m_VirtualMem, lCount)
End Sub
'Reads from the allocated memory and writes it to a specified pointer
Public Sub ReadFrom(ByVal hWritePointer As Long, ByVal lLength As Long)
If IsBadWritePtr(hWritePointer, lLength) = 0 And IsBadReadPtr(Handle, lLength) = 0 Then
CopyMemory(hWritePointer, Handle, lLength)
End If
End Sub
'Writes to the allocated memory and reads it from a specified pointer
Public Sub WriteTo(ByVal hReadPointer As Long, ByVal lLength As Long)
If IsBadReadPtr(hReadPointer, lLength) = 0 And IsBadWritePtr(Handle, lLength) = 0 Then
CopyMemory(Handle, hReadPointer, lLength)
End If
End Sub
'Extracts a string from the allocated memory
Public Function ExtractString(ByVal hStartPointer As Long, ByVal lMax As Long) As String
Dim Length As Long
If IsBadStringPtr(hStartPointer, lMax) = 0 Then
ExtractString = Space(lMax)
lstrcpy(ExtractString, hStartPointer)
Length = lstrlen(hStartPointer)
If Length >= 0 Then ExtractString = Left$(ExtractString, Length)
Else
ExtractString = ""
End If
End Function
'Release the allocated memory
Public Sub ReleaseMemory()
If m_VirtualMem <> 0 Then
VirtualUnlock(m_VirtualMem, lLength)
VirtualFree(m_VirtualMem, lLength, MEM_DECOMMIT)
VirtualFree(m_VirtualMem, 0, MEM_RELEASE)
m_VirtualMem = 0
End If
End Sub
Private Sub Class_Terminate()
ReleaseMemory()
Application.DoEvents()
End Sub
End Class
et dans une classe MemoryBlock.vb
Option Explicit On
Imports System
Imports System.Runtime.InteropServices.ComTypes.FILETIME
Imports System.Runtime.InteropServices
Public Class MemoryBlock
Private Const MEM_DECOMMIT = &H4000
Private Const MEM_RELEASE = &H8000
Private Const MEM_COMMIT = &H1000
Private Const MEM_RESERVE = &H2000
Private Const MEM_RESET = &H80000
Private Const MEM_TOP_DOWN = &H100000
Private Const PAGE_READONLY = &H2
Private Const PAGE_READWRITE = &H4
Private Const PAGE_EXECUTE = &H10
Private Const PAGE_EXECUTE_READ = &H20
Private Const PAGE_EXECUTE_READWRITE = &H40
Private Const PAGE_GUARD = &H100
Private Const PAGE_NOACCESS = &H1
Private Const PAGE_NOCACHE = &H200
Private Const n1 = 0&
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal pDest As Long, ByVal pSrc As Long, ByVal ByteLen As Long)
Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function VirtualLock Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long) As Long
Private Declare Function VirtualUnlock Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long) As Long
Private Declare Function IsBadReadPtr Lib "kernel32" (ByVal lp As Long, ByVal ucb As Long) As Long
Private Declare Function IsBadWritePtr Lib "kernel32" (ByVal lp As Long, ByVal ucb As Long) As Long
Private Declare Function IsBadStringPtr Lib "kernel32" Alias "IsBadStringPtrA" (ByVal lpsz As Long, ByVal ucchMax As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpStringDest As String, ByVal lpStringSrc As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
Private m_VirtualMem As Long, lLength As Long
'Returns the handle of the allocated memory
<StructLayout(LayoutKind.Explicit, Size:=80)> Public Structure INTERNET_CACHE_ENTRY_INFO
<FieldOffset(0)> Public dwStructSize As Short
<FieldOffset(4)> Public lpszSourceUrlName As IntPtr
<FieldOffset(8)> Public lpszLocalFileName As IntPtr
<FieldOffset(12)> Public CacheEntryType As Short
<FieldOffset(16)> Public dwUseCount As Short
<FieldOffset(20)> Public dwHitRate As Short
<FieldOffset(24)> Public dwSizeLow As Short
<FieldOffset(28)> Public dwSizeHigh As Short
<FieldOffset(32)> Public LastModifiedTime As System.Runtime.InteropServices.ComInterfaceType
<FieldOffset(40)> Public ExpireTime As System.Runtime.InteropServices.ComInterfaceType
<FieldOffset(48)> Public LastAccessTime As System.Runtime.InteropServices.ComInterfaceType
<FieldOffset(56)> Public LastSyncTime As System.Runtime.InteropServices.ComInterfaceType
<FieldOffset(64)> Public lpHeaderInfo As IntPtr
<FieldOffset(68)> Public dwHeaderInfoSize As Short
<FieldOffset(72)> Public lpszFileExtension As IntPtr
<FieldOffset(76)> Public dwReserved As Short
<FieldOffset(76)> Public dwExemptDelta As Short
End Structure
Public Property Handle() As Long
Get
Handle = m_VirtualMem
End Get
Set(ByVal value As Long)
End Set
End Property
'Allocates a specific amount of bytes in the Virtual Memory
Public Sub Allocate(ByVal lCount As Long)
ReleaseMemory()
Application.DoEvents()
m_VirtualMem = VirtualAlloc(n1, lCount, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
VirtualLock(m_VirtualMem, lCount)
End Sub
'Reads from the allocated memory and writes it to a specified pointer
Public Sub ReadFrom(ByVal hWritePointer As Long, ByVal lLength As Long)
If IsBadWritePtr(hWritePointer, lLength) = 0 And IsBadReadPtr(Handle, lLength) = 0 Then
CopyMemory(hWritePointer, Handle, lLength)
End If
End Sub
'Writes to the allocated memory and reads it from a specified pointer
Public Sub WriteTo(ByVal hReadPointer As Long, ByVal lLength As Long)
If IsBadReadPtr(hReadPointer, lLength) = 0 And IsBadWritePtr(Handle, lLength) = 0 Then
CopyMemory(Handle, hReadPointer, lLength)
End If
End Sub
'Extracts a string from the allocated memory
Public Function ExtractString(ByVal hStartPointer As Long, ByVal lMax As Long) As String
Dim Length As Long
If IsBadStringPtr(hStartPointer, lMax) = 0 Then
ExtractString = Space(lMax)
lstrcpy(ExtractString, hStartPointer)
Length = lstrlen(hStartPointer)
If Length >= 0 Then ExtractString = Left$(ExtractString, Length)
Else
ExtractString = ""
End If
End Function
'Release the allocated memory
Public Sub ReleaseMemory()
If m_VirtualMem <> 0 Then
VirtualUnlock(m_VirtualMem, lLength)
VirtualFree(m_VirtualMem, lLength, MEM_DECOMMIT)
VirtualFree(m_VirtualMem, 0, MEM_RELEASE)
m_VirtualMem = 0
End If
End Sub
Private Sub Class_Terminate()
ReleaseMemory()
Application.DoEvents()
End Sub
End Class |
