[HaBo]

Ein KeyGen wär aber auch nice.

Option Explicit
Dim user As String
Dim usa As Integer
Dim usc As Integer
Dim userm(2) As String
Dim usac As Integer
Dim usermz As String
Dim a As Boolean
Dim b As Boolean

Public Enum jxSelectedConstants
  jxAll
  jxSelected
  jxSelectedRange
End Enum

Public Function JoinEx(Data As Variant, _
 Optional Separator As String = "", _
 Optional TrimSeparator As Boolean = True, _
 Optional ByVal First As Variant, _
 Optional ByVal Count As Variant, _
 Optional ByVal Last As Variant, _
 Optional ByVal Reverse As Boolean, _
 Optional ByVal SwapRange As Boolean = False, _
 Optional IndexList As Variant, _
 Optional ByVal Selected As jxSelectedConstants) As String

  Dim nObj As Object
  
  If IsArray(Data) Then
    JoinEx = JoinExArray(Data, Separator, TrimSeparator, First, _
     Count, Last, Reverse, SwapRange, IndexList)
  ElseIf IsObject(Data) Then
    Set nObj = Data
    Select Case TypeName(Data)
      Case "Collection", "ListBox", "ComboBox", "FileListBox"
        JoinEx = JoinExList(nObj, Separator, TrimSeparator, First, _
         Count, Last, Reverse, SwapRange, IndexList, Selected)
    End Select
  End If
End Function

Public Function JoinExArray(Data As Variant, _
 Optional Separator As String = "", _
 Optional TrimSeparator As Boolean = True, _
 Optional ByVal First As Variant, _
 Optional ByVal Count As Variant, _
 Optional ByVal Last As Variant, _
 Optional ByVal Reverse As Boolean, _
 Optional ByVal SwapRange As Boolean = False, _
 Optional IndexList As Variant) As String

  Dim l As Long
  Dim nFirst As Long
  Dim nLast As Long
  Dim nSwap As Long
  Dim nReverse As Boolean
  Dim nStep As Integer
  Dim nJoinEx As String
  Dim nTest As String
  
  On Error GoTo Error_JoinExArray
  If IsEmpty(Data) Then
    Exit Function
  End If
  nTest = Data(LBound(Data))
  If IsMissing(IndexList) Then
    If IsMissing(First) Then
      nFirst = LBound(Data)
    Else
      nFirst = First
    End If
    If IsMissing(Count) Then
      If IsMissing(Last) Then
        nLast = UBound(Data)
      Else
        nLast = Last
      End If
    Else
      nLast = nFirst + Count - 1
    End If
    If Reverse Then
      nReverse = True
      nStep = -1
    Else
      nStep = 1
    End If
    If SwapRange Then
      If nLast < nFirst Then
        nReverse = Not nReverse
      End If
    End If
    If nReverse Then
      nSwap = nLast
      nLast = nFirst
      nFirst = nSwap
    End If
    If nFirst < LBound(Data) Then
      nFirst = LBound(Data)
    End If
    If nLast > UBound(Data) Then
      nLast = UBound(Data)
    End If
    For l = nFirst To nLast Step nStep
      nJoinEx = nJoinEx & Data(l) & Separator
    Next 'l
  Else
    If Reverse Then
      nFirst = UBound(IndexList)
      nLast = LBound(IndexList)
      nStep = -1
    Else
      nLast = UBound(IndexList)
      nFirst = LBound(IndexList)
      nStep = 1
    End If
    For l = nFirst To nLast Step nStep
      Select Case IndexList(l)
        Case LBound(Data) To UBound(Data)
          nJoinEx = nJoinEx & Data(IndexList(l)) & Separator
      End Select
    Next 'l
  End If
  If TrimSeparator Then
    If Len(nJoinEx) Then
      nJoinEx = Left$(nJoinEx, Len(nJoinEx) - Len(Separator))
    End If
  End If
  JoinExArray = nJoinEx
  
Error_JoinExArray:
End Function

Public Function JoinExCollection(Coll As Collection, _
 Optional Separator As String = "", _
 Optional TrimSeparator As Boolean = True, _
 Optional ByVal First As Variant, _
 Optional ByVal Count As Variant, _
 Optional ByVal Last As Variant, _
 Optional ByVal Reverse As Boolean, _
 Optional ByVal SwapRange As Boolean = False, _
 Optional IndexList As Variant) As String

  Dim l As Long
  Dim nFirst As Long
  Dim nLast As Long
  Dim nSwap As Long
  Dim nReverse As Boolean
  Dim nStep As Integer
  Dim nJoinEx As String
  
  With Coll
    If .Count = 0 Then
      Exit Function
    End If
    If IsMissing(IndexList) Then
      If IsMissing(First) Then
        nFirst = 1
      Else
        nFirst = First
      End If
      If IsMissing(Count) Then
        If IsMissing(Last) Then
          nLast = .Count
        Else
          nLast = Last
        End If
      Else
        nLast = nFirst + Count - 1
      End If
      If Reverse Then
        nReverse = True
        nStep = -1
      Else
        nStep = 1
      End If
      If SwapRange Then
        If nLast < nFirst Then
          nReverse = Not nReverse
        End If
      End If
      If nReverse Then
        nSwap = nLast
        nLast = nFirst
        nFirst = nSwap
      End If
      If nFirst < 1 Then
        nFirst = 1
      End If
      If nLast > .Count Then
        nLast = .Count
      End If
      For l = nFirst To nLast
        nJoinEx = nJoinEx & .Item(l) & Separator
      Next 'l
    Else
      On Error GoTo Error_JoinExCollection
      If Reverse Then
        nFirst = UBound(IndexList)
        nLast = LBound(IndexList)
        nStep = -1
      Else
        nLast = UBound(IndexList)
        nFirst = LBound(IndexList)
        nStep = 1
      End If
      For l = nFirst To nLast Step nStep
        Select Case IndexList(l)
          Case 1 To .Count
            nJoinEx = nJoinEx & .Item(IndexList(l)) & Separator
        End Select
      Next 'l
    End If
    If TrimSeparator Then
      If Len(nJoinEx) Then
        nJoinEx = Left$(nJoinEx, Len(nJoinEx) - Len(Separator))
      End If
    End If
  End With
  JoinExCollection = nJoinEx
  
