| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 6392 人关注过本帖
标题:[求助]一个程序,想破头了都不知该怎么编!
只看楼主 加入收藏
ioriliao
Rank: 7Rank: 7Rank: 7
来 自:广东
等 级:贵宾
威 望:32
帖 子:2829
专家分:647
注 册:2006-11-30
收藏
得分:0 
我的产生一万能条用时四十秒...但我保证了是绝对的随机和绝对不存在重复..就算是删除了以前生成的文本也不会产生重复的字符串!

/images/2011/147787/2011051411021524.jpg" border="0" />
2007-04-10 19:26
Joforn
Rank: 6Rank: 6
等 级:贵宾
威 望:23
帖 子:1242
专家分:122
注 册:2007-1-2
收藏
得分:0 
以下是引用freeforever在2007-4-10 18:03:53的发言:
??不可能吧,把你的验证程序代码发上来看看

For k = 1 To 16
intTmp = Rnd * 1000 Mod 61 + 1
Print #1, Mid(strALl, intTmp, 1);
Next k
再加上后面的一次不就是写了17次文件吗?


VB QQ群:47715789
2007-04-10 19:50
Joforn
Rank: 6Rank: 6
等 级:贵宾
威 望:23
帖 子:1242
专家分:122
注 册:2007-1-2
收藏
得分:0 

MJpgsh18.rar (13.63 KB) [求助]一个程序,想破头了都不知该怎么编!


这是我的源码,我测试过100万条大概要花30秒左右。

'下面是主要的代码:

Private Sub CreatFile(Optional ByVal L As Long = 10000)
Dim PathName As String, ID(5) As Byte, IDS(21) As Byte, K As Byte
Dim I As Long, File1 As Long, File2 As Long, RndTime As Byte
Dim StartTime As Date, Flag1 As Boolean, Flag2 As Boolean, Flag3 As Boolean

On Error Resume Next
If L < 1 Then Exit Sub
PathName = App.Path
PathName = PathName & IIf(Right(PathName, 1) = "\", "NumSTRS.Ron", "\NumSTRS.Ron")
File1 = FreeFile
Open PathName For Binary As #File1
Get #File1, 1, ID
For I = 0 To 5
File2 = File2 Or ID(I)
Next
If File2 = 0 Then
ID(0) = 73
ID(1) = 108
ID(2) = 97
ID(3) = 104
ID(4) = 105
ID(5) = 99
End If
File2 = FreeFile
PathName = App.Path
I = 1
PathName = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\") & "RNGSTR"
Do While Len(Dir(PathName & Trim(Str(I)) & ".TXT", vbHidden Or vbReadOnly Or vbSystem))
I = I + 1
Loop
PathName = PathName & Trim(Str(I)) & ".TXT"
Open PathName For Binary As #File2

IDS(18) = 48
IDS(19) = 48
IDS(16) = 35
IDS(20) = 13
IDS(21) = 10
Do While RndTime = 0
RndTime = CLng(Timer) Mod 26
Loop
StartTime = Now
For I = 0 To L
K = I Mod 10
If K Mod 5 = 0 Then
IDS(17) = 53
ElseIf K Mod 3 = 0 Then
IDS(17) = 50
Else
IDS(17) = 49
End If
For K = 0 To 5
ID(K) = Add1(ID(K), K * 2 + 1)
Next
Flag1 = False
Flag2 = False
Flag3 = False
For K = 0 To 15
IDS(K) = RNDChar((I And &HFF&) Xor ID(K Mod 6), (I Mod 23) + RndTime Xor K)
Flag1 = Flag1 Or ((IDS(K) > &H2F) And (IDS(K) < &H3A))
Flag2 = Flag2 Or ((IDS(K) > &H40) And (IDS(K) < &H5B))
Flag3 = Flag3 Or ((IDS(K) > &H60) And (IDS(K) < &H7B))
Next
Do While Not Flag1
IDS(13) = (IDS(13) Mod 10) + &H30
Flag1 = (IDS(13) > &H2F) And (IDS(13) < &H3A)
Loop
Do While Not Flag2
IDS(3) = IDS(3) Mod 20 + &H41
Flag2 = (IDS(3) > &H40) And (IDS(3) < &H5B)
Loop
Do While Not Flag3
IDS(10) = IDS(10) Mod 20 + &H61
Flag3 = (IDS(10) > &H60) And (IDS(10) < &H7B)
Loop
IDS(2) = ID(0)
IDS(4) = ID(1)
IDS(8) = ID(2)
IDS(11) = ID(3)
IDS(12) = ID(4)
IDS(14) = ID(5)
Put #File2, , IDS
Next
Close File2
Put #File1, 1, ID
Close File1
MsgBox "生成随机字符串成功!生成文件名为:" & PathName & " 请查看。" & vbCrLf & _
"共生成了" & I - 1 & "条字符串,共计耗时" & DateDiff("S", StartTime, Now) & "秒。" _
, vbInformation Or vbOKOnly, Me.Caption
End Sub

Private Function RNDChar(ByVal Num1 As Byte, Optional ByVal RNDNum As Long) As Byte
Dim I As Long
Static K As Long

If RNDNum = 0 Then RNDNum = CLng(Timer) Mod 256
I = RNDNum + Num1
If (I < 48) Or (I > 122) Or ((I > 57) And (I < 65)) Or ((I > 90) And (I < 97)) Or I = K Then
If I < 48 Then
I = Add1(I + Rnd * 17, CLng(Timer) And &HFF&)
Else
I = Add1(I)
End If
End If
K = I
RNDChar = I
End Function

Private Function Add1(ByVal Num1 As Byte, Optional ByVal AddNum As Long) As Byte
Dim I As Integer
I = (Num1 + AddNum) And &HFF&
AddStart:
If ((I > &H2F) And (I < &H3A)) Or ((I > &H40) And (I < &H5B)) Or ((I > &H60) And (I < &H7B)) Then
Add1 = I: Exit Function
ElseIf I > 122 Then
I = I - 74: GoTo AddStart
ElseIf I > 90 Then
Add1 = I + 6: Exit Function
ElseIf I > 57 Then
Add1 = I + 7: Exit Function
Else
Add1 = 48: Exit Function
End If
End Function


VB QQ群:47715789
2007-04-10 21:53
〖笨蛋〗
Rank: 1
等 级:新手上路
帖 子:10
专家分:0
注 册:2006-12-26
收藏
得分:0 
以下是引用freeforever在2007-4-10 16:50:13的发言:

我刚才重启机器了,一个哥们向我要VFP的图书馆管理系统代码,我去找了,没找到,谁能帮我呀

我的代码就简单了,看吧:
Option Explicit

Const MAX100 = 5
Const MAX200 = 3
Const MAX500 = 2

Private Sub Form_Load()
Dim strTime As String, strALl As String
strTime = Time()
Dim i As Integer, j As Integer, k As Integer
Dim intTmp As Integer, intLenSTRALL As Integer
Dim cnt100 As Integer, cnt200 As Integer, cnt500 As Integer
strALl = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
Randomize Time
intLenSTRALL = Len(strALl)
Dim strTmp As String
Open App.Path & "\Test.txt" For Output As #1
For i = 1 To 1000
cnt100 = 0: cnt200 = 0: cnt500 = 0
For j = 1 To 10
For k = 1 To 16
intTmp = Rnd * 1000 Mod 61 + 1
Print #1, Mid(strALl, intTmp, 1);
Next k
intTmp = intTmp Mod 10
If (intTmp Mod 2 = 0) And cnt100 < MAX100 Then
Print #1, "#100": cnt100 = cnt100 + 1
ElseIf (intTmp Mod 4 = 1) And cnt200 < MAX200 Then
Print #1, "#200": cnt200 = cnt200 + 1
ElseIf (intTmp Mod 4 = 3) And cnt500 < MAX500 Then
Print #1, "#500": cnt500 = cnt500 + 1
ElseIf (MAX100 - cnt100) > (MAX200 - cnt200) And cnt100 < MAX100 Then
Print #1, "#100": cnt100 = cnt100 + 1
ElseIf (MAX200 - cnt200) > (MAX500 - cnt500) And cnt200 < MAX200 Then
Print #1, "#200": cnt200 = cnt200 + 1
ElseIf (MAX500 - cnt500) > (MAX100 - cnt100) And cnt500 < MAX500 Then
Print #1, "#500": cnt500 = cnt500 + 1
ElseIf (cnt100 < MAX100) Then
Print #1, "#100": cnt100 = cnt100 + 1
ElseIf (cnt200 < MAX200) Then
Print #1, "#200": cnt200 = cnt200 + 1
ElseIf (cnt500 < MAX500) Then
Print #1, "#500": cnt500 = cnt500 + 1
End If
Next j
Next i
Close #1
MsgBox strTime & "-" & Time()
End
End Sub

      For k = 1 To 16
intTmp = Rnd * 1000 Mod 62 + 1
Print #1, Mid(strALl, intTmp, 1);
Next k
是不是应该除62?
顺便说句,帅哥你太有才了:)

2007-04-10 21:57
〖笨蛋〗
Rank: 1
等 级:新手上路
帖 子:10
专家分:0
注 册:2006-12-26
收藏
得分:0 
不太明白各位大侠是怎么比较是否有重复字符串的?能否给解释下谢谢了
2007-04-10 22:16
ioriliao
Rank: 7Rank: 7Rank: 7
来 自:广东
等 级:贵宾
威 望:32
帖 子:2829
专家分:647
注 册:2006-11-30
收藏
得分:0 
怎么你们的代码都这么复杂

/images/2011/147787/2011051411021524.jpg" border="0" />
2007-04-11 08:11
ioriliao
Rank: 7Rank: 7Rank: 7
来 自:广东
等 级:贵宾
威 望:32
帖 子:2829
专家分:647
注 册:2006-11-30
收藏
得分:0 
以下是引用freeforever在2007-4-10 17:07:54的发言:
看了ioriliao的程序了,我没见过Collection,呵呵,你的程序耗时间就在后面的随机安排后缀出现的次序上了,不知道Collection在删除时是怎样工作的,你给介绍一下吧.

我的程序不好明白的就在那组IF语句了,其实就像满酒一样:
三个大小不一样的杯子,随机往一个杯子里倒一滴;当选中的杯子满了时,选另外两个相对更空的杯子;当二个杯子满了,就只能往第三个杯子里倒了.我之前的程序在文件尾会出现同一后缀的大量连续记录就是这个只剩第三杯的原因,改进后是分成两个循环,即把三个杯子都缩小1000倍,在文件里就看不出问题了,呵呵,好累.....

Collection是一个集合

如果一个集合{1,2,3,4,5,6}
这里有6个元素.
那么它的count就是6
之后我就随机它的count,之后取出这个count的元素.之后就delete了这个count的元素
那么Collection就少了一个元素,就少了一个count,那么又在余下的count进行随机,,,,
依此类推...


/images/2011/147787/2011051411021524.jpg" border="0" />
2007-04-11 08:20
〖笨蛋〗
Rank: 1
等 级:新手上路
帖 子:10
专家分:0
注 册:2006-12-26
收藏
得分:0 
以下是引用ioriliao在2007-4-11 8:20:42的发言:

Collection是一个集合

如果一个集合{1,2,3,4,5,6}
这里有6个元素.
那么它的count就是6
之后我就随机它的count,之后取出这个count的元素.之后就delete了这个count的元素
那么Collection就少了一个元素,就少了一个count,那么又在余下的count进行随机,,,,
依此类推...

老大你更有才,佩服佩服。collection我都没听说过

2007-04-11 09:54
ioriliao
Rank: 7Rank: 7Rank: 7
来 自:广东
等 级:贵宾
威 望:32
帖 子:2829
专家分:647
注 册:2006-11-30
收藏
得分:0 
又改进了程序...现在产生一万条字符串用时28秒!

/images/2011/147787/2011051411021524.jpg" border="0" />
2007-04-11 10:14
ioriliao
Rank: 7Rank: 7Rank: 7
来 自:广东
等 级:贵宾
威 望:32
帖 子:2829
专家分:647
注 册:2006-11-30
收藏
得分:0 
以下是引用〖笨蛋〗在2007-4-11 9:54:26的发言:

老大你更有才,佩服佩服。collection我都没听说过

哪里哪里...Joforn才是真正的高手!


/images/2011/147787/2011051411021524.jpg" border="0" />
2007-04-11 10:18
快速回复:[求助]一个程序,想破头了都不知该怎么编!
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.019383 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved