GFEnlargeFile/GFEnlargeFile.frm

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4695
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4695
   StartUpPosition =   3 'Windows‑Standard
   Begin VB.CommandButton Command1
      Caption         =   "Enlarge!"
      Height          =   375
      Left            =   2640
      TabIndex        =   1
      Top             =   180
      Width           =   1935
   End
   Begin VB.TextBox Text1
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Text            =   "c:\test.dat"
      Top             =   240
      Width           =   2355
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001, 2004 by Louis. Use to enlarge a large file without copying it. This function is a manipulation of GFShrinkFile.
'
'Downloaded from www.louis‑coder.com.
'Copy this form's code (except Command1_Click) to your project. With a call of
'GFEnlargeFile() you can increase the size of a file without writing data into it.
'So you can quickly reserve disk space, if that is of use for your app.
'
'GFEnlargeFile
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle 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 SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'GFEnlargeFile
Private Const OFS_MAXPATHNAME = 128
Private Const OF_READWRITE = &H2
Private Const FILE_BEGIN = 0
'GFEnlargeFile
Private Type OFSTRUCT
    cBytes As Byte
    fFixedDisk As Byte
    nErrCode As Integer
    Reserved1 As Integer
    Reserved2 As Integer
    szPathName(OFS_MAXPATHNAME) As Byte
End Type

Private Sub Command1_Click()
    'on error resume next 'testing sub
    Open Text1.Text For Output As #1
        Print #1, String$(2000, Chr$(32));
    Close #1
    Debug.Print FileLen(Text1.Text)
    Debug.Print GFEnlargeFile(Text1.Text, 2001)
    Debug.Print FileLen(Text1.Text)
    Kill Text1.Text
End Sub

Private Function GFEnlargeFile(ByVal EnlargeName As String, ByVal EnlargeNameSizeNew As Long) As Boolean
    'on error resume next 'enlarges a file; function returns True if file was enlarged, False if not
    Dim EnlargeNameHandle As Long
    Dim OFSTRUCTVar As OFSTRUCT
    Dim EnlargeFileTemp As Long
    'verify
    If ((Dir(EnlargeName) = "") Or (Right$(EnlargeName, 1) = "\") Or (EnlargeName = "")) Then 'verify
        GFEnlargeFile = False 'error
        Exit Function
    End If
    Select Case EnlargeNameSizeNew
    Case Is < FileLen(EnlargeName)
        GoTo Error:
    'Case Is > (2# ^ 32# ‑ 2#) 'VC++ help 'EnlargeNameSizeNew has the type Long anyway
    '    EnlargeNameSizeNew = (2# ^ 32# ‑ 2#)
    End Select
    'begin
    EnlargeNameHandle = OpenFile(EnlargeName, OFSTRUCTVar, OF_READWRITE)
    If EnlargeNameHandle = 0 Then GoTo Error: 'verify
    EnlargeFileTemp = SetFilePointer(EnlargeNameHandle, EnlargeNameSizeNew, 0, FILE_BEGIN)
    'If EnlargeFileTemp = 0 Then GoTo Error: 'functions returns something nobody understands
    EnlargeFileTemp = SetEndOfFile(EnlargeNameHandle)
    If EnlargeFileTemp = 0 Then GoTo Error: 'verify
    EnlargeFileTemp = CloseHandle(EnlargeNameHandle)
    If EnlargeFileTemp = 0 Then GoTo Error: 'verify
    GFEnlargeFile = True 'ok
    Exit Function
Error:
    Call CloseHandle(EnlargeNameHandle) 'make sure file is closed
    GFEnlargeFile = False 'error
    Exit Function
End Function


[END OF FILE]