Add bytes to any file-VBForums
Results 1 to 9 of 9

Thread: Add bytes to any file

  1. #1

    Thread Starter
    Supreme User Madboy's Avatar
    Join Date
    Oct 2003
    Location
    England
    Posts
    3,253

    Add bytes to any file

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

    VB Code:
    1. Private Sub lblAdd_Click()
    2. Dim lprog As Long
    3.  
    4. If txtFile.Text = "" Then
    5. frmMessage!lblMessage.Caption = "Please select a file first to add required bytes to it."
    6. frmMessage.Show vbModal
    7. Else
    8. lblPercent.Visible = True
    9. lblStatus2.ForeColor = &HC0&
    10. lblStatus2.Caption = "Working"
    11. lblBytes3.Caption = "N/A"
    12. lblFile3.Caption = "N/A"
    13. lblTime2.Caption = "N/A"
    14.  
    15. If txtFile.Text <> "" And txtBytes.Text > 0 Then
    16. fsiz = ShowFileSize(txtFile.Text)
    17. prgMain.Value = 0
    18. prgMain.Max = txtBytes.Text
    19. prgMain.Visible = True
    20. DoEvents
    21. Me.Enabled = False
    22. Open txtFile.Text For Binary As #1
    23. For A = 1 To txtBytes.Text
    24. Put #1, fsiz - 1 + A, 0
    25.  
    26. prgMain.Value = A
    27.  
    28. prgMain.Refresh
    29.  
    30. lprog = (A / txtBytes) * 100
    31. lblPercent = lprog & "%"
    32. lblPercent.Refresh
    33.  
    34.  
    35. Next
    36. Close
    37. End If
    38. prgMain.Visible = False
    39. prgMain.Value = 0
    40. lblPercent.Visible = False
    41. lblStatus2.ForeColor = &H8000&
    42. lblStatus2.Caption = "Ready"
    43. lblBytes3.Caption = txtBytes.Text
    44. lblFile3.Caption = Replace(txtFile.Text, "&", "&&")
    45. lblTime2.Caption = Now
    46. DoEvents
    47. Me.Enabled = True
    48. End If
    49. End Sub
    50.  
    51. Function ShowFileSize(file)
    52.     Dim fs, f, S
    53.     Set fs = CreateObject("Scripting.FileSystemObject")
    54.     Set f = fs.GetFile(file)
    55.     ShowFileSize = f.Size
    56.     's = UCase(f.Name) & " uses " & f.Size & " bytes."
    57.     'MsgBox s, 0, "Folder Size Info"
    58. End Function
    59. '94208
    60.  
    61. Private Sub lblFileBrowse_Click()
    62. dlgFile.ShowOpen
    63. txtFile.Text = dlgFile.FileName
    64. End Sub

  2. #2
    Super Moderator Wokawidget's Avatar
    Join Date
    Nov 2001
    Location
    Headingly Occupation: Classified
    Posts
    9,633
    Bad Wiggles, you could use:
    VB Code:
    1. Public Sub AmendFile(ByVal pstrFilename As String, ByRef pbytData() As Byte)
    2. Dim intFile     As Integer
    3. On Error GoTo ErrHandler
    4.     'if required add code here to see if file exists
    5.     intFile = FreeFile
    6.     Open pstrFilename For Binary Access Write As #intFile
    7.     Put #intFile, LOF(intFile) + 1, pbytData()
    8.     Close #intFile
    9.     Exit Sub
    10. ErrHandler:
    11.     Close #intFile
    12.     Err.Raise Err.Number, Err.Source, Err.Description
    13. End Sub


    Woka

  3. #3
    Super Moderator Wokawidget's Avatar
    Join Date
    Nov 2001
    Location
    Headingly Occupation: Classified
    Posts
    9,633
    Wiggles, you can even take this one step further and add the code to a class:
    VB Code:
    1. Option Explicit
    2.  
    3. Public Event Progress(ByVal BytesWritten As Long, ByVal TotalBytes As Long)
    4.  
    5. Public Sub AmendFile(ByVal pstrFilename As String, ByRef pbytData() As Byte)
    6. Dim intFile     As Integer
    7. Dim lngFileLen  As Long
    8. Dim lngByteLen  As Long
    9. Dim lngIndex    As Long
    10. Dim lngLBound   As Long
    11. Dim lngUBound   As Long
    12. On Error GoTo ErrHandler
    13.     'if required add code here to see if file exists
    14.     intFile = FreeFile
    15.     Open pstrFilename For Binary Access Write As #intFile
    16.     lngFileLen = LOF(intFile)
    17.     lngLBound = LBound(pbytData)
    18.     lngUBound = UBound(pbytData)
    19.     lngByteLen = lngUBound - lngLBound + 1
    20.     For lngIndex = 1 To lngByteLen
    21.         Put #intFile, lngFileLen + lngIndex, pbytData(lngLBound + lngIndex - 1)
    22.         RaiseEvent Progress(lngIndex, lngByteLen)
    23.     Next lngIndex
    24.     Close #intFile
    25.     Exit Sub
    26. ErrHandler:
    27.     Close #intFile
    28.     Err.Raise Err.Number, Err.Source, Err.Description
    29. End Sub
    This will raise an event to your form so that you can display the progress of the writting if you wish.

    Woof

  4. #4

    Thread Starter
    Supreme User Madboy's Avatar
    Join Date
    Oct 2003
    Location
    England
    Posts
    3,253
    Cheers Woka , bad Sharkey!

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

  5. #5

    Thread Starter
    Supreme User Madboy's Avatar
    Join Date
    Oct 2003
    Location
    England
    Posts
    3,253

    Re: Add bytes to any file

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

    Thanks

  6. #6
    VBA Nutter visualAd's Avatar
    Join Date
    Apr 2002
    Location
    Camden, London Mode: PPI
    Posts
    4,904

    Re: Add bytes to any file

    Quote Originally Posted by Madboy
    Anyone, i cant find my old threads
    Do you mean this: http://www.vbforums.com/showthread.php?t=292654
    PHP || MySql || Apache || Get Firefox || OpenOffice.org || Click || Slap ILMV || 1337 c0d || GotoMyPc For FREE! Part 1, Part 2

    | PHP Session --> Database Handler * Custom Error Handler * Installing PHP * HTML Form Handler * PHP 5 OOP * Using XML * Ajax * Xslt | VB6 Winsock - HTTP POST / GET * Winsock - HTTP File Upload

    Latest quote: crptcblade - VB6 executables can't be decompiled, only disassembled. And the disassembled code is even less useful than I am.

    Random VisualAd: Blog - Latest Post: When the Internet becomes Electricity!!


    Spread happiness and joy. Rate good posts.

  7. #7

    Thread Starter
    Supreme User Madboy's Avatar
    Join Date
    Oct 2003
    Location
    England
    Posts
    3,253

    Re: Add bytes to any file

    Nope, thats the address book one

    thanks, still cant find it though

  8. #8

    Thread Starter
    Supreme User Madboy's Avatar
    Join Date
    Oct 2003
    Location
    England
    Posts
    3,253

    Re: Add bytes to any file

    Still no luck,

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

  9. #9
    New Member
    Join Date
    Sep 2005
    Location
    IRAN
    Posts
    10

    Resolved Re: Add bytes to any file

    Me Need Add Mb Or GIG To Files.

    Code:
    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
    BYE SEE YOU LEADER HELL

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.