frmmain.frm

VB多功能密码生成器

            Case 0: sLine = GenPassword(26, 26, pLen)
            Case 1: sLine = GenPassword(0, 26, pLen)
            Case 2: sLine = GenPassword(52, 10, pLen)
            Case 3: sLine = GenPassword(0, 62, pLen)
            Case 4: sLine = GetExtPassword(pLen)
            Case 5: sLine = GetSpecialPassword(pLen)
            Case 6: sLine = GetPasswordAll(pLen)
            Case 7: sLine = GenPassword(52, 2, pLen)
        End Select
        
        DoEvents
        If SerachListBox(sLine, lstPasswords) <> -1 Then
        If ChkDup Then GoTo top:
    End If
    
        If cboIndex = 1 Then
            sLine = SortStr(sLine, True)
        End If
        
        If cboIndex = 2 Then
            sLine = SortStr(sLine, False)
        End If
        
        lstPasswords.AddItem sLine
    Next X
    
    
    lblGen.Caption = "密码产生: " & X
    sLine = ""
End Sub

Sub LoadSettings()
Dim aTmp As String
    aTmp = GetSetting("DmPassGen", "config", "PassLen", 6)
    SpinFx1.Value = CInt(aTmp)
    aTmp = GetSetting("DmPassGen", "config", "NoOfPass", 6)
    SpinFx2.Value = CInt(aTmp)
    aTmp = GetSetting("DmPassGen", "config", "NoDups", 1)
    ChkDup.Value = CInt(aTmp)
    aTmp = GetSetting("DmPassGen", "config", "SortOrder", 0)
    cboSort.ListIndex = aTmp
    aTmp = GetSetting("DmPassGen", "config", "GenOption", 0)
    OptGen(CInt(aTmp)).Value = True
    aTmp = ""
    
End Sub

Sub InvertPassword(LstBox As ListBox)
Dim X As Long
    For X = 0 To LstBox.ListCount - 1
        LstBox.List(X) = Invert(LstBox.List(X))
    Next X
    X = 0
End Sub

Sub RevPassword(LstBox As ListBox)
Dim X As Long
    For X = 0 To LstBox.ListCount - 1
        LstBox.List(X) = Reserve(LstBox.List(X))
    Next X
    X = 0
End Sub

Function SortStr(lpStr As String, bSort As Boolean) As String
Dim X As Long, Y As Long, TmpStr() As String, Size As Long, sBuff As String

    Size = Len(lpStr) - 1
    ReDim Preserve TmpStr(Size)

    For X = 1 To Len(lpStr)
        TmpStr(X - 1) = Mid(lpStr, X, 1)
    Next X
    
    For X = 0 To Size
        For Y = X + 1 To Size
            If bSort Then
                If TmpStr(X) > TmpStr(Y) Then Swap TmpStr(X), TmpStr(Y)
            Else
                If TmpStr(X) < TmpStr(Y) Then Swap TmpStr(X), TmpStr(Y)
            End If
        Next Y
    Next X
    
    For X = 0 To Size
        sBuff = sBuff & TmpStr(X)
    Next
    
    Erase TmpStr
    SortStr = sBuff
    sBuff = ""
    X = 0: Y = 0: Size = 0
    
End Function

Sub FixSpin(SpinObj As SpinFx)
    If Not isalnum(SpinObj.Text) Then SpinObj.Text = ""
End Sub

Function SerachListBox(lpSerachFor As String, cboBox As ListBox) As Integer
Dim n As Integer

    SerachListBox = -1
    For n = 0 To cboBox.ListCount
        If cboBox.List(n) = lpSerachFor Then
            SerachListBox = n
            Exit For
        End If
    Next n
    
End Function

Sub SortLB(bSort As Boolean)
Dim X As Long, Y As Long, iSize As Long

    
    'Sort a Listbox
    iSize = (lstPasswords.ListCount) - 1
    If iSize = -1 Then Exit Sub
    
    ReDim Preserve TmpPasswords(iSize)

    For X = 0 To iSize
        TmpPasswords(X) = lstPasswords.List(X)
    Next X
    
    lstPasswords.Clear
    
    For X = 0 To iSize
        For Y = X + 1 To iSize
            If bSort Then
                If Left(TmpPasswords(X), 1) > Left(TmpPasswords(Y), 1) Then
                    Swap TmpPasswords(X), TmpPasswords(Y)
                End If
            Else
                If Left(TmpPasswords(X), 1) < Left(TmpPasswords(Y), 1) Then
                    Swap TmpPasswords(X), TmpPasswords(Y)
                End If
            End If
        Next Y
    Next X
    
    For X = 0 To iSize
        lstPasswords.AddItem TmpPasswords(X)
    Next X
    
    Erase TmpPasswords
    
    iSize = 0
    X = 0: Y = 0
End Sub

Private Sub UnLoadForm()
    SaveSetting "DmPassGen", "config", "PassLen", SpinFx1.Text
    SaveSetting "DmPassGen", "config", "NoOfPass", SpinFx2.Text
    SaveSetting "DmPassGen", "config", "NoDups", ChkDup.Value
    SaveSetting "DmPassGen", "config", "SortOrder", cboSort.ListIndex
    SaveSetting "DmPassGen", "config", "GenOption", OptGenOption
    cboTmp = ""
    TmpOld = ""
    Unload frmmain
End Sub

Sub DoHover(Index As Integer)
Dim X As Integer
    DoEvents
    For X = 0 To lblButton.Count - 1
        lblButton(X).FontUnderline = False
        lblButton(X).ForeColor = vbWhite
        Next X
    If Index = -1 Then Exit Sub
    
    lblButton(Index).ForeColor = &HE0E0E0
    lblButton(Index).FontUnderline = True
End Sub

Sub DrawBar()
Dim X As Long
Static Y As Integer

    For X = 0 To Picbar.ScaleWidth
        BitBlt Picbar.hdc, X, 0, PicDc.ScaleWidth, PicDc.ScaleHeight, PicDc.hdc, 0, 0, vbSrcCopy
    Next X
    
    For X = 0 To PicA(0).ScaleWidth
        Y = (Not Y)
        BitBlt PicA(Abs(Y)).hdc, X - 1, 0, PicDc.ScaleWidth, PicDc.ScaleHeight, PicDc.hdc, 0, 0, vbSrcCopy
    Next X
    
    For X = 0 To PicA(2).ScaleWidth
        BitBlt PicA(2).hdc, X - 1, 0, PicDc.ScaleWidth, PicDc.ScaleHeight, PicDc.hdc, 0, 0, vbSrcCopy
    Next
    
    PicStatus.Line (0, 0)-(PicStatus.ScaleWidth - 2, PicStatus.ScaleHeight - 1), &H808080, B
    PicBar2.Line (0, 0)-(PicBar2.ScaleWidth - 1, PicBar2.ScaleHeight - 1), &HA0A0A0, B

    Picbar.Refresh
    PicBar2.Refresh
    PicA(0).Refresh
    PicA(1).Refresh
    
    Set PicDc = Nothing

End Sub

Private Sub ButtonFx1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    lblTip.Caption = "密码排序"
End Sub

Private Sub ButtonFx1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button <> vbLeftButton Then Exit Sub
    Sort = (Not Sort)
    
    If Not Sort Then
        Set ButtonFx1.Picture = pTmp.Picture
    Else
        Set ButtonFx1.Picture = pTmp2.Picture
    End If
    
    SortLB Sort
    
End Sub

Private Sub ButtonFx2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    lblTip.Caption = "复制密码到剪切板"
End Sub

Private Sub ButtonFx2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim xCnt As Long, sLine As String

    If Button <> vbLeftButton Then Exit Sub
    
    'Copy selected list items to the clipboard
    If lstPasswords.ListCount = 0 Then Exit Sub
    For xCnt = 0 To lstPasswords.ListCount - 1
        If lstPasswords.Selected(xCnt) Then
            sLine = sLine & lstPasswords.List(xCnt) & vbCrLf
        End If
    Next xCnt
    MsgBox sLine
    Clipboard.Clear
    Clipboard.SetText sLine, vbCFText
    sLine = ""
    
End Sub

Private Sub ButtonFx3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    lblTip.Caption = "密码打乱"
End Sub

Private Sub ButtonFx4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    lblTip.Caption = "导出密码清单"
End Sub

Private Sub ButtonFx4_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim pSize As Long, Counter As Long

    If Button <> vbLeftButton Then Exit Sub
    If lstPasswords.ListCount = 0 Then
        MsgBox "当前尚没有密码清单导出！" _
        & vbCrLf & "请先生成密码后在选择该功能.", vbInformation, "提示"
        Exit Sub
    Else
        pSize = (lstPasswords.ListCount) - 1
        
        Erase TmpPasswords
        ReDim Preserve TmpPasswords(pSize)
    
        For Counter = 0 To pSize
            TmpPasswords(Counter) = lstPasswords.List(Counter)
        Next Counter
    End If
    
    frmExport.Show vbModal, frmmain
End Sub

Private Sub ButtonFx5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    lblTip.Caption = "生成密码"
End Sub

Private Sub ButtonFx5_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button <> vbLeftButton Then Exit Sub
    Call GeneratePassword
End Sub

Private Sub ButtonFx6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    lblTip.Caption = "密码大小写转换"
End Sub

Private Sub ButtonFx6_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static iVert As Boolean

    If Button <> vbLeftButton Then Exit Sub
    iVert = Not iVert
    
    If iVert Then
        Set ButtonFx6.Picture = PicInv1.Picture
    Else
        Set ButtonFx6.Picture = PicInv2.Picture
    End If
    
    Call InvertPassword(lstPasswords)
End Sub

Private Sub cboSort_Change()
    cboSort.Text = cboTmp
End Sub

Private Sub cboSort_Click()
    cboTmp = cboSort.Text
    cboIndex = cboSort.ListIndex
End Sub

Private Sub ButtonFx3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static RevChar As Boolean

    If Button <> vbLeftButton Then Exit Sub
    RevChar = Not RevChar
    
    If RevChar Then
        Set ButtonFx3.Picture = Rev1.Picture
    Else
        Set ButtonFx3.Picture = rev2.Picture
    End If
    
    Call RevPassword(lstPasswords)
    
End Sub

Private Sub dmHyperLink1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button <> vbLeftButton Then Exit Sub
    OpenSite frmmain.hwnd, "http://www.eraystudios.com"
    dmHyperLink1.ForeColor = dmHyperLink1.HoverOut
    dmHyperLink1.Font.Underline = False
End Sub

Private Sub Form_Load()
       
    DialogH.DlgHwnd = frmmain.hwnd
    DialogH.flags = 0
    DialogH.hInst = App.hInstance
    
    Sort = True
    
    For X = 1 To lblButton.Count - 1
        Set lblButton(X).MouseIcon = lblButton(0).MouseIcon
    Next
    Set dmHyperLink1.MouseIcon = lblButton(0).MouseIcon
    dmHyperLink1.Caption = "Copyright