阡陌暮的部落格

Dim TempPsdString As String
Dim tem(3) As String
Private Sub Command1_Click()
Dim i As Integer
Dim TmpStr As String
List1.Clear
Open Text3 & "pwd.txt" For Output As #1
   Print ""
Close #1
For i = 0 To Text2 - 1
   TmpStr = GetStr(Text1)
   List1.AddItem TmpStr
   Open Text3 & "pwd.txt" For Append As #1
       Print #1, TmpStr
   Close #1
   Form1.Caption = "密码生成器" & "--已完成" & Int(i / (Text2 - 1) * 100) & "%"
Next
If MsgBox("已生成" & Text2 & "个" & Text1 & "字符的密码" & vbCr & "是否打开密码文件查看?", vbYesNo + vbInformation, "任务完成") = vbYes Then Shell "notepad.exe " & Text3 & "pwd.txt"
Form1.Caption = "密码生成器"
End Sub

Function GetStr(Index As Integer) As String
   If Index < 1 Then Exit Function
   Dim i As Integer
   Dim TmpStr As String
   For i = 1 To Index
      Randomize
      TmpStr = Mid(TempPsdString, Int(Len(TempPsdString) * Rnd) + 1, 1)
      GetStr = GetStr + CStr(TmpStr)
   Next
End Function

Private Sub Form_Load()
Text3 = App.Path
If Right(Text3, 1) <> "\" Then Text3 = Text3 & "\"
Text3 = App.Path
If Right(Text3, 1) <> "\" Then Text3 = Text3 & "\"
tem(0) = "0123456789"
tem(1) = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
tem(2) = "abcdefghijklmnopqrstuvwxyz"
tem(3) = "~!@#$%^&*()_+[]:,.<>?/*-"
TempPsdString = tem(0) + tem(1) + tem(2) + tem(3)
End Sub

Private Sub Check1_Click(Index As Integer)
TempPsdString = ""
For i = 0 To 3
   If Check1(i).Value = 1 Then TempPsdString = TempPsdString & tem(i)
Next
If TempPsdString = "" Then MsgBox "必须选择一项！": Check1(Index).Value = 1
End Sub

Public connSTR As String  '定义一个公用变量

Public Function CData() '连接数据库,
On Error GoTo errEnd
dbName = App.Path
If Right(dbName, 1) <> "\" Then dbName = dbName + "\"
dbName = dbName + "Data.mdb"
connSTR = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbName & ";Persist Security Info=False"
Exit Sub
errEnd:
   MsgBox err.Description, vbOKOnly + vbExclamation, "打开数据库出错"
End Function

'汉字转拼音
Public Function py(mystr As String) As String
 If Asc(mystr) < 0 Then
   If Asc(Left(mystr, 1)) < Asc("啊") Then
      py = "0"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("啊") And Asc(Left(mystr, 1)) < Asc("芭") Then
      py = "A"
      Exit Function
   End If
[separator]
   If Asc(Left(mystr, 1)) >= Asc("芭") And Asc(Left(mystr, 1)) < Asc("擦") Then
      py = "B"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("擦") And Asc(Left(mystr, 1)) < Asc("搭") Then
      py = "C"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("搭") And Asc(Left(mystr, 1)) < Asc("蛾") Then
      py = "D"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("蛾") And Asc(Left(mystr, 1)) < Asc("发") Then
      py = "E"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("发") And Asc(Left(mystr, 1)) < Asc("噶") Then
      py = "F"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("噶") And Asc(Left(mystr, 1)) < Asc("哈") Then
      py = "G"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("哈") And Asc(Left(mystr, 1)) < Asc("击") Then
      py = "H"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("击") And Asc(Left(mystr, 1)) < Asc("喀") Then
      py = "J"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("喀") And Asc(Left(mystr, 1)) < Asc("垃") Then
      py = "K"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("垃") And Asc(Left(mystr, 1)) < Asc("妈") Then
      py = "L"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("妈") And Asc(Left(mystr, 1)) < Asc("拿") Then
      py = "M"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("拿") And Asc(Left(mystr, 1)) < Asc("哦") Then
      py = "N"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("哦") And Asc(Left(mystr, 1)) < Asc("啪") Then
      py = "O"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("啪") And Asc(Left(mystr, 1)) < Asc("期") Then
      py = "P"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("期") And Asc(Left(mystr, 1)) < Asc("然") Then
      py = "Q"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("然") And Asc(Left(mystr, 1)) < Asc("撒") Then
      py = "R"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("撒") And Asc(Left(mystr, 1)) < Asc("塌") Then
      py = "S"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("塌") And Asc(Left(mystr, 1)) < Asc("挖") Then
      py = "T"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("挖") And Asc(Left(mystr, 1)) < Asc("昔") Then
      py = "W"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("昔") And Asc(Left(mystr, 1)) < Asc("压") Then
      py = "X"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("压") And Asc(Left(mystr, 1)) < Asc("匝") Then
      py = "Y"
      Exit Function
   End If
   If Asc(Left(mystr, 1)) >= Asc("匝") Then
      py = "Z"
      Exit Function
   End If
 Else
   If UCase(mystr) <= "Z" And UCase(mystr) >= "A" Then
      py = UCase(Left(mystr, 1))
     Else
      py = mystr
   End If
 End If

End Function
'汉字转拼音完

Private Sub Text1_Change()'text1l输入时在label1中即时显示拼音
 If Option1.Value = True Then
    Label1.Caption = ""
    Dim a As Integer
    a = Len(Text1.Text)
    For i = 1 To a
        Label1.Caption = Label1.Caption & py(Mid(Text1.Text, i, 1))
    Next i
 End If
End Sub

Private Sub Command1_Click()'按command1后在label1显示拼音
 Dim a As Integer
 Label1.Caption = ""
 a = Len(Text1.Text)
 For i = 1 To a
     Label1.Caption = Label1.Caption & py(Mid(Text1.Text, i, 1))
 Next i
End Sub