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