Dim flags() As Byte
Dim chars() As Boolean
Dim maxDeep As Integer
 
Dim CharSet1 As String
Dim CharSet2 As String
Dim maxDeep1 As Byte
 
 
Sub main()
 
Dim i As Integer
 
CharSet1 = " ef"
CharSet2 = "abcdghijklmnopqrstuvwxyz"
ReDim flags(Len(CharSet1))
ReDim chars(Len(CharSet2))
maxDeep1 = 5
For i = 1 To Len(CharSet1): flags(i) = 0: Next i      ' müßte ansich nicht sein 
' ...
For i = 1 To Len(CharSet2): chars(i) = False: Next i
Open FILENAME For Output As #1
rec1 "", 0
Close #1
 
End Sub
 
 
Function rec1(ByVal tStr As String, ByVal actDeep As Byte) As String
 
Dim b As Byte
Dim c As Byte
Dim i As Byte
 
If actDeep < maxDeep1 Then
  For b = 1 To Len(CharSet1)
    flags(b) = flags(b) + 1
    rec1 tStr + Mid$(CharSet1, b, 1), actDeep + 1
    flags(b) = flags(b) - 1
  Next b
Else
  If (flags(2) > 0) And (flags(3) > 0) Then    ' nur getrickst, weil ich 
  ' weiß, wo die Zeichen stehen
    c = 0
    For i = 1 To maxDeep1
      If Mid$(tStr, i, 1) = " " Then c = c + 1
    Next i
    rec2 tStr, "", 0, c
  End If
End If
End Function
 
 
Function rec2(ByVal strMask As String, ByVal tStr As String, ByVal actDeep As _
  Byte, ByVal maxDeep As Byte) As String
 
Dim b As Byte
Dim c As Byte
Dim i As Byte
 
If actDeep < maxDeep Then
  For b = 1 To Len(CharSet2)
    If Not chars(b) Then
      chars(b) = True
      rec2 strMask, tStr + Mid$(CharSet2, b, 1), actDeep + 1, maxDeep
      chars(b) = False
    End If
  Next b
Else
  c = 0
  For i = 1 To maxDeep1
    If Mid$(strMask, i, 1) = " " Then
      c = c + 1
      Mid(strMask, i) = Mid$(tStr, c, 1)
    End If
  Next i
  Print #1, strMask
End If
 
End Function