'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, t, g, timevon, timebis, trenner, nummer, inidatei, _ timebismax, letzter, verzeichnis, texterweiterung, ausgabeerweiterung ReDim As String texte(0), timecodes(0) Dim As Integer anfang, ende, x, y, z, timediff, buchstaben, naechster, voriger, silben, _ umschlag, bestmatch, matchmax, i 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 'defaultwerte setzen ini(inidatei, "texterweiterung", ".txt") ini(inidatei, "ausgabeerweiterung", ".src") 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 texterweiterung = ini(inidatei, "texterweiterung") ausgabeerweiterung = ini(inidatei, "ausgabeerweiterung") MkDir(verzeichnis + "\untertitel") 'erstellt ausgabeverzeichnis, falls nicht vorhanden 'liste aller timecode- und textdateien erstellen g = Dir(verzeichnis + "\*.*", -1 Xor fbDirectory) Do While Len(g) If LCase(Right(g, 4)) = ".txt" Then 'textdatei ReDim Preserve texte(UBound(texte) + 1) texte(UBound(texte)) = g Else 'auf timecodedatei prüfen Open verzeichnis + "\" + g For Input As #1 For y = 1 To 10 Line Input #1, t If Str(Val(t)) = t Then 'nummer Line Input #1, t If Len(t) >= 29 Then 'timecode? For z = 0 To 28 t[z] = IIf(InStr(":,-> ", Chr(t[z])), t[z], Asc("x")) Next If t = "xx:xx:xx,xxx --> xx:xx:xx,xxx" Then 'timecode gefunden ReDim Preserve timecodes(UBound(timecodes) + 1) timecodes(UBound(timecodes)) = g Exit For 'suche abbrechen EndIf EndIf EndIf Next Close 1 EndIf g = Dir("", -1 Xor fbDirectory) Loop trenner = "#.,;: " 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) + ausgabeerweiterung Open verzeichnis + "\untertitel\" + Left(timecodes(z), matchmax) + ausgabeerweiterung For Output As #3 Print " Lade Text..." text = Input(Lof(1), 1) 'gesamtes textfile in string laden Close 1 'variablen initialisieren / zurücksetzen silben = 0 timebismax = "" timediff = 0 umschlag = 0 letzter = "" fertig = FALSE 'gesamtzahl der vokale ermitteln For x = 0 To Len(text) - 1 If InStr("aeiouäöüy", Chr(text[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 anfang = 1 ende = 1 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 If silben = 0 Then 'kein geeigneter text Close Print " Fehler" Continue For 'nächstes objekt EndIf buchstaben = 0 Do 'silben abzählen und anzahl der buchstaben ermitteln If anfang + buchstaben >= Len(text) Then 'text zuende Exit Do EndIf buchstaben += 1 If InStr("aeiouäöüy", Chr(text[anfang + buchstaben])) Then 'vokal silben -= 1 EndIf Loop While silben naechster = InStr(anfang + buchstaben, text, Any trenner) 'nächsten trenner suchen voriger = InStrRev(text, 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(text, 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 text[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