Split Wav αρχείο σε VB6

ψήφοι
0

Χρειάζομαι βοήθεια για να διορθώσετε το συνημμένο κώδικα VB6 που υποτίθεται ότι θα λάβει ένα αρχείο ήχου και γίνεται διαχωρισμός σε 5 ίσα μέρη.

Αυτός είναι ο τρόπος που αυτός ο κώδικας θα πρέπει να εργαστεί:

Το πρώτο μέρος ξεκινά από την αρχή του αρχείου Track.wav. Το δεύτερο μέρος ξεκινά απ 'όπου η πρώτη διάσπαση μέρος τελείωσε. Το τρίτο μέρος ξεκινάει απ 'όπου η δεύτερη διάσπαση μέρος τελείωσε. Το τέταρτο μέρος ξεκινάει απ 'όπου το τρίτο διάσπαση μέρος τελείωσε. Το πέμπτο μέρος ξεκινάει απ 'όπου η τέταρτη διάσπαση μέρος τελείωσε.

Ουσιαστικά κάθε ένα από τα τμήματα του αρχείου αποτελεί συνέχεια της προηγούμενης από την κατάτμηση αρχείο. Μετά τη διάσπαση έχω 1.wav, 2.wav, 3.wav. 4.wav και 5.wav όλα προέρχονται από ένα αρχείο Track.wav. Ο κωδικός που επισυνάπτεται ήδη χωρίζει το αρχείο σε πέντε ίσα μέρη, αλλά το πρόβλημα είναι ότι όλα τα ηχητικά μέρη είναι το ίδιο με το πρώτο μέρος, αντί να συνεχιστεί.

Χρειάζομαι βοήθεια για να πάρει αυτό που καθορίζεται με το έργο όπως θα έπρεπε σε VB6 (δεν ΝΕΤ). Θα ήμουν ευγνώμων για τη βοήθειά σας με αυτό.

Dim Wavlength As Integer

Private Sub Command1_Click()

On Error Resume Next

DoFirstWav

Me.SetFocus

End Sub

Private Sub DoFirstWav()

On Error Resume Next

Dim ByteData() As Byte
Dim FirstWav As Integer

FirstWav = Wavlength / 5

ByteData = ReadFile(App.Path & \Track.wav, 1, FirstWav & 0000)
Call WriteFile(App.Path & \Segments\1.wav, ByteData)

DoSecondWav

End Sub

Private Sub DoSecondWav()

On Error Resume Next

Dim ByteData() As Byte
Dim SecondWav As Integer

SecondWav = Wavlength / 5

ByteData = ReadFile(App.Path & \Track.wav, 1, SecondWav & 0000)
Call WriteFile(App.Path & \Segments\2.wav, ByteData)

DoThirdWav

End Sub

Private Sub DoThirdWav()

On Error Resume Next

Dim ByteData() As Byte
Dim ThirdWav As Integer

ThirdWav = Wavlength / 5

ByteData = ReadFile(App.Path & \Track.wav, 1, ThirdWav & 0000)
Call WriteFile(App.Path & \Segments\3.wav, ByteData)

DoFourthWav

End Sub

Private Sub DoFourthWav()

On Error Resume Next

Dim ByteData() As Byte
Dim FourthWav As Integer

FourthWav = Wavlength / 5

ByteData = ReadFile(App.Path & \Track.wav, 1, FourthWav & 0000)
Call WriteFile(App.Path & \Segments\4.wav, ByteData)

DoFifthWav

End Sub

Private Sub DoFifthWav()

On Error Resume Next

Dim ByteData() As Byte
Dim FifthWav As Integer

FifthWav = Wavlength / 5

ByteData = ReadFile(App.Path & \Track.wav, 1, FifthWav & 0000)
Call WriteFile(App.Path & \Segments\5.wav, ByteData)

MsgBox Wav Split Successfully, vbInformation

End

End Sub

Private Function ReadFile(ByVal strFileName As String, Optional ByVal lngStartPos As Long = 1, Optional ByVal lngFileSize As Long = -1) As Byte()

On Error Resume Next

Dim FilNum As Integer

FilNum = FreeFile

Open strFileName For Binary As #FilNum
    If lngFileSize = -1 Then
        ReDim ReadFile(LOF(FilNum) - lngStartPos)
        Else
        ReDim ReadFile(lngFileSize - 1)
    End If
    Get #FilNum, lngStartPos, ReadFile
Close #FilNum

End Function

Private Function WriteFile(ByVal strFileName As String, ByteData() As Byte, Optional ByVal lngStartPos As Long = -1, Optional ByVal OverWrite As Boolean = True)

