Const MOVEFILE_REPLACE_EXISTING = &H1 Const FILE_ATTRIBUTE_TEMPORARY = &H100 Const FILE_BEGIN = 0 Const FILE_SHARE_READ = &H1 Const FILE_SHARE_WRITE = &H2 Const CREATE_NEW = 1 Const OPEN_EXISTING = 3 Const GENERIC_READ = &H80000000 Const GENERIC_WRITE = &H40000000 Private Declare Function SetVolumeLabel Lib "kernel32" Alias "SetVolumeLabelA" (ByVal lpRootPathName As String, ByVal lpVolumeName As String) As Long Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long Private Declare Function MoveFileEx Lib "kernel32" Alias "MoveFileExA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal dwFlags As Long) As Long Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long Private Sub Form_Load() 'KPD-Team 1998 'URL: http://www.allapi.net/ 'E-Mail: [email protected] Dim sSave As String, hOrgFile As Long, hNewFile As Long, bBytes() As Byte Dim sTemp As String, nSize As Long, Ret As Long 'Ask for a new volume label sSave = InputBox("Please enter a new volume label for drive C:\" + vbCrLf + " (if you don't want to change it, leave the textbox blank)") If sSave <> "" Then SetVolumeLabel "C:\", sSave End If 'Create a buffer sTemp = String(260, 0) 'Get a temporary filename GetTempFileName "C:\", "KPD", 0, sTemp 'Remove all the unnecessary chr$(0)'s sTemp = Left$(sTemp, InStr(1, sTemp, Chr$(0)) - 1) 'Set the file attributes SetFileAttributes sTemp, FILE_ATTRIBUTE_TEMPORARY 'Open the files hNewFile = CreateFile(sTemp, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0) hOrgFile = CreateFile("c:\config.sys", GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0) 'Get the file size nSize = GetFileSize(hOrgFile, 0) 'Set the file pointer SetFilePointer hOrgFile, Int(nSize / 2), 0, FILE_BEGIN 'Create an array of bytes ReDim bBytes(1 To nSize - Int(nSize / 2)) As Byte 'Read from the file ReadFile hOrgFile, bBytes(1), UBound(bBytes), Ret, ByVal 0& 'Check for errors If Ret <> UBound(bBytes) Then MsgBox "Error reading file ..." 'Write to the file WriteFile hNewFile, bBytes(1), UBound(bBytes), Ret, ByVal 0& 'Check for errors If Ret <> UBound(bBytes) Then MsgBox "Error writing file ..." 'Close the files CloseHandle hOrgFile CloseHandle hNewFile 'Move the file MoveFileEx sTemp, "C:\KPDTEST.TST", MOVEFILE_REPLACE_EXISTING 'Delete the file DeleteFile "C:\KPDTEST.TST" Unload Me End Sub
大约167.64GB!!!
你确定你的计算机能有这么大的内存?首先,目前家用/办公电脑的主板恐怕就没有哪个能支持这么大内存的;
其次,Win系统只有64位的才行(理论上行,实际上行不行未知)。
参考API SetFilePointer
2)new 开内存
当然也可以,用文件,数据库储存
每条记录 15000 个double 应该没问题
Const FILE_ATTRIBUTE_TEMPORARY = &H100
Const FILE_BEGIN = 0
Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
Const CREATE_NEW = 1
Const OPEN_EXISTING = 3
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000
Private Declare Function SetVolumeLabel Lib "kernel32" Alias "SetVolumeLabelA" (ByVal lpRootPathName As String, ByVal lpVolumeName As String) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function MoveFileEx Lib "kernel32" Alias "MoveFileExA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal dwFlags As Long) As Long
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: [email protected]
Dim sSave As String, hOrgFile As Long, hNewFile As Long, bBytes() As Byte
Dim sTemp As String, nSize As Long, Ret As Long
'Ask for a new volume label
sSave = InputBox("Please enter a new volume label for drive C:\" + vbCrLf + " (if you don't want to change it, leave the textbox blank)")
If sSave <> "" Then
SetVolumeLabel "C:\", sSave
End If 'Create a buffer
sTemp = String(260, 0)
'Get a temporary filename
GetTempFileName "C:\", "KPD", 0, sTemp
'Remove all the unnecessary chr$(0)'s
sTemp = Left$(sTemp, InStr(1, sTemp, Chr$(0)) - 1)
'Set the file attributes
SetFileAttributes sTemp, FILE_ATTRIBUTE_TEMPORARY
'Open the files
hNewFile = CreateFile(sTemp, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
hOrgFile = CreateFile("c:\config.sys", GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0) 'Get the file size
nSize = GetFileSize(hOrgFile, 0)
'Set the file pointer
SetFilePointer hOrgFile, Int(nSize / 2), 0, FILE_BEGIN
'Create an array of bytes
ReDim bBytes(1 To nSize - Int(nSize / 2)) As Byte
'Read from the file
ReadFile hOrgFile, bBytes(1), UBound(bBytes), Ret, ByVal 0&
'Check for errors
If Ret <> UBound(bBytes) Then MsgBox "Error reading file ..." 'Write to the file
WriteFile hNewFile, bBytes(1), UBound(bBytes), Ret, ByVal 0&
'Check for errors
If Ret <> UBound(bBytes) Then MsgBox "Error writing file ..." 'Close the files
CloseHandle hOrgFile
CloseHandle hNewFile 'Move the file
MoveFileEx sTemp, "C:\KPDTEST.TST", MOVEFILE_REPLACE_EXISTING
'Delete the file
DeleteFile "C:\KPDTEST.TST"
Unload Me
End Sub