Large_Integer

[Matthew Holton]

Hello All,

Here is what I am attempting to accomplish...

Using the API SetFilePointer, I want to position my pointer above the 2GB limit.

Type Large_Integer
Hi32 as long
Lo32 as long
End Type

....

Public Sub WriteOut(Pos As Currency, Data() As Byte)
Dim iMover as Large_Integr
CLargeInt(Pos, iMover)
iMover.Lo32 = SetFilePointer(hOrgFile, iMover.Lo32, iMover.Hi32, FILE_BEGIN)
....
End Sub

Private Sub CLargeInt(InBound as currency, OutBound as Large_Integer)
'Here is where I am stuck
End Sub

Thanks in Advance,

Matthew

[Joe "Nuke Me Xemu" Foster]

"Matthew Holton" <anon...@discussions.microsoft.com> wrote in message <news:C82ECA0A-8045-472B...@microsoft.com>...

> Here is what I am attempting to accomplish...
>
>
> Using the API SetFilePointer, I want to position my pointer above the 2GB limit.
>
> Type Large_Integer
> Hi32 as long
> Lo32 as long
> End Type
>
> ...
>

> Public Sub WriteOut(Pos As Currency, Data() As Byte)
> Dim iMover as Large_Integr
> CLargeInt(Pos, iMover)
> iMover.Lo32 = SetFilePointer(hOrgFile, iMover.Lo32, iMover.Hi32, FILE_BEGIN)
> ...

> End Sub
>
>
> Private Sub CLargeInt(InBound as currency, OutBound as Large_Integer)
> 'Here is where I am stuck
> End Sub

This may or may not be faster than calls to RtlMoveMemory:

Private Type BigEndian64
High As Long
Low As Long
End Type

Private Type LittleEndian64
Low As Long
High As Long
End Type

Private Type Currency64
Value As Currency
End Type

Private Sub CLargeInt(InBound as currency, OutBound as Large_Integer)

Dim C64 As Currency64, LE64 As LittleEndian64

C64.Value = InBound ' * 0.0001@
LSet LE64 = C64

OutBound.Hi32 = LE64.High
OutBound.Lo32 = LE64.Low
End Sub

--
Joe Foster <mailto:jlfoster%40znet.com> "Regged" again? <http://www.xenu.net/>
WARNING: I cannot be held responsible for the above They're coming to
because my cats have apparently learned to type. take me away, ha ha!

[Matthew Holton]

That will do it, Thanks. For anyone else interested in seeing the solution....

***This code will genereate a file 2049MB in size, breaking the 2GB (2048MB) limit that is impossed on the
***PUT and GET Statements used in VB (BTW Moving with the API seems really slow, may it can be tweeked.)
***This is still very much a work in progress
***Next Stop Linked-Lists and AVL and Red-Black Trees (oh boy!)

***Make sure you have the HD space to create a file of this size, doh! the results are not pretty.

Module::modMain

Public Const MOVEFILE_REPLACE_EXISTING = &H1
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_BEGIN = 0
Public Const FILE_CURRENT = 1
Public Const FILE_END = 2
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const CREATE_NEW = 1
Public Const OPEN_EXISTING = 3
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000

'Holds our pointer to desired position
Public Type SIMPLE_INTEGER

Value As Currency
End Type

'Holds our pointer to the actual postion
Public Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type

Public Sub CreateABigFile(strFileName as string)

Dim aByte(8192) As Byte
Dim iFile As Currency
Dim sFile As String
Dim iLoop As Long
Dim bLoop As Long
Dim cpos As Long
Dim objDataFile As Datafile
Dim iRet As Long

Const strstringa As String = "Begin data..............................................End Data"

For bLoop = 1 To 8192 Step 64
For iLoop = 0 To 63
cpos = iLoop + bLoop
aByte(cpos) = Asc(Mid(strstringa, iLoop + 1, 1))
Next iLoop
Next bLoop

Set objDataFile = New Datafile
iRet = objDataFile.OpenFile(strFileName, GENERIC_WRITE, 0, ByVal 0&, OPEN_EXISTING, 0, 0)

iFile = -1
For bLoop = 1 To 2049
Debug.Print "Increasing to a " & bLoop & "MB file."
For iLoop = 1 To 128
iFile = iFile + 1
objDataFile.MoveToPos (CDec(iFile) * CDec(8192)), FILE_BEGIN
objDataFile.WriteToFile aByte, UBound(aByte), 0&, ByVal 0&
'WriteOut (CDec(iFile) * CDec(8192)), aByte
DoEvents
Next iLoop
Debug.Print "File is now " & bLoop & "MB."
Next bLoop
Set objDataFile = Nothing
End Sub

Class::DataFile

Option Explicit

'set this to 0 to disable debug code in this class
#Const DebugMode = 1