On Error Resume Next

Dim FilNum As Integer

FilNum = FreeFile

If OverWrite = True And Dir(strFileName) <>  Then
    Kill strFileName
End If

Open strFileName For Binary As #FilNum
    If lngStartPos = -1 Then
        Put #FilNum, LOF(FilNum) + 1, ByteData
        Else
        Put #FilNum, l, ByteData
    End If
Close #FilNum

End Function

Private Sub Form_Load()

On Error Resume Next

Dim MyInt As Integer
Dim MyByte As Byte
Dim MyStr As String * 4
Dim MyLong As Long
Dim SampleRate, BytesPerSample, FileSize As Long

Open App.Path & \Track.wav For Binary Access Read Lock Read As #1
    Get #1, , MyStr:    Debug.Print Riff = ; MyStr
    Get #1, , MyLong:   Debug.Print File size = ; MyLong
    FileSize = MyLong
    Get #1, , MyStr:    Debug.Print Wave = ; MyStr
    Get #1, , MyStr:    Debug.Print Format = ; MyStr
    Get #1, , MyLong:   Debug.Print Any = ; MyLong
    Get #1, , MyInt:    Debug.Print formatTag = ; MyInt
    Get #1, , MyInt:    Debug.Print Channels = ; MyInt
    Get #1, , MyLong:   Debug.Print Samples per Sec = ; MyLong
    SampleRate = MyLong
    Get #1, , MyInt:    Debug.Print Bytes per Sec = ; MyInt
    Get #1, , MyInt:    Debug.Print BlockAlign = ; MyInt
    Get #1, , MyInt:    Debug.Print Bytes per Sample = ; MyInt
    BytesPerSample = MyInt
Close #1

Wavlength = FileSize / (SampleRate * BytesPerSample)

End Sub
Δημοσιεύθηκε 14/02/2020 στις 00:01
πηγή χρήστη
Σε άλλες γλώσσες...                            


2 απαντήσεις

ψήφοι
1

Αυτή η ερώτηση είναι αρκετά συμμετοχή, ειδικά αν κάθε μέρος πρέπει να είναι playable. Ο λόγος είναι ότι κάθε αρχείο που δημιουργείτε πρέπει να έχει μια έγκυρη ρεκόρ μπάλα. Για να το περιπλέξουν περαιτέρω, φαίνεται μια εγγραφή κεφαλίδας μπορεί να είναι 44 bytes, 46 bytes, ή ακόμα και άλλα μεγέθη.

Δούλεψα κάποιες βασικές κώδικα με βάση την ανάρτησή σας που εμφανίζεται στην εργασία για το αρχείο wav θα δοκιμαστεί:

Option Explicit

Private Const HEADER_SIZE As Long = 46
Private Const CHUNK_COUNT As Long = 5

Private HeaderData(HEADER_SIZE) As Byte
Private ChunkSize As Long

Private Sub Form_Load()
   Dim MyInt As Integer
   Dim MyByte As Byte
   Dim MyStr As String * 4
   Dim MyLong As Long
   Dim FileSize As Long

   Open App.Path & "\Track.wav" For Binary Access Read Lock Read As #1
   Get #1, , MyStr:    Debug.Print "Riff = "; MyStr
   Get #1, , MyLong:   Debug.Print "File size = "; MyLong
   Get #1, , MyStr:    Debug.Print "Wave = "; MyStr
   Get #1, , MyStr:    Debug.Print "Format = "; MyStr
   Get #1, , MyLong:   Debug.Print "Any = "; MyLong
   Get #1, , MyInt:    Debug.Print "formatTag = "; MyInt
   Get #1, , MyInt:    Debug.Print "Channels = "; MyInt
   Get #1, , MyLong:   Debug.Print "Samples per Sec = "; MyLong
   Get #1, , MyInt:    Debug.Print "Bytes per Sec = "; MyInt
   Get #1, , MyInt:    Debug.Print "BlockAlign = "; MyInt
   Get #1, , MyInt:    Debug.Print "Bytes per Sample = "; MyInt
   Get #1, , MyInt:    Debug.Print "Something = "; MyInt  'for my wave file, I needed 2 extra bytes
   Get #1, , MyStr:    Debug.Print "SubchunkID = "; MyStr
   Get #1, , FileSize: Debug.Print "SubchunkSize = "; FileSize
   Get #1, 1, HeaderData  'the size changes depending upon the file
   Close #1

   ChunkSize = CLng(FileSize / CHUNK_COUNT)  'you might loose some data here
End Sub

Private Sub Command1_Click()
   Dim i As Integer
   Dim ByteData() As Byte
   Dim StartPos As Long

   For i = 1 To CHUNK_COUNT
      StartPos = HEADER_SIZE + ((i - 1) * ChunkSize)
      ByteData = ReadFile(App.Path & "\Track.wav", StartPos, ChunkSize)
      Call WriteFile(App.Path & "\Segments\" & i & ".wav", HeaderData, ByteData)
   Next

   MsgBox "Wav Split Successfully", vbInformation
   End
End Sub

Private Function ReadFile(ByVal strFileName As String, ByVal lngStartPos As Long, ByVal lngFileSize As Long) As Byte()
   On Error Resume Next

   Dim FilNum As Integer

   FilNum = FreeFile

   ReDim ReadFile(lngFileSize - 1)

   Open strFileName For Binary As #FilNum

   Get #FilNum, lngStartPos, ReadFile

   Close #FilNum
End Function

Private Function WriteFile(ByVal strFileName As String, HeaderData() As Byte, ByteData() As Byte, Optional ByVal OverWrite As Boolean = True)
   On Error Resume Next

   Dim FilNum As Integer

   FilNum = FreeFile

   If OverWrite = True And Dir(strFileName) <> "" Then
       Kill strFileName
   End If

   Open strFileName For Binary As #FilNum

   Put #FilNum, LOF(FilNum) + 1, HeaderData
   Put #FilNum, HEADER_SIZE, ByteData

   Close #FilNum
End Function

Θα εξαλειφθούν πολλά διπλούν κώδικα, με την εφαρμογή ενός Forβρόχου. Σε αυτό το βρόχο, έχω υπολογίσει τη θέση εκκίνησης για το διαβάζω, αλλά και να περάσει το αρχείο κεφαλίδας για την Write.

Και πάλι, τονίζω ότι αυτό είναι πολύ βασικό και δεν θα λειτουργήσει για όλα τα αρχεία wav. Μπορείτε να ρυθμίσετε χειροκίνητα την HEADER_SIZE αν δεν λειτουργεί για το αρχείο σας.

Πιθανόν οι ανάγκες εγγραφή κεφαλίδας να τροποποιηθεί ώστε να αντανακλά το σωστό μέγεθος του νέου αρχείου, αντί να χρησιμοποιεί την κεφαλίδα από το αρχικό αρχείο.

Αυτό θα πρέπει να ξεκινήσετε.

Απαντήθηκε 17/02/2020 στις 00:25
πηγή χρήστη

ψήφοι
0

Αυτός είναι ο κώδικας εργασίας. Είμαι σίγουρος ότι κάποιος μπορεί να χρειαστεί κάτι τέτοιο στο μέλλον, si πίστευα ότι θα το δημοσιεύσετε εδώ.


Dim Wavlength As Long
Dim PartLength As Integer
Dim WavHeader() As Byte

Private Sub Command1_Click()

On Error Resume Next

WavHeader = ReadFile(App.Path & "\Track.wav", 1, 320)

PartLength = Wavlength / 6 - 2

DoFirstWav

End Sub

Private Sub DoFirstWav()

On Error Resume Next

Dim ByteData() As Byte
Dim FirstWav As Integer

ByteData = ReadFile(App.Path & "\Track.wav", 1, PartLength & "0000")
Call WriteFile(App.Path & "\Segments\1.wav", ByteData)

DoSecondWav

End Sub

Private Sub DoSecondWav()

On Error Resume Next

Dim ByteData() As Byte
Dim ByteRead() As Byte
Dim SecondWav As Integer

SecondWav = PartLength

ByteRead = ReadFile(App.Path & "\Track.wav", SecondWav & "0000", PartLength & "0000")

ReDim ByteData(UBound(WavHeader) + UBound(ByteRead)) As Byte

For i = 0 To UBound(WavHeader)
    ByteData(i) = WavHeader(i)
Next i

For i = 0 To UBound(ByteRead)
    ByteData(UBound(WavHeader) + i) = ByteRead(i)
Next i

Call WriteFile(App.Path & "\Segments\2.wav", ByteData)

DoThirdWav

End Sub

Private Sub DoThirdWav()

On Error Resume Next

Dim ByteData() As Byte
Dim ByteRead() As Byte
Dim ThirdWav As Integer

ThirdWav = PartLength * 2 + 1

ByteRead = ReadFile(App.Path & "\Track.wav", ThirdWav & "0000", PartLength & "0000")

ReDim ByteData(UBound(WavHeader) + UBound(ByteRead)) As Byte

For i = 0 To UBound(WavHeader)
    ByteData(i) = WavHeader(i)
Next i

For i = 0 To UBound(ByteRead)
    ByteData(UBound(WavHeader) + i) = ByteRead(i)
Next i

Call WriteFile(App.Path & "\Segments\3.wav", ByteData)

DoFourthWav

End Sub

Private Sub DoFourthWav()

On Error Resume Next

Dim ByteData() As Byte
Dim ByteRead() As Byte
Dim FourthWav As Integer

FourthWav = PartLength * 3 + 1

ByteRead = ReadFile(App.Path & "\Track.wav", FourthWav & "0000", PartLength & "0000")

ReDim ByteData(UBound(WavHeader) + UBound(ByteRead)) As Byte

For i = 0 To UBound(WavHeader)
    ByteData(i) = WavHeader(i)
Next i

For i = 0 To UBound(ByteRead)
    ByteData(UBound(WavHeader) + i) = ByteRead(i)
Next i

Call WriteFile(App.Path & "\Segments\4.wav", ByteData)

DoFifthWav

End Sub

Private Sub DoFifthWav()

On Error Resume Next

Dim ByteData() As Byte
Dim ByteRead() As Byte
Dim FifthWav As Integer

FifthWav = PartLength * 4 + 1

ByteRead = ReadFile(App.Path & "\Track.wav", FifthWav & "0000", PartLength & "0000")

ReDim ByteData(UBound(WavHeader) + UBound(ByteRead)) As Byte

For i = 0 To UBound(WavHeader)
    ByteData(i) = WavHeader(i)
Next i

For i = 0 To UBound(ByteRead)
    ByteData(UBound(WavHeader) + i) = ByteRead(i)
Next i

Call WriteFile(App.Path & "\Segments\5.wav", ByteData)

End Sub

Private Function ReadFile(ByVal strFileName As String, Optional ByVal lngStartPos As Long = 1, Optional ByVal lngFileSize As Long = -1) As Byte()

On Error Resume Next

Dim FilNum As Integer

FilNum = FreeFile

Open strFileName For Binary As #FilNum
    If lngFileSize = -1 Then
        ReDim ReadFile(LOF(FilNum) - lngStartPos)
        Else
        ReDim ReadFile(lngFileSize - 1)
    End If
    Get #FilNum, lngStartPos, ReadFile
Close #FilNum

End Function

Private Function WriteFile(ByVal strFileName As String, ByteData() As Byte, Optional ByVal lngStartPos As Long = -1, Optional ByVal OverWrite As Boolean = True)

On Error Resume Next

Dim FilNum As Integer

FilNum = FreeFile

If OverWrite = True And Dir(strFileName) <> "" Then
    Kill strFileName
End If

Open strFileName For Binary As #FilNum
    If lngStartPos = -1 Then
        Put #FilNum, LOF(FilNum) + 1, ByteData
        Else
        Put #FilNum, l, ByteData
    End If
Close #FilNum

End Function

Private Sub Form_Load()

On Error Resume Next

Dim MyInt As Integer
Dim MyByte As Byte
Dim MyStr As String * 4
Dim MyLong As Long
Dim SampleRate, BytesPerSample, FileSize As Long

Open App.Path & "\Track.wav" For Binary Access Read Lock Read As #1
    Get #1, , MyStr:    Debug.Print "Riff = "; MyStr
    Get #1, , MyLong:   Debug.Print "File size = "; MyLong
    FileSize = MyLong
    Get #1, , MyStr:    Debug.Print "Wave = "; MyStr
    Get #1, , MyStr:    Debug.Print "Format = "; MyStr
    Get #1, , MyLong:   Debug.Print "Any = "; MyLong
    Get #1, , MyInt:    Debug.Print "formatTag = "; MyInt
    Get #1, , MyInt:    Debug.Print "Channels = "; MyInt
    Get #1, , MyLong:   Debug.Print "Samples per Sec = "; MyLong
    SampleRate = MyLong
    Get #1, , MyInt:    Debug.Print "Bytes per Sec = "; MyInt
    Get #1, , MyInt:    Debug.Print "BlockAlign = "; MyInt
    Get #1, , MyInt:    Debug.Print "Bytes per Sample = "; MyInt
    BytesPerSample = MyInt

Close #1

Wavlength = FileSize \ (SampleRate * BytesPerSample)

Debug.Print "Wavlength"; Wavlength

End Sub
Απαντήθηκε 18/02/2020 στις 01:41
πηγή χρήστη

Cookies help us deliver our services. By using our services, you agree to our use of cookies. Learn more