siehe Beschreibung

Dim dn__$(), zku__$(), zko__$(), zkn__$(), zk__$(), n, o, p, gef__$(), an, a, b, c, ze$

Dim zkurau__$(), zkorau__$(), zknrau__$(), zkm__$(), zrt, space_, zzkp, zkurt__$(), zkort__$(), zknrt__$(), ert, ort, prt, eu, eo, ep, e, zkee__$(), ee

Public Sub main()

ReDim dn__$(1000)

ReDim zku__$(20)

ReDim zko__$(20)

ReDim zkn__$(20)

ReDim zk__$(30)

ReDim gef__$(2000)

ReDim zkurau__$(10, 10)

ReDim zkorau__$(10, 10)

ReDim zknrau__$(10, 10)

ReDim zkm__$(10)

ReDim zkurt__$(10)

ReDim zkort__$(10)

ReDim zknrt__$(10)

ReDim zkee__$(100)

Dim pfautor$

Dim pfinout$

Dim nd

Dim dlg2 As Object

Dim pfad$

Dim i

Dim dlg1 As Object

Dim dn$

Dim kr1

Dim kr2

Dim kr3

Dim zk$

Dim z

Dim j

Dim f

n = 0

o = 0

p = 0

an = 0

a = 0

b = 0

c = 0

ze$ = ""

zrt = 0

space_ = 0

zzkp = 0

ert = 0

ort = 0

prt = 0

eu = 0

eo = 0

ep = 0

e = 0

ee = 0

Close

zrt = 6

WordBasic.FormatParagraph FirstIndent:="-0,65 cm"

zkm__$(1) = Chr(32): zkm__$(2) = ",": zkm__$(3) = ".": zkm__$(4) = "?": zkm__$(5) = ";": zkm__$(6) = "!": zkm__$(7) = Chr(34): zkm__$(8) = "'": zkm__$(9) = Chr(148)

Close

pfautor$ = "C:/"

pfinout$ = "c:/suchen.txt"

WordBasic.ChDir pfautor$

ReDim sw__$(3)

Open pfinout$ For Input As 1

Line Input #1, sw__$(0)

If sw__$(0) = "" Then sw__$(0) = pfautor$: GoTo WEITR

Line Input #1, sw__$(1)

WEITR:

Close

start:

If nd = 1 Then

Set dlg2 = WordBasic.DialogRecord.FileOpen(False)

WordBasic.CurValues.FileOpen dlg2

dlg2.Name = "*.txt"

On Error Resume Next

WordBasic.Dialog.FileOpen dlg2

pfad$ = WordBasic.[Files$](".")

Close

Open pfinout$ For Output As 1

'Open "c:/ww2/werte/suchen.txt" For Output As #1

'Print #1, Date$()

Print #1, pfad$

dn__$(n) = WordBasic.[Files$]("*.txt")

While dn__$(n) <> ""

n = n + 1

dn__$(n) = WordBasic.[Files$]()

WordBasic.PrintStatusBar dn__$(n), n

Wend

For i = 0 To n

While InStr(dn__$(i), "/") <> 0

dn__$(i) = Mid(dn__$(i), InStr(dn__$(i), "/") + 1)

Wend

Next

WordBasic.BeginDialog 140, 89, 356, 260, "Microsoft Word"

WordBasic.Text 10, 6, 188, 19, "Wählen Sie eine Datei aus!"

WordBasic.ListBox 15, 30, 312, 183, dn__$(), "lstbx"

WordBasic.OKButton 133, 231, 88, 21

WordBasic.CancelButton 22, 230, 95, 24

WordBasic.EndDialog

Set dlg1 = WordBasic.CurValues.UserDialog

WordBasic.CurValues.UserDialog dlg1

If Not WordBasic.Dialog.UserDialog(dlg1) Then

GoTo ende

End If

dn$ = dn__$(dlg1.lstbx)

Print #1, dn$

Close

Else

WordBasic.ChDir sw__$(0)

dn$ = sw__$(1)

End If

WEITER:

WordBasic.BeginDialog 688, 300, "Microsoft Word"

WordBasic.Text 191, 11, 350, 19, "Die zu durchsuchende Datei ist " + dn$

WordBasic.Text 27, 45, 536, 27, "Geben Sie eine oder mehrere Zeichenfolgen ein und trennen Sie sie durch + (Pluszeichen)"

WordBasic.Text 27, 87, 437, 15, "Alle Ausdrücke sollen in einem Paragraph enthalten sein."

WordBasic.TextBox 26, 113, 345, 18, "tbx1"

WordBasic.Text 34, 144, 274, 13, "Einer der Ausdrücke soll enthalten sein."

WordBasic.TextBox 32, 165, 345, 18, "tbx2"

WordBasic.Text 32, 195, 383, 13, "Die folgenden Ausdrücke sollen nicht enthalten sein."

WordBasic.TextBox 37, 215, 345, 18, "tbx3"

WordBasic.CheckBox 360, 261, 170, 22, "neue Datei suchen", "chbx"

WordBasic.OKButton 45, 263, 83, 21

WordBasic.CancelButton 189, 265, 83, 21

WordBasic.EndDialog

Set dlg1 = WordBasic.CurValues.UserDialog

Dim dlg As Object: Set dlg = WordBasic.CurValues.UserDialog

WordBasic.CurValues.UserDialog dlg

If Not WordBasic.Dialog.UserDialog(dlg) Then GoTo ende

nd = dlg.chbx

If dlg.chbx = 1 Then GoTo start

If dlg.tbx1 > "" Then kr1 = 1

If dlg.tbx2 > "" Then kr2 = 1

If dlg.tbx3 > "" Then kr3 = 1

If kr1 Then

zk$ = dlg.tbx1

n = 0

If InStr(dlg.tbx1, "+") <> 0 Then

While InStr(zk$, "+")

z = InStr(zk$, "+")

n = n + 1

zku__$(n) = WordBasic.[Left$](zk$, z - 1)

zk$ = Mid(zk$, z + 1)

Wend

End If

n = n + 1

zku__$(n) = zk$

End If

For i = 1 To n

If WordBasic.[Right$](zku__$(i), 1) = "#" Then

ert = ert + 1

zkurt__$(ert) = WordBasic.[Left$](zku__$(i), Len(zku__$(i)) - 1)

Else

eu = eu + 1: ee = ee + 1: zkee__$(ee) = zku__$(i)

zku__$(eu) = zku__$(i)

End If

Next

If ert > 0 Then

For i = 1 To ert

For j = 1 To zrt 'Wö.m.Rautenendung

zkurau__$(i, j) = zkurt__$(i) + zkm__$(j)

ee = ee + 1: zkee__$(ee) = zkurau__$(i, j)

Next

Next

End If

If kr2 Then

zk$ = dlg.tbx2

If InStr(dlg.tbx2, "+") <> 0 Then

While InStr(zk$, "+")

z = InStr(zk$, "+")

o = o + 1

zko__$(o) = WordBasic.[Left$](zk$, z - 1)

zk$ = Mid(zk$, z + 1)

Wend

End If

o = o + 1

zko__$(o) = zk$

End If

For i = 1 To o

If WordBasic.[Right$](zko__$(i), 1) = "#" Then

ort = ort + 1

zkort__$(ort) = WordBasic.[Left$](zko__$(i), Len(zko__$(i)) - 1)

Else

eo = eo + 1

zko__$(eo) = zko__$(i): ee = ee + 1: zkee__$(ee) = zko__$(i)

End If

Next

If ort > 0 Then

For i = 1 To ort

For j = 1 To zrt

zkorau__$(i, j) = zkort__$(i) + zkm__$(j)

ee = ee + 1: zkee__$(ee) = zkorau__$(i, j)

Next

Next

End If

If kr3 Then

zk$ = dlg.tbx3

If InStr(dlg.tbx3, "+") <> 0 Then

While InStr(zk$, "+")

z = InStr(zk$, "+")

p = p + 1

zkn__$(p) = WordBasic.[Left$](zk$, z - 1)

zk$ = Mid(zk$, z + 1)

Wend

End If

p = p + 1

zkn__$(p) = zk$

End If

For i = 1 To p

If WordBasic.[Right$](zkn__$(i), 1) = "#" Then

prt = prt + 1

zknrt__$(prt) = WordBasic.[Left$](zkn__$(i), Len(zkn__$(i)) - 1)

Else

ep = ep + 1

zkn__$(ep) = zkn__$(i)

End If

Next

If prt > 0 Then

For i = 1 To prt

For j = 1 To zrt

zknrau__$(i, j) = zknrt__$(i) + zkm__$(j)

Next

Next

End If

If kr1 Then

If kr2 And kr3 Then

f = 4

ElseIf kr2 Then

f = 2

ElseIf kr3 Then

f = 3

Else

f = 1

End If

Else

If kr2 And kr3 Then

f = 6

ElseIf kr3 Then

f = 7

Else

f = 5

End If

End If

Select Case f

Case 1

Close

Open dn$ For Input As 1

While Not EOF(1)

Line Input #1, ze$

UPU

If a Then

a = 0

an = an + 1: WordBasic.Insert Mid(Str(an), 2) + Chr(9)

WordBasic.Insert ze$: UPE

End If

Wend

Case 2

Open dn$ For Input As 1

While Not EOF(1)

Line Input #1, ze$

UPU

If a Then

a = 0

UPO

End If

If b Then

b = 0

an = an + 1: WordBasic.Insert Mid(Str(an), 2) + Chr(9)

WordBasic.Insert ze$: UPE

End If

Wend

Case 3

Open dn$ For Input As 1

While Not EOF(1)

Line Input #1, ze$

UPU

If a Then

a = 0

UPN

End If

If c Then

c = 0

an = an + 1: WordBasic.Insert Mid(Str(an), 2) + Chr(9)

WordBasic.Insert ze$: UPE

End If

Wend

Case 4

Open dn$ For Input As 1

While Not EOF(1)

Line Input #1, ze$

UPU

If a Then

a = 0

UPO

End If

If b Then

b = 0

UPN

End If

If c Then

c = 0

an = an + 1: WordBasic.Insert Mid(Str(an), 2) + Chr(9)

WordBasic.Insert ze$: UPE

End If

Wend

Case 5

Open dn$ For Input As 1

While Not EOF(1)

Line Input #1, ze$

UPO

If b Then

b = 0

an = an + 1: WordBasic.Insert Mid(Str(an), 2) + Chr(9)

WordBasic.Insert ze$: UPE

End If

Wend

Case 6

Open dn$ For Input As 1

While Not EOF(1)

Line Input #1, ze$

UPO

If b Then

b = 0

UPN

End If

If c Then

c = 0

an = an + 1: WordBasic.Insert Mid(Str(an), 2) + Chr(9)

WordBasic.Insert ze$: UPE

End If

Wend

Case Else

Open dn$ For Input As 1

While Not EOF(1)

Line Input #1, ze$

UPN

If c Then

c = 0

an = an + 1: WordBasic.Insert Mid(Str(an), 2) + Chr(9)

WordBasic.Insert ze$: UPE

End If

Wend

End Select

ende:

ENDERSETZUNG

End Sub

'000000000000000000000000000

Private Sub UPU()

Dim i

Dim j

Dim und

Dim n1

For i = 1 To ert

For j = 1 To zrt

If InStr(ze$, zkurau__$(i, j)) <> 0 Then

und = und + 1: e = e + 1: zk__$(e) = zkurau__$(i, j): j = zrt

End If

Next

Next

For i = 1 To eu

If InStr(ze$, zku__$(i)) = 0 Then

i = n: n1 = 1

Else

und = und + 1: e = e + 1: zk__$(e) = zku__$(i)

End If

Next

If ert + eu = und Then

a = 1

Else

e = 0

End If

und = 0

End Sub

'-------------------------

Private Sub UPO()

Dim i

Dim j

For i = 1 To ort

For j = 1 To zrt

If InStr(ze$, zkorau__$(i, j)) <> 0 Then

b = 1: e = e + 1: zk__$(e) = zkorau__$(i, j): j = zrt

End If

Next

Next

If b Then GoTo ende

For i = 1 To eo

If InStr(ze$, zko__$(i)) <> 0 Then

b = 1: e = e + 1: zk__$(e) = zko__$(i): i = eo

End If

Next

ende:

If b = 0 Then e = 0

End Sub

'---------------------

Private Sub UPN()

Dim i

Dim j

For i = 1 To prt

For j = 1 To zrt

If InStr(ze$, zknrau__$(i, j)) <> 0 Then

c = 2: j = zrt

End If

Next

Next

If c Then GoTo ende

For i = 1 To ep

If InStr(ze$, zkn__$(i)) <> 0 Then

c = 2: i = ep

End If

Next

ende:

If c = 2 Then

c = 0 'vorhanden

Else

c = 1 'nicht vorhanden

End If

End Sub

'---------------------

Private Sub UPE()

Dim i

WordBasic.ParaUp

WordBasic.EditFindClearFormatting

For i = 1 To e

WordBasic.PrintStatusBar zk__$(i)

WordBasic.EditReplaceFont Points:="", Underline:=-1, Color:=6, StrikeThrough:=-1, Superscript:=-1, Subscript:=-1, Hidden:=-1, SmallCaps:=-1, AllCaps:=-1, Spacing:="", Position:="", Kerning:=-1, KerningMin:="", Tab:="0", Font:="(normaler Text)", Bold:=-1, Italic:=-1

WordBasic.EditReplace Find:=zk__$(i), Replace:=zk__$(i), Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, ReplaceAll:=1, Format:=1, Wrap:=0

Next

WordBasic.ParaDown

WordBasic.InsertPara

WordBasic.CharLeft 2, 1: WordBasic.FormatFont Color:=1: WordBasic.CharRight

e = 0

End Sub

'------------------------

Private Sub ENDERSETZUNG()

Dim i

WordBasic.EditFindClearFormatting

For i = 1 To ee

WordBasic.PrintStatusBar zkee__$(i)

WordBasic.EditReplaceFont Points:="", Underline:=-1, Color:=6, StrikeThrough:=-1, Superscript:=-1, Subscript:=-1, Hidden:=-1, SmallCaps:=-1, AllCaps:=-1, Spacing:="", Position:="", Kerning:=-1, KerningMin:="", Tab:="0", Font:="(normaler Text)", Bold:=-1, Italic:=-1

WordBasic.EditReplace Find:=zkee__$(i), Replace:=zkee__$(i), Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, ReplaceAll:=1, Format:=1, Wrap:=1

Next

End Sub