#If DebugMode Then
'local variable to hold the serialized class ID that was created in Class_Initialize
Private mlClassDebugID As Long
#End If

Public Key As String

Private Type BigEndian64
High As Long
Low As Long
End Type

Private Type LittleEndian64
Low As Long
High As Long
End Type

Private Type Currency64
Value As Currency
End Type

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 mvarFilePath As String
Private mvarDatabaseID As String
Private mvarFileHandle As Long
Private mvarIsOpen As Boolean

Private Function InitDatabase() As Long

End Function
Private Function ReadHeaderInfo() As Long

End Function
Public Function MoveToPos(pos As Currency, ByVal dwMoveMethod As Long) As Currency

Dim iMover As LARGE_INTEGER

CLargeInt pos, iMover
iMover.lowpart = SetFilePointer(mvarFileHandle, iMover.lowpart, iMover.highpart, dwMoveMethod)

End Function
Public Function WriteToFile(Data() As Byte, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long

WriteToFile = WriteFile(mvarFileHandle, Data(1), UBound(Data), lpNumberOfBytesWritten, ByVal lpOverlapped)

End Function
Public Function CloseFile() As Long

If Not mvarFileHandle = 0 Then
CloseHandle mvarFileHandle
mvarFileHandle = 0
End If

End Function
Public Function OpenFile(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

Dim hOrgFile As Long

If mvarFileHandle <> 0 Then Exit Function

hOrgFile = CreateFile(lpFileName, dwDesiredAccess, dwShareMode, ByVal lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)

If hOrgFile <> 0 Then
mvarFileHandle = hOrgFile
OpenFile = mvarFileHandle
mvarIsOpen = True
End If

End Function

Public Property Get FileSize() As Long

On Error GoTo FileSizeGetErr

FileSize = GetFileSize(mvarFileHandle, 0)
Exit Property

FileSizeGetErr:
Call RaiseError(MyUnhandledError, "Datafile:FileSize Property Get")

End Property
Public Property Get FileHandle() As Long

On Error GoTo FileHandleGetErr

If mvarIsOpen Then
FileHandle = mvarFileHandle
End If

Exit Property

FileHandleGetErr:
Call RaiseError(MyUnhandledError, "Datafile:FileHandle Property Get")

End Property
Public Property Let DatabaseID(ByVal vData As String)

On Error GoTo DatabaseIDLetErr

mvarDatabaseID = vData
Exit Property

DatabaseIDLetErr:
Call RaiseError(MyUnhandledError, "Datafile:DatabaseID Property Let")

End Property
Public Property Get DatabaseID() As String

On Error GoTo DatabaseIDGetErr

DatabaseID = mvarDatabaseID
Exit Property

DatabaseIDGetErr:
Call RaiseError(MyUnhandledError, "Datafile:DatabaseID Property Get")

End Property
Public Property Let FilePath(ByVal vData As String)

On Error GoTo FilePathLetErr

If mvarFilePath <> "" Then Exit Property
mvarFilePath = vData
Exit Property

FilePathLetErr:
Call RaiseError(MyUnhandledError, "Datafile:FilePath Property Let")

End Property
Public Property Get FilePath() As String

On Error GoTo FilePathGetErr

FilePath = mvarFilePath
Exit Property

FilePathGetErr:
Call RaiseError(MyUnhandledError, "Datafile:FilePath Property Get")

End Property
Private Sub Class_Initialize()
#If DebugMode Then
'get the next available class ID, and print out
'that the class was created successfully
mlClassDebugID = GetNextClassDebugID()
Debug.Print "'" & TypeName(Me) & "' instance " & mlClassDebugID & " created"
#End If
End Sub
Private Sub Class_Terminate()
'the class is being destroyed
#If DebugMode Then
Debug.Print "'" & TypeName(Me) & "' instance " & CStr(mlClassDebugID) & " is terminating"
#End If

CloseFile

End Sub
#If DebugMode Then
Public Property Get ClassDebugID()
'if we are in debug mode, surface this property that consumers can query
ClassDebugID = mlClassDebugID
End Property
#End If

Private Sub CLargeInt(InBound As Currency, OutBound As LARGE_INTEGER)

'Joe Foster <mailto:jlfoster%40znet.com> "Regged" again? <http://www.xenu.net/>
' Private Type BigEndian64

' High As Long
' Low As Long
' End Type
'
' Private Type LittleEndian64
' Low As Long
' High As Long
' End Type
'
' Private Type Currency64
' Value As Currency
' End Type

'
'Many thanks Joe

Dim C64 As Currency64, LE64 As LittleEndian64

C64.Value = InBound ' * 0.0001@
LSet LE64 = C64

OutBound.highpart = LE64.High
OutBound.lowpart = LE64.Low
End Sub