Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

Untertiteldatei erstellen

Uploader:Mitgliedgrindstone
Datum/Zeit:05.02.2019 10:33:49

'Coded 2019 by grindstone
'Contact: https://forum.qbasic.at/privmsg.php?mode=post&u=1890
'
'This program is distributed under the terms of the FBPSL
' https://www.freebasic-portal.de/fbpsl.html

#Include Once "file.bi"
#Include Once "dir.bi"

Function ini OverLoad (datei As String, schluessel As String) As String
    'liest werte aus der ini-datei
    Dim As Integer ff
    Dim As String g

    ff = FreeFile
    If Open(datei For Input As #ff) Then
        Return ""
    EndIf

    Do
        Line Input #ff, g
        If Left(g, Len(schluessel) + 1) = schluessel + "=" Then
            Close ff
            Return Mid(g, InStr(g, "=") + 1)
        EndIf
    Loop Until Eof(ff)
    Close ff
    Return ""
End Function

Function ini (datei As String, schluessel As String, wert As string) As Integer
    'schreibt werte in die ini-datei
    Dim As Integer ff, ft
    Dim As String g, td
    Dim As boolean gefunden = FALSE

    ff = FreeFile
    If Open(datei For Input As #ff) Then
        Return 1 'fehler
    EndIf

    td = Left(Command(0), Len(Command(0)) - 3) + "tmp"
    ft = FreeFile
    If Open(td For Output As #ft) Then
        Close ff
        Close ft
        Return 1 'fehler
    EndIf

    Do
        Line Input #ff, g
        If Left(g, Len(schluessel) + 1) = schluessel + "=" Then
            Print #ft, schluessel + "=" + wert
            gefunden = TRUE
        Else
            Print #ft, g
        EndIf
    Loop Until Eof(ff)

    If gefunden = FALSE Then
        Print #ft, schluessel + "=" + wert
    EndIf

    Close ff
    Close ft

    Kill datei
    Name td, datei

End Function

Function stringmod(text As String = "", modus As Integer = 0) As String
'die angabe von 'modus' ist optional, defaultwert ist 0
'modus0 --> normale funktion
'modus1 --> kehrt nach 'pfeil nach oben', 'pfeil nach unten', 'bild nach oben' und
'           'bild nach unten'zum hauptprogramm zurück
'modus4 --> setzt nur die variable 'vorigertext' und kehrt dann zurück
'modus8 --> setzt bei druck auf esc - taste code 27 (esc) vor den rückgabestring

  Dim As Integer ze, sp, co, gi, ms, mz, rad, tasten, laenge
  Dim As String g, merken, txt, g2

  Static As String vorigertext

  If (modus And 4) Then
    vorigertext = text + " "
    Return text
  EndIf

  If vorigertext = "" Then
    vorigertext = " "
  EndIf

  txt = text + " "
  merken = txt
  co = Pos 'cursor offset
  ze = CsrLin
  sp = Len(txt) 'zeiger auf zeichen unter cursor
  Locate ze, co, 1
  Print txt;
  Locate ze, sp+co-1, 1

  Do
    'eingabe
    g = InKey
    If Len(g) = 1 Then 'normales zeichen
        If g[0] > 31 Then 'normaler buchstabe
        txt = Left(txt, sp - 1) + g + Mid(txt, sp)
        sp += 1
        Locate ze, co, 0
        Print txt;
        Locate ze, sp+co-1, 1
      Else 'steuerzeichen
        Select Case g[0]
            Case 8 ' Rücktaste
            If sp > 1 Then
              txt = Left(txt, sp - 2) + Mid(txt, sp)
              sp -= 1
              Locate ze, co, 0
              Print txt;
              Locate ze, sp+co-1, 1
            End If
          Case 13
            'return
          Case 27 'esc
            If (modus And 8) Then
                txt = Chr(27) + txt
            Else
                txt = merken 'alter string
            EndIf
            g = Chr(13) 'beenden
            Case Else
            'Print "*"; g; "*"; ASC(g) 'code von unbekannter taste anzeigen
        End Select
      End If
    ElseIf Len(g) = 2 Then 'steuerzeichen
        gi = g[1]
      Select Case gi 'steuerzeichen
        Case 75 'pfeil nach links -> cursor nach links
          If sp > 1 Then
            sp -= 1
            Locate ze, sp+co-1, 1
          End If
        Case 77 'pfeil nach rechts -> cursor nach rechts
          If sp < Len(txt) Then
            sp += 1
            Locate ze, sp+co-1, 1
          ElseIf txt = " " Then 'vorherigen string setzen
            txt = vorigertext
            sp = Len(txt)
            Print txt;
            Locate ze, sp+co-1, 1
          End If
        Case 14 'rücktaste -> zeichen vor cursor löschen
          If sp > 1 Then
            txt = Left(txt, sp - 1) + Mid(txt, sp)
            sp -= 1
            Locate ze, co, 0
            Print txt;
            Locate ze, sp+co-1, 1
          End If
        Case 83 'entf -> zeichen hinter cursor löschen
          If sp < Len(txt) Then
            txt = Left(txt, sp - 1) + Mid(txt, sp + 1)
            Locate ze, co, 0
            Print txt;
            Locate ze, sp+co-1, 1
          End If
        Case 71 'pos1 -> cursor an stringanfang setzen
          sp = 1
          Locate ze, sp+co-1, 1
        Case 79 'ende -> cursor an stringende setzen
          sp = Len(txt)
          Locate ze, sp+co-1, 1
        Case Else
            If (modus And 1) Then
            txt = g + Chr(ze) + Chr(co) + txt 'steuerzeichen und cursorposition zurückgeben
            g = Chr(13)
          EndIf
          'Print "*"; g; "*";Asc(Right(g,1)) 'code von unbekannter taste anzeigen
      End Select
    Else 'keine taste
        Sleep 1 'zur ressourcenschonung
    End If
  Loop Until g = Chr(13) 'return

  vorigertext = txt
  Return Left(txt, Len(txt) - 1)
  Locate ze, sp+co-1, 0 'cursor aus

End Function

Function msec(zeit As String) As Integer
    'rechnet zeitangabe hh:mm:ss in millisekunden um
    Dim As String stunden, minuten, sekunden
    Dim As Integer ret

    stunden = Left(zeit, 2)
    minuten = Mid(zeit, 4, 2)
    sekunden = Mid(zeit, 7, 2)
    ret = 3600000 * Val(stunden) + 60000 * Val(minuten) + 1000 * Val(sekunden) + Val(Mid(zeit, 10))
    Return ret
End Function

'############################################################################

Dim As String text, timecode, ausgabe, zeit, t, g, txt, timevon, timebis, leerzeichen, trenner, nummer, _
              inidatei, timebismax, letzter, verzeichnis
ReDim As String texte(1), timecodes(1)
Dim As Integer zeilen, punkte, anfang, ende, x, y, z, timediff, buchstaben, naechster, voriger, silben, _
               silbenzeiger, umschlag
Dim As Double laenge, korrektur
Dim As boolean fertig = FALSE


inidatei = Left(Command(0), Len(Command(0)) - 3) + "ini"

If Not FileExists(inidatei) Then 'inidatei anlegen
    Open inidatei For Output As #1
    Close 1
EndIf

'zu bearbeitendes verzeichnis angeben
verzeichnis = ini(inidatei, "verzeichnis") 'verzeichnis aus inidatei holen
Print "Verzeichnis: ";
verzeichnis = stringmod(verzeichnis) 'namen eingeben / bearbeiten
Print
Print

If verzeichnis = "" Then
    verzeichnis = ExePath
EndIf

If InStrRev(verzeichnis, ".") > InStrRev(verzeichnis, Any "\/") Then 'pfad extrahieren
    verzeichnis = Left(verzeichnis, InStrRev(verzeichnis, Any "\/") - 1)
EndIf

ini(inidatei, "verzeichnis", verzeichnis) 'in inidatei schreiben

MkDir(verzeichnis + "\untertitel") 'erstellt ausgabeverzeichnis, falls nicht vorhanden

'liste aller textdateien erstellen
x = 0
g = Dir(verzeichnis + "\*.txt", -1)
Do While Len(g)
    x += 1
    ReDim Preserve texte(x)
    texte(x) = g
    g = Dir("", -1)
Loop

'liste aller timecodedateien erstellen
x = 0
g = Dir(verzeichnis + "\*.src", -1)
Do While Len(g)
    x += 1
    ReDim Preserve timecodes(x)
    timecodes(x) = g
    g = Dir("", -1)
Loop

Dim As Integer bestmatch, matchmax, i, gleich

Print UBound(timecodes);IIf(UBound(timecodes) = 1, " Timecodedatei", " Timecodedateien")
For z = 1 To UBound(timecodes) 'alle timecodedateien
    Print
    Print z;". Objekt"
    'passende textdatei suchen
    bestmatch = 0
    matchmax = 0
    For y = 1 To UBound(texte) 'alle textdateien
        'anfänge der dateinamen vergleichen
        For i = 0 To IIf(Len(timecodes(z)) < Len(texte(y)), Len(timecodes(z)), Len(texte(y))) - 1
            If timecodes(z)[i] <> texte(y)[i] Then '1. nichtübereinstimmender buchstabe
                If matchmax < i Then 'größere anzahl übereinstimmender buchstaben gefunden
                    matchmax = i 'anzahl merken
                    bestmatch = y 'index der textdatei merken
                EndIf
                Exit For 'nächste textdatei
            EndIf
        Next
    Next

    Print " Timecode: ";timecodes(z)
    Print "     Text: ";texte(bestmatch)

    If bestmatch = 0 Then 'keine passende textdatei gefunden
        Print " Keine passende Textdatei"
        Continue For
    EndIf

    Open verzeichnis + "\" + texte(bestmatch) For Input As #1

    Open verzeichnis + "\" + timecodes(z) For Input As #2

    Print "  Ausgabe: ";Left(timecodes(z), matchmax) + ".src"
    Open verzeichnis + "\untertitel\" + Left(timecodes(z), matchmax) + ".src" For Output As #3

    Print " Lade Text..."
    txt = Input(Lof(1), 1) 'gesamtes textfile in string laden
    Close 1

    silben = 0
    timebismax = ""
    timediff = 0
    umschlag = 0
    letzter = ""

    'gesamtzahl der vokale ermitteln
    For x = 0 To Len(txt) - 1
        If InStr("aeiouäöüy", Chr(txt[x])) Then 'vokal
            silben += 1
        EndIf
    Next

    'zeiten aufaddieren
    Do
        Line Input #2, g
        If InStr(g, "-->") Then 'timecode
            timevon = Left(g, InStr(g, "-->") - 2)
            timebis = Mid(g, InStr(g, "-->") + 4)
            timediff += msec(timebis) - msec(timevon)
        EndIf
    Loop Until Eof(2)
    timebismax = timebis
    Seek 2, 1 'dateizeiger zurücksetzen

    'variablen initialisieren
    laenge = silben / timediff 'wert für silben/ms berechnen
    korrektur = 1
    leerzeichen = "j" 'trennen bei leerzeichen
    anfang = 1
    ende = 1
    trenner = IIf(leerzeichen = "j", "#.,;: ", "#.,;:")

    Print " Berechne Korrekturfaktor..."

    Do
        anfang = 1
        ende = 1
        Seek #2, 1 'dateizeiger zurücksetzen

        Do 'timecodedatei abarbeiten
            Line Input #2, g
            If InStr(g, "-->") Then 'timecode
                timevon = Left(g, InStr(g, "-->") - 2)
                timebis = Mid(g, InStr(g, "-->") + 4)
                timediff = msec(timebis) - msec(timevon) 'einblendzeit in ms
                silben = Int(timediff * laenge * korrektur + .5) 'anzahl der silben berechnen
                buchstaben = 0
                Do 'silben abzählen und anzahl der buchstaben ermitteln
                    If anfang + buchstaben >= Len(txt) Then 'text zuende
                        Exit Do
                    EndIf
                    buchstaben += 1
                    If InStr("aeiouäöüy", Chr(txt[anfang + buchstaben])) Then 'vokal
                        silben -= 1
                    EndIf
                Loop While silben

                naechster = InStr(anfang + buchstaben, txt, Any trenner) 'nächsten trenner suchen
                voriger = InStrRev(txt, Any trenner, anfang + buchstaben) 'vorhergehenden trenner suchen

                'zeiger auf ende des textabschnitts setzen
                If naechster = 0 Then
                    ende = voriger
                ElseIf voriger = 0 Then
                    ende = naechster
                ElseIf voriger < anfang Then
                    ende = naechster
                ElseIf Abs(naechster - (anfang + buchstaben)) <= Abs(voriger - (anfang + buchstaben)) Then
                    ende = naechster
                Else
                    ende = voriger
                EndIf

                If (umschlag > 2) And (letzter = "time") Then
                    'werte in ausgabedatei schreiben
                    Print #3, nummer
                    Print #3, g
                    g = Mid(txt, anfang, ende - anfang + 1)
                    Print #3, g
                    Print #3, ""
                    fertig = TRUE
                EndIf

                If (ende > anfang) And (ende + anfang > 0) Then
                    anfang = ende + 1 'zeiger auf beginn des nächsten textabschnitts
                Else
                    If letzter = "time" Then
                        umschlag += 1
                    EndIf
                    letzter = "text"
                    korrektur -= .001 'korrekturfaktor vermindern
                    Exit Do 'text zuende
                EndIf
                Do While txt[anfang - 1] = Asc(" ")
                    anfang += 1
                Loop
            ElseIf Str(Val(g)) = g Then 'nummer
                nummer = g
            Else
                'ignorieren --> nächste zeile
            EndIf
        Loop Until Eof(2)

        If Eof(2) Then
            If letzter = "text" Then
                umschlag += 1
            EndIf
            letzter = "time"
            korrektur += .001 'korrekturfaktor erhöhen
        EndIf
    Loop Until fertig

    Close
Next

Print
Print "Fertig"
Sleep