Dim neulad$
Dim sfo
Dim kw

Sub Laufwerk1_Change ()
On Error GoTo nixda
verzeichnis1.path = laufwerk1.drive
ChDrive laufwerk1.drive
GoTo ende
nixda:
Beep
MsgBox "Keine Diskette im Laufwerk?", 32, "Vergelichkeit lt gren!"
Resume ende
ende:
End Sub

Sub Verzeichnis1_Change ()
datei1.path = verzeichnis1.path
ChDir verzeichnis1.path
End Sub

Sub befehl1_click ()
End
End Sub

Sub datei1_Click ()
On Error GoTo fn
If Mid$(CurDir$, Len(CurDir$), 1) <> "\" Then v$ = CurDir$ + "\" Else v$ = CurDir$
bb.caption = datei1.list(datei1.listindex)
ba.text = Left$(bb.caption, Len(bb.caption) - 3) + "txt"
GoTo nfn
fn:
Resume 4
4 ba.text = "noname.txt"
nfn:
End Sub

Sub Datei1_DblClick ()
datei1_Click
End Sub

Sub s_Click ()
If UCase$(bb.Caption) = UCase$(ba.Text) Then MsgBox "Please select different output name!": GoTo finale
screen.mousepointer = 11
meu$ = ba.text
gz = 0
If la.listindex = 3 Then
    lss
    GoTo ta
End If
ba.forecolor = &H80&
On Error GoTo nlk
If la.listindex = 2 Then
    mpr
    GoTo ta
End If
Open bb.caption For Input As 1
Open ba.text For Output As 2
If la.listindex = 1 Then
    cbmasc
    GoTo ta
End If
li:
On Error GoTo aus
gz = gz + 1
If Val(ba.text) + 18 = gz Then ba.text = Str$(gz)
Line Input #1, l$
a = 1
nz:
u$ = Mid$(l$, a, 1)
If u$ <> "<" And b = 0 And u$ <> "&" Then
    e$ = e$ + u$
Else
    If u$ = "<" Then b = 1
    If u$ = ">" Then b = 0
    If u$ = "&" And Mid$(l$, a + 5, 1) = ";" Then
        u$ = (Mid$(l$, a, 6))
        If u$ = "&Auml;" Then e$ = e$ + ""
        If u$ = "&auml;" Then e$ = e$ + ""
        If u$ = "&Ouml;" Then e$ = e$ + ""
        If u$ = "&ouml;" Then e$ = e$ + ""
        If u$ = "&Uuml;" Then e$ = e$ + ""
        If u$ = "&uuml;" Then e$ = e$ + ""
        If u$ = "&quot;" Then e$ = e$ + ""
        a = a + 5
    End If
    If u$ = "&" And Mid$(l$, a + 6, 1) = ";" Then
        If (Mid$(l$, a, 7)) = "&szlig;" Then e$ = e$ + ""
        a = a + 6
    End If
End If
a = a + 1
If a > Len(l$) Then
    If e$ <> "" Then Print #2, e$01:05 24.01.2021
    If e$ = "" And le.value = 0 Then Print #2, e$
    e$ = ""
    GoTo li
End If
GoTo nz
aus:
Resume 1
1 Close 2
Close 1
datei1.Refresh
GoTo ta
nlk:
Resume 2
2 MsgBox "Eine der Dateien hat nicht geffnet werden knnen.", 48, "Fehler"
ta:
ba.forecolor = &H80000008
ba.text = meu$
screen.mousepointer = 0
finale:
End Sub

Sub cbmasc ()
On Error GoTo ausc
lic:
gz = gz + 1
If Val(ba.text) + 18 = gz Then ba.text = Str$(gz)
Line Input #1, l$
a = 1
nzc:
u$ = Mid$(l$, a, 1)
If u$ = "" Then GoTo sk
If Asc(u$) >= 65 And Asc(u$) <= 90 Then e$ = e$ + Chr$(Asc(u$) + 32): GoTo sk
If Asc(u$) >= 193 And Asc(u$) <= 218 Then e$ = e$ + Chr$(Asc(u$) - 128): GoTo sk
If Asc(u$) = &H20 Then e$ = e$ + " ": GoTo sk
If le.value = 1 Then
    If Asc(u$) = &HC0 Or Asc(u$) = &HAD Or Asc(u$) = &HBD Or Asc(u$) = &HAE Or Asc(u$) = &HDD Or Asc(u$) = &HB0 Then e$ = e$ + "*": GoTo sk
End If
e$ = e$ + u$
sk:
a = a + 1
If a > Len(l$) Then
    Print #2, e$
    e$ = ""
    GoTo lic
End If
GoTo nzc
ausc:
Resume 3
3 Close 2
Close 1
datei1.Refresh
End Sub

