Add bytes to any file

[Madboy]

This came from one of my older projects, so take note in the code of the required controls and name suffixes

Private Sub lblAdd_Click()
Dim lprog As Long
 
If txtFile.Text = "" Then
frmMessage!lblMessage.Caption = "Please select a file first to add required bytes to it."
frmMessage.Show vbModal
Else
lblPercent.Visible = True
lblStatus2.ForeColor = &HC0&
lblStatus2.Caption = "Working"
lblBytes3.Caption = "N/A"
lblFile3.Caption = "N/A"
lblTime2.Caption = "N/A"
 
If txtFile.Text <> "" And txtBytes.Text > 0 Then
fsiz = ShowFileSize(txtFile.Text)
prgMain.Value = 0
prgMain.Max = txtBytes.Text
prgMain.Visible = True
DoEvents
Me.Enabled = False
Open txtFile.Text For Binary As #1
For A = 1 To txtBytes.Text
Put #1, fsiz - 1 + A, 0
 
prgMain.Value = A
 
prgMain.Refresh
 
lprog = (A / txtBytes) * 100
lblPercent = lprog & "%"
lblPercent.Refresh
 
 
Next
Close
End If
prgMain.Visible = False
prgMain.Value = 0
lblPercent.Visible = False
lblStatus2.ForeColor = &H8000&
lblStatus2.Caption = "Ready"
lblBytes3.Caption = txtBytes.Text
lblFile3.Caption = Replace(txtFile.Text, "&", "&&")
lblTime2.Caption = Now
DoEvents
Me.Enabled = True
End If
End Sub
 
Function ShowFileSize(file)
    Dim fs, f, S
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(file)
    ShowFileSize = f.Size
    's = UCase(f.Name) & " uses " & f.Size & " bytes."
    'MsgBox s, 0, "Folder Size Info"
End Function
'94208
 
Private Sub lblFileBrowse_Click()
dlgFile.ShowOpen
txtFile.Text = dlgFile.FileName
End Sub

[Wokawidget]

Bad Wiggles, you could use:

Public Sub AmendFile(ByVal pstrFilename As String, ByRef pbytData() As Byte)
Dim intFile     As Integer
On Error GoTo ErrHandler
    'if required add code here to see if file exists
    intFile = FreeFile
    Open pstrFilename For Binary Access Write As #intFile
    Put #intFile, LOF(intFile) + 1, pbytData()
    Close #intFile
    Exit Sub
ErrHandler:
    Close #intFile
    Err.Raise Err.Number, Err.Source, Err.Description
End Sub

Woka

[Wokawidget]

Wiggles, you can even take this one step further and add the code to a class:

Option Explicit
 
Public Event Progress(ByVal BytesWritten As Long, ByVal TotalBytes As Long)
 
Public Sub AmendFile(ByVal pstrFilename As String, ByRef pbytData() As Byte)
Dim intFile     As Integer
Dim lngFileLen  As Long
Dim lngByteLen  As Long
Dim lngIndex    As Long
Dim lngLBound   As Long
Dim lngUBound   As Long
On Error GoTo ErrHandler
    'if required add code here to see if file exists
    intFile = FreeFile
    Open pstrFilename For Binary Access Write As #intFile
    lngFileLen = LOF(intFile)
    lngLBound = LBound(pbytData)
    lngUBound = UBound(pbytData)
    lngByteLen = lngUBound - lngLBound + 1
    For lngIndex = 1 To lngByteLen
        Put #intFile, lngFileLen + lngIndex, pbytData(lngLBound + lngIndex - 1)
        RaiseEvent Progress(lngIndex, lngByteLen)
    Next lngIndex
    Close #intFile
    Exit Sub
ErrHandler:
    Close #intFile
    Err.Raise Err.Number, Err.Source, Err.Description
End Sub

This will raise an event to your form so that you can display the progress of the writting if you wish.

Woof

[Madboy]

Cheers Woka , bad Sharkey!

You know im no pro programmer, but its good to see people help modify my existing code to improve it

[Madboy]

I had this converted for Delphi, how do you do it again, in DELPHI?

Thanks

[visualAd]

Anyone, i cant find my old threads

Do you mean this: http://www.vbforums.com/showthread.php?t=292654

[Madboy]

Nope, thats the address book one

thanks, still cant find it though

[Madboy]

Still no luck,

and why were you posting at 2am in the morning, you insomniac

[AHRIMANSEFID]

Me Need Add Mb Or GIG To Files.

Private Sub Command1_Click()
CD1.ShowOpen
Text1.Text = CD1.FileName
End Sub

Private Sub Command2_Click()
If Text1.Text <> "" And Text2.Text > 0 Then
fsiz = ShowFileSize(Text1.Text)
PB1.Value = 0
PB1.Max = Text2.Text
PB1.Visible = True
Open Text1.Text For Binary As #1
For a = 1 To Text2.Text
Put #1, fsiz - 1 + a, 0
PB1.Value = a
Next
Close
End If
PB1.Visible = False
PB1.Value = 0
End Sub
Function ShowFileSize(file)
    Dim fs, f, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(file)
    ShowFileSize = f.Size
    's = UCase(f.Name) & " uses " & f.Size & " bytes."
    'MsgBox s, 0, "Folder Size Info"
End Function
'94208

Private Sub Command3_Click()
Timer1.Enabled = True
End Sub

Private Sub Form_Load()
Text1.Text = App.Path & "\"
End Sub

Private Sub Label1_Click()

End Sub

Private Sub Label2_Click()

End Sub

Private Sub PB1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

End Sub

Private Sub Text1_Change()

End Sub

Private Sub Text3_Change()
pb2.Max = Text3.Text
End Sub

Private Sub Timer1_Timer()
Form1.Hide
pb2.Value = pb2.Value + 1
If pb2.Value = Text3.Text Then
Form1.Show
pb2.Value = 0
Timer1.Enabled = False
End If
End Sub