Error_JoinExCollection:
End Function

Public Function JoinExList(List As Object, _
 Optional Separator As String = "", _
 Optional TrimSeparator As Boolean = True, _
 Optional ByVal First As Variant, _
 Optional ByVal Count As Variant, _
 Optional ByVal Last As Variant, _
 Optional ByVal Reverse As Boolean, _
 Optional ByVal SwapRange As Boolean = False, _
 Optional IndexList As Variant, _
 Optional ByVal Selected As jxSelectedConstants) As String

  Dim l As Long
  Dim nFirst As Long
  Dim nLast As Long
  Dim nSwap As Long
  Dim nReverse As Boolean
  Dim nStep As Integer
  Dim nJoinEx As String
  Dim nSelected() As String
  Dim nIndex As Long
  
  With List
    If .ListCount = 0 Then
      Exit Function
    End If
    If IsMissing(IndexList) Then
      If IsMissing(First) Then
        nFirst = 0
      Else
        nFirst = First
      End If
      If IsMissing(Count) Then
        If IsMissing(Last) Then
          nLast = .ListCount - 1
        Else
          nLast = Last
        End If
      Else
        nLast = nFirst + Count - 1
      End If
      If Reverse Then
        nReverse = True
        nStep = -1
      Else
        nStep = 1
      End If
      If SwapRange Then
        If nLast < nFirst Then
          nReverse = Not nReverse
        End If
      End If
      If nReverse Then
        nSwap = nLast
        nLast = nFirst
        nFirst = nSwap
      End If
      If nFirst < 0 Then
        nFirst = 0
      End If
      If nLast > .ListCount - 1 Then
        nLast = .ListCount - 1
      End If
      If TypeName(List) = "ListBox" Then
        Select Case Selected
          Case jxAll
            For l = nFirst To nLast
              nJoinEx = nJoinEx & .List(l) & Separator
            Next 'l
          Case jxSelected
            For l = nFirst To nLast
              If .Selected(l) Then
                nJoinEx = nJoinEx & .List(l) & Separator
              End If
            Next 'l
          Case jxSelectedRange
            ReDim nSelected(0 To .SelCount - 1)
            For l = 0 To .ListCount - 1
              If .Selected(l) Then
                nSelected(nIndex) = .List(l)
                nIndex = nIndex + 1
              End If
            Next 'l
            JoinExList = JoinExArray(nSelected, Separator, _
             TrimSeparator, First, Count, Last)
            Exit Function
        End Select
      Else
        For l = nFirst To nLast
          nJoinEx = nJoinEx & .List(l) & Separator
        Next 'l
      End If
    Else
      On Error GoTo Error_JoinExList
      If Reverse Then
        nFirst = UBound(IndexList)
        nLast = LBound(IndexList)
        nStep = -1
      Else
        nLast = UBound(IndexList)
        nFirst = LBound(IndexList)
        nStep = 1
      End If
      If Selected Then
        For l = nFirst To nLast Step nStep
          Select Case IndexList(l)
            Case 0 To .ListCount - 1
              If .Selected(IndexList(l)) Then
                nJoinEx = nJoinEx & .List(IndexList(l)) & Separator
              End If
          End Select
        Next 'l
      Else
        For l = nFirst To nLast Step nStep
          Select Case IndexList(l)
            Case 0 To .ListCount - 1
              nJoinEx = nJoinEx & .List(IndexList(l)) & Separator
          End Select
        Next 'l
      End If
    End If
    If TrimSeparator Then
      If Len(nJoinEx) Then
        nJoinEx = Left$(nJoinEx, Len(nJoinEx) - Len(Separator))
      End If
    End If
  End With
  JoinExList = nJoinEx
  
Error_JoinExList:
End Function


Private Sub cmdcheck_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
user = txtuser.Text
If (Len(user) < 5) Then
    MsgBox "Username muss länger als 5 Zeichen sein!"
Else
    usa = Asc(user)
    usc = Len(user)
    userm(0) = Mid(user, 2)
    userm(1) = Left(user, 3)
    userm(2) = Right(user, 4)
    If (IsNumeric(txtpass.Text)) Then
        If (txtpass.Text = usc + usa) Then
            a = True
        End If
        If (txtsec.Text = JoinEx(userm, "a1m9s1T6S")) Then
            b = True
        End If
    Else
        MsgBox "Code eingabe muss aus Zahlen bestehen!"
    End If
End If
End Sub

Private Sub cmdcheck_Click()
If (a And b) Then
    frmHide.Show
    frmHide.Visible = True
    frmHide.Enabled = True
End If
End Sub