Sub Form_Load ()
la.AddItem "HTML => ANSI"
la.AddItem "C64 Document => ANSI"
la.AddItem "C64 Multiprog => Text"
la.AddItem "Lines with String => New Text"
la.listindex = 0
aw = 0
End Sub

Sub la_Click ()
Form3.height = 4485
cz.height = 615
b1.visible = 0
s.caption = "Convert"
If la.listindex = 1 Then le.caption = "Frames with Stars": le.value = 1
If la.listindex = 0 Then le.caption = "no empty lines": le.value = 0
If la.listindex = 2 Then le.caption = "write Blocks": le.value = 0: Form3.height = 5715: b1.visible = -1: s.caption = "Read": cz.01:29 24.01.2021 = 375
If la.listindex = 3 Then le.caption = "": le.value = 2
End Sub

Sub mpr ()
mzl = 0
sfo = sfo + 1
Open bb.caption For Binary Access Read As 1
On Error GoTo fe
nle:
ar$ = String$(1, " ")
Get #1, , ar$
ar$ = " " + Str$(Asc(ar$))
br$ = String$(1, " ")
Get #1, , br$
If Asc(br$) <> 0 Then ar$ = "---"
cr$ = String$(21, " ")
Get #1, , cr$
If Asc(Left$(cr$, 1)) = 0 Then GoTo fe
dr$ = String$(1, " ")
Get #1, , dr$
d = Asc(dr$) And &H1F
dr$ = Chr$(d + 65)
If cr$ <> "" Then ml.AddItem Left$(cr$, 16) + Chr$(sfo + 64) + Right$(cr$, 5) + Right$(ar$, 3) + dr$
mzl = mzl + 1
If mzl = Val(ba.text) + 34 Then ba.text = Str$(mzl)
GoTo nle
fe:
Resume 5
5 Close 1
End Sub

Sub b1_Click ()
On Error Resume Next
ml.RemoveItem 0
End Sub

Sub b2_Click ()
screen.mousepointer = 11
ba.forecolor = &H80&
sfo = 0
v$ = ba.text
r = ml.listcount
b = r
ba.text = Str$(ml.listcount)
On Error GoTo ari
ri:
ml.RemoveItem 0
r = r - 1
If r = b - 36 Then
    ba.text = Str$(r)
    b = r
End If
GoTo ri
ari:
Resume 6
6 ba.forecolor = &H80000008
ba.text = v$
screen.mousepointer = 0
End Sub

Sub b3_Click ()
screen.mousepointer = 11
meu$ = ba.text
ars = 0
ml.visible = 0
rs = 0
wg = 0
dpl = 0
Open ba.text For Output As 1
ba.text = ""
ba.forecolor = &H80&
lrs:
ml.listindex = rs
If rs > ml.listcount / 12 * x Then
    x = x + 1
    ba.text = ba.text + "X"
End If
p$ = ml.text
If k3.value = 1 And Left$(p$, 16) = Left$(sg$, 16) Then GoTo wt
If k4.value = 1 Then Print #1, Mid$(p$, 17, 1) + " ";
If le.value = 1 Then Print #1, Mid$(p$, 23, 3) + " ";
Print #1, Left$(p$, 16) + " ";
If k2.value = 1 Then Print #1, Mid$(p$, 18, 5) + " ";
If k4.value = 2 Then Print #1, Mid$(p$, 17, 1);
If dpl <> Val(na.text) - 1 Then
    Print #1, Right$(p$, 1) + " | ";
    dpl = dpl + 1
Else
    Print #1, Right$(p$, 1)
    dpl = 0
End If
wg = wg + 1
sg$ = p$
wt:
rs = rs + 1
If rs < ml.listcount Then GoTo lrs
Print #1,
Print #1, Str$(wg) + " Programs"
Close 1
ml.visible = -1
ba.text = meu$
ba.forecolor = &H80000008
screen.mousepointer = 0
End Sub

Sub k4_Click ()
If kw = 0 And k4.value = 1 Then
    k4.value = 2
    kw = 1
End If
If kw = 1 And k4.value = 1 Then kw = 0
End Sub

Sub lss ()
On Error GoTo ausl
su$ = InputBox$("Enter Search String")
If su$ = "" Then GoTo ausl
ba.forecolor = &H80&
Open bb.caption For Input As 1
Open ba.text For Output As 2
lil:
gz = gz + 1
If Val(ba.text) + 39 = gz Then ba.text = Str$(gz)
Line Input #1, l$
If InStr(l$, su$) <> 0 Then Print #2, l$
GoTo lil
ausl:
Resume 7
7 Close 2
Close 1
datei1.Refresh
End Sub

Sub le_KeyPress (tastenascii As Integer)
If le.caption = "no empty lines" Then le.value = 2
End Sub

