VB急速密码生成---RndString

来源：巧巧读书网作者：狂族魔帝出处：巧巧读书 2007-12-15 进入讨论组

关键词：
rip

调用实例：
将下面内容保存为*.frm
VERSION 5.00
Begin VB.Form Form1
Caption = "Over 0"
ClientHeight = 2730

   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5115
   LinkTopic       =   "Form1"
   ScaleHeight     =   2730
   ScaleWidth      =   5115
   StartUpPosition =   3 '窗口缺省
   Begin VB.CheckBox Check3
      Caption         =   "BigWrite"
      Height          =   255
      Left            =   2880
      TabIndex        =   4
      Top             =   0
      Visible         =   0   'False
      Width           =   1080
   End
   Begin VB.CommandButton Command4
      Caption         =   "About.."
      Height          =   495
      Left            =   4080
      TabIndex        =   8
      Top             =   1620
      Width           =   975
   End
   Begin VB.CommandButton Command3
      Caption         =   "Exit"
      Height          =   495
      Left            =   4080
      TabIndex        =   9
      Top             =   2200
      Width           =   975
   End
   Begin VB.CommandButton Command2
      Caption         =   "Output to c:\Rndtxt.txt"
      Height          =   495
      Left            =   4080
      TabIndex        =   7
      Top             =   360
      Width           =   975
   End
   Begin VB.CheckBox Check2
      Caption         =   "Str"
      Height          =   255
      Left            =   2160
      TabIndex        =   3
      Top             =   0
      Width           =   615
   End
   Begin VB.CheckBox Check1
      Caption         =   "Num"
      Height          =   255
      Left            =   1560
      TabIndex        =   2
      Top             =   0
      Value           =   1 'Checked
      Width           =   615
   End
   Begin VB.TextBox Text3
      Height          =   270
      Left            =   600
      MaxLength       =   6
      TabIndex        =   1
      Text            =   "10"
      Top             =   0
      Width           =   855
   End
   Begin VB.CommandButton Command1
      Caption         =   "Start"
      Height          =   495
      Left            =   4080
      TabIndex        =   5
      Top             =   960
      Width           =   975
   End
   Begin VB.TextBox Text2
      Height          =   2295
      Left            =   0
      MultiLine       =   -1 'True
      TabIndex        =   6
      Top             =   360
      Width           =   3975
   End
   Begin VB.TextBox Text1
      Height          =   915
      Left            =   720
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   540
      Visible         =   0   'False
      Width           =   3795
   End
   Begin VB.Label Label1
      AutoSize        =   -1 'True
      BackStyle       =   0 'Transparent
      Caption         =   "Length:"
      Height          =   180
      Left            =   0
      TabIndex        =   10
      Top             =   0
      Width           =   630
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim nt As Boolean

Private Sub Check2_Click()
On Error GoTo ert
If False Then
ert:
MsgBox "错误 " & Err.Number & " ：" & Err.Description
Exit Sub
End If
If Check2.Value = 1 Then Check3.Visible = True Else Check3.Visible = False: Check3.Value = 0
End Sub

Private Sub Command1_Click()
Dim T
''''On Error GoTo ert
If False Then
ert:
MsgBox "错误 " & Err.Number & " ：" & Err.Description
Exit Sub
End If
If nt Then Edd: Exit Sub
Dim Cs As Long, fw As Long
Cs = 0
Cs = Val(Text3.Text)
If Check1.Value = 0 And Check2.Value = 0 Then Check1.Value = 1
'fw = IIf(Check1.Value = 1, 2, 0) + IIf(Check2.Value = 1, 1, 0)
Command1.Caption = "End"
nt = True
T = Timer
RndStr Cs, (Check2.Value = 1), (Check1.Value = 1), Form1.Text1, Text2, (Check3.Value = 1), True, , Me, IIf(Val(Text3) > 99999, 99999, 70000)
MsgBox "耗时" & Val((Timer - T) * 10) / 10 & "秒"
nt = False
Command1.Caption = "Start"
Caption = "Over " & Len(Text2.Text)
End Sub
Private Sub Command2_Click()
On Error GoTo ert
If False Then
ert:
MsgBox "错误 " & Err.Number & " ：" & Err.Description
Exit Sub
End If
Dim T
''''On Error GoTo ert
If False Then
ert:
MsgBox "错误 " & Err.Number & " ：" & Err.Description
Exit Sub
End If
If nt Then Edd: Exit Sub
Dim Cs As Long, fw As Long
Cs = 0
Cs = Val(Text3.Text)
If Check1.Value = 0 And Check2.Value = 0 Then Check1.Value = 1
'fw = IIf(Check1.Value = 1, 2, 0) + IIf(Check2.Value = 1, 1, 0)
Command1.Caption = "End"
nt = True
T = Timer
RndStr Cs, (Check2.Value = 1), (Check1.Value = 1), Form1.Text1, Text2, (Check3.Value = 1), False, "c:\Rndtxt.txt", Me, IIf(Val(Text3) > 5000, 3000, 5000)
MsgBox "耗时" & Val((Timer - T) * 10) / 10 & "秒"
nt = False
Command1.Caption = "Start"
Caption = "Over " & Len(Text2.Text)
End Sub
Function RndStr(Length As Long, StrY As Boolean, Num As Boolean, TemObj As TextBox, PutText As TextBox, Optional BigWrite As Boolean = False, Optional Returnw As Boolean = True, Optional FilePath As String = "", Optional FrmC As Form, Optional PerNum As Long = 50000)
End Function
Private Sub Command3_Click()
On Error GoTo ert
If False Then
ert:
MsgBox "错误 " & Err.Number & " ：" & Err.Description
Exit Sub
End If
Edd
Unload Me
End
End Sub
Private Sub Command4_Click()
On Error GoTo ert
If False Then
ert:
MsgBox "错误 " & Err.Number & " ：" & Err.Description
Exit Sub
End If
MsgBox "Made at Http://hi.baidu.com " & vbCrLf & " QQ:381504449 E-mail:wwc7654321@yahoo.com.cn", , "Rnd"
End Sub

Private Sub Form_Load()

On Error GoTo ert
If False Then
ert:
MsgBox "错误 " & Err.Number & " ：" & Err.Description
Exit Sub
End If
nt = False
'd:\Inetpub\key.txt,255,1,1,1
End Sub

Private Sub Text3_Change()
On Error GoTo ert
If False Then
ert:
MsgBox "错误 " & Err.Number & " ：" & Err.Description
Exit Sub
End If
Text3.Text = Val(Text3.Text)
If Val(Text3.Text) < 0 Then Text3.Text = -Val(Text3.Text)
If Val(Text3.Text) = 0 Then Text3.Text = 10
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
On Error GoTo ert
If False Then
ert:
MsgBox "错误 " & Err.Number & " ：" & Err.Description
Exit Sub
End If
If KeyAscii = 13 Then Command1_Click: KeyAscii = 0
End Sub