VB编的程序怎么样使物理内存的占用挪到虚拟内存里？

Question

载了桌面日立秀这个软件，发现运行的时候只占用内存376K,虚拟内存6M多，
请问这样的技术应该怎么实现？因为我用VB编的程序就几个按钮也得占用4M多内存有朋友说
主要使用的两个函数：Public Declare Function VirtualAlloc Lib "kernel32" Alias "VirtualAlloc" (lpAddress As Any, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Public Declare Function VirtualFree Lib "kernel32" Alias "VirtualFree" (lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long但是我不知道具体的用法，请指点

Answer 1

估计没那么容易吧.只这两个API?

Answer 2

这两个API从名字来看是完成在虚拟内存中产生空间和销毁空间的。

Answer 3

实际上使用时还要用到另外两个API：Private Declare Function VirtualLock Lib "kernel32" Alias "VirtualLock" (lpAddress As Any, ByVal dwSize As Long) As LongPrivate Declare Function VirtualUnlock Lib "kernel32" Alias "VirtualUnlock" (lpAddress As Any, ByVal dwSize As Long) As Long参考：http://dev.csdn.net/Develop/article/12/12457.shtm      在Win32中管理虚拟内存

Answer 4

类似如下：
Private Sub Form_Load()
    Dim LPTR As Long, lPtr2 As Long    LPTR = malloc("This string is being copied into memory.")
    
    'lets get it back out and display it in a msgbox
    MsgBox RetMemory(LPTR)
    
    'clean up
    FreeMemory LPTR
    LPTR = malloc("This is a concantenated string ")
    lPtr2 = malloc("that was created using the same technique.")
    MsgBox RetMemory(LPTR) & RetMemory(lPtr2)
End Sub
－－－－－－－－－
下面的写到模块里,
'Put together by Mouse
'[email protected]
'http://www.theblackhand.netPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Const LPTR = (&H0 Or &H40)Public Function malloc(Strin As String) As Long
    Dim PointerA As Long, lSize As Long
    
    lSize = LenB(Strin) 'Length of string in bytes.
    
    'Allocate the memory needed and returns a pointer to that memory
    PointerA = LocalAlloc(LPTR, lSize + 4)
    If PointerA <> 0 Then
        'Final allocation
        CopyMemory ByVal PointerA, lSize, 4
        If lSize > 0 Then
            'copy the string to that allocated memory.
            CopyMemory ByVal PointerA + 4, ByVal StrPtr(Strin), lSize
        End If
    End If
    'return the pointer to the string stored memory
    malloc = PointerA
End FunctionPublic Function RetMemory(PointerA As Long) As String
    Dim lSize As Long, sThis As String
    If PointerA = 0 Then
        GetMemory = ""
    Else
        'get the size of the string stored at pointer "PointerA"
        CopyMemory lSize, ByVal PointerA, 4
        If lSize > 0 Then
            'buffer a varible
            sThis = String(lSize \ 2, 0)
            'retrive the data at the address of "PointerA"
            CopyMemory ByVal StrPtr(sThis), ByVal PointerA + 4, lSize
            'return the buffer
            RetMemory = sThis
        End If
    End If
End FunctionPublic Sub FreeMemory(PointerA As Long)
    'frees up the memory at the address of "PointerA"
    LocalFree PointerA
End Sub

Answer 5

另一个例子：'This project requries a form with a listbox (List1) on it
'and a class module (MemoryBlock)'In the form:
Option Explicit
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type INTERNET_CACHE_ENTRY_INFO
    dwStructSize As Long
    lpszSourceUrlName As Long
    lpszLocalFileName As Long
    CacheEntryType As Long
    dwUseCount As Long
    dwHitRate As Long
    dwSizeLow As Long
    dwSizeHigh As Long
    LastModifiedTime As FILETIME
    ExpireTime As FILETIME
    LastAccessTime As FILETIME
    LastSyncTime As FILETIME
    lpHeaderInfo As Long
    dwHeaderInfoSize As Long
    lpszFileExtension As Long
    dwReserved As Long
    dwExemptDelta As Long
    'szRestOfData() As Byte
End Type
Private Declare Function FindFirstUrlCacheEntry Lib "wininet.dll" Alias "FindFirstUrlCacheEntryA" (ByVal lpszUrlSearchPattern As String, ByVal lpFirstCacheEntryInfo As Long, ByRef lpdwFirstCacheEntryInfoBufferSize As Long) As Long
Private Declare Function FindNextUrlCacheEntry Lib "wininet.dll" Alias "FindNextUrlCacheEntryA" (ByVal hEnumHandle As Long, ByVal lpNextCacheEntryInfo As Long, ByRef lpdwNextCacheEntryInfoBufferSize As Long) As Long
Private Declare Sub FindCloseUrlCache Lib "wininet.dll" (ByVal hEnumHandle As Long)
Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
Private Sub Form_Load()
    'KPD-Team 2001
    'URL: http://www.allapi.net/
    'E-Mail: [email protected]
    Dim ICEI As INTERNET_CACHE_ENTRY_INFO, Ret As Long
    Dim hEntry As Long, Msg As VbMsgBoxResult
    Dim MemBlock As New MemoryBlock
    'Start enumerating the visited URLs
    FindFirstUrlCacheEntry vbNullString, ByVal 0&, Ret
    'If Ret is larger than 0...
    If Ret > 0 Then
        '... allocate a buffer
        MemBlock.Allocate Ret
        'call FindFirstUrlCacheEntry
        hEntry = FindFirstUrlCacheEntry(vbNullString, MemBlock.Handle, Ret)
        'copy from the buffer to the INTERNET_CACHE_ENTRY_INFO structure
        MemBlock.ReadFrom VarPtr(ICEI), LenB(ICEI)
        'Add the lpszSourceUrlName string to the listbox
        If ICEI.lpszSourceUrlName <> 0 Then List1.AddItem MemBlock.ExtractString(ICEI.lpszSourceUrlName, Ret)
    End If
    'Loop until there are no more items
    Do While hEntry <> 0
        'Initialize Ret
        Ret = 0
        'Find out the required size for the next item
        FindNextUrlCacheEntry hEntry, ByVal 0&, Ret
        'If we need to allocate a buffer...
        If Ret > 0 Then
            '... do it
            MemBlock.Allocate Ret
            'and retrieve the next item
            FindNextUrlCacheEntry hEntry, MemBlock.Handle, Ret
            'copy from the buffer to the INTERNET_CACHE_ENTRY_INFO structure
            MemBlock.ReadFrom VarPtr(ICEI), LenB(ICEI)
            'Add the lpszSourceUrlName string to the listbox
            If ICEI.lpszSourceUrlName <> 0 Then List1.AddItem MemBlock.ExtractString(ICEI.lpszSourceUrlName, Ret)
        'Else = no more items
        Else
            Exit Do
        End If
    Loop
    'Close enumeration handle
    FindCloseUrlCache hEntry
    'Delete our memory block
    Set MemBlock = Nothing
    Msg = MsgBox("Do you wish to delete the Internet Explorer cache?", vbYesNo + vbDefaultButton2 + vbQuestion)
    If Msg = vbYes Then
        'loop trough the entries...
        For Ret = 0 To List1.ListCount - 1
            '...and delete them
            DeleteUrlCacheEntry List1.List(Ret)
        Next Ret
        MsgBox "Cache deleted..."
    End If
End Sub'In the class module 'MemoryBlock':
Option Explicit
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 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
Public Property Get Handle() As Long
    Handle = m_VirtualMem
End Property
'Allocates a specific amount of bytes in the Virtual Memory
Public Sub Allocate(lCount As Long)
    ReleaseMemory
    m_VirtualMem = VirtualAlloc(ByVal 0&, 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(hWritePointer As Long, 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(hReadPointer As Long, 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(hStartPointer As Long, 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)
    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
End Sub

Answer 6

占用 4M 多没关系，多半是被 msvbvm60, ole32, oleaut32 等占用。如果楼主要让占用内存数暂时减小的话，可以用：SetProcessWorkingSetSize GetCurrentProcess(), -1&, -1&不过只是暂时的，过一会儿又会恢复。

Answer 7

James0001(虾米—什么时候成大虾？) 
如果用一个定时器每隔一秒执行一次会不会有“副作用”？

Answer 8

我并不是觉得占用内存很大，只是对Vb实现这种技术很感兴趣，所以想要了解~另外请问James0001(虾米—什么时候成大虾？) 您的方法有什么副作用么？假如我定时执行会不会有什么不好的后果？

Answer 9

// 我并不是觉得占用内存很大，只是对Vb实现这种技术很感兴趣，所以想要了解~
// 另外请问James0001(虾米—什么时候成大虾？) 
// 您的方法有什么副作用么？假如我定时执行会不会有什么不好的后果？
唯一的副作用就是程序运行效率下降。  ：（因为那个方法实际上是叫 windows 把程序所占用的内存放到硬盘上，等用到时再从硬盘读入到真正的内存里。所以如果你定时执行的话 windows 就要不停地访问硬盘，使得效率下降。

Answer 10

//因为那个方法实际上是叫 windows 把程序所占用的内存放到硬盘上，等用到时再从硬盘读入到真正//的内存里。所以如果你定时执行的话 windows 就要不停地访问硬盘，使得效率下降。啊，看来我还是看看VirtualAlloc怎么用阿

Answer 11

我觉得 SetProcessWorkingSetSize GetCurrentProcess(), -1&, -1&
方法似乎并没有占用很多资源，并没有使程序速度下降很多~不知道还有没有其他后遗症

Answer 12

VerQueryValue VB声明 
Declare Function VerQueryValue& Lib "version.dll" Alias "VerQueryValueA" (pBlock As Byte, ByVal lpSubBlock As String, lplpBuffer As Long, puLen As Long) 
说明 
这个函数用于从版本资源中获取信息。调用这个函数前，必须先用GetFileVersionInfo函数获取版本资源信息。这个函数会检查资源信息，并将需要的数据复制到一个缓冲区里 
返回值 
Long，TRUE（非零）表示成功，如请求的信息不存在，或pBlock不属于有效版本信息，那就返回一个零 
参数表 
参数 类型及说明 
pBlock Byte，指定一个内存块第一个字节的地址。这个内存块包含了由GetFileVersionInfo函数取回的版本数据信息 
lpSubBlock String，下述值之一： 
"\" 获取文件的VS_FIXEDFILEINFO结构 
"\VarFileInfo\Translation" 获取文件的翻译表 
"\StringFileInfo\...." 获取文件的字串信息。参考注解 
lplpBuffer Long，指定一个Long变量的地址，该变量用于装载一个缓冲区的地址。请求的版本信息最终会装载到那个缓冲区里 
puLen Long，指定由lplpBuffer参数引用的数据值的长度，以字节为单位 
注解 
如lplpBuffer参数为"\StringFileInfo\...."，缓冲区里就会载入一个整数数组。每一对整数都代表一种语言和代码页，它们描绘了可用的字串信息。通过用下面这三个部分指定一个字串，从而获得StringFileInfo字串数据："\StringFileInfo\languagecodepage\stringname"，其中languagecodepage（语言代码页）是采用字串形式的一个8字符十六进制数字。如翻译表中的语言代码页条目是&H04090000，那么这个字串就应该是"04090000"。stringname（字串名）指定的是一个字串名。这个参数的一个例子如下：
"\StringFileInfo\04090000\CompanyName"
 
其他 
从vb的api文本查看器复制的声明如下：
Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValue" (pBlock As Any, ByVal lpSubBlock As String, ByVal lplpBuffer As Long, puLen As Long) As Long Top
 

Answer 13

我想单独一个 程序,并不能把自身加载到虚拟内存中,如果你要实现
建议 你参考 Exe 压缩程序(网上有相应的汇编源码) 和PE 结构
exe 压缩程序: 起实 是 两个程序, 压缩部分是程序的主体,解压缩部分是程序的启动
原理是: 解压部分先启动, 分配 主体需要的内存,解压缩主体,并将启动指向在内存中的主体程序
你所需要的就是把内存中的主体放到虚拟内存中
当然 Vb 是不可能实现这些的,因为 vb 的运行库会自动把 程序加载到内存

Answer 14

vb真的不可能实现么 delphi可以做到的 vb应该也可以把

Answer 15

vbangle(我也许能帮助你，你也要帮助我呀) 您好:
  第一个例子我试了,好象没什么作用.第二个太长了没试.

Answer 16

我已经找到了该软件的缩进虚拟内存的API,如果你开1000 分,我就告诉你

Answer 17

楼上的有点病，喜欢CSDN 1000 分，呵呵

Answer 18

我已经将 该方法 放在我的Blog ，自己去看将物理内存的占用挪到虚拟内存里-----揭密篇http://blog.csdn.net/zlt982001/archive/2005/08/28/466879.aspx