为一个网友写的真正的精确到毫秒级的动态秒表。顺便散分！

2007-12-25 05:36:34 1.1k 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

京东联盟h5st(3.1)加密参数逆向实战与反爬对抗策略本文详细解析了京东联盟h5st(3.1)加密参数的逆向分析与实战破解过程。通过接口分析定位关键加密函数，拆解h5st结构并还原其基于SHA256和HMAC-SHA256的加密逻辑，最终使用Python集成JavaScript环境成功复现加密算法，并分享了应对反爬的频率限制、IP封禁及算法升级等对抗策略。阅读详情

为一个网友写的真正的精确到毫秒级的动态秒表。这个网友发贴子提问，只精确到了秒，我觉得动得不够快，所以改进了一下，动得很快，并修改了这个网友的错误。

转载请标明出处。 VB演示窗体下载(源码):http://download.csdn.net/source/316696

Option Explicit

Dim x As Long
Dim h As Long, m As Long, s As Long, ms As Long
Dim cjlh As Long, cjlm As Long, cjls As Long
Dim cjlms As String
Private Sub Form_Load()
'Form1.StartUpPosition = 2
Form1.Caption = "真正的动态秒表（小时：分：秒.毫秒）"
Command1.Caption = "开始[&S]"
Command2.Caption = "结束[&E]"
Label1.Alignment = 2 '居中对齐
Label1.Caption = "00:00:00.000"
Timer1.Interval = 10
Timer1.Enabled = False
Label1.BackColor = &H0&
Label1.ForeColor = &HFF00&
Label1.Font.Name = "Arial Rounded MT Bold"
Label1.Alignment = 2
x = 0
End Sub
Private Sub Command1_Click()
Timer1.Enabled = True
Label1.Font.Size = 24
End Sub
Private Sub Command2_Click()
Timer1.Enabled = False
Label1.Font.Size = 14
x = 0
Label1.Caption = "运行了" & IIf(Len(Trim(Str(h))) < 2, "0" & Trim(Str(h)), Trim(Str(h))) & "小时" & IIf(Len(Trim(Str(m))) < 2, "0" & Trim(Str(m)), Trim(Str(m))) & "分" & IIf(Len(Trim(Str(s))) < 2, "0" & Trim(Str(s)), Trim(Str(s))) & "秒" & cjlms & "毫秒"
Form1.Caption = Label1.Caption
End Sub
Private Sub Timer1_Timer() '每1秒钟触发100次
x = x + 10 '单位是毫秒
cjlh = Int(x / 3600000)
h = cjlh '取得小时
cjlm = Int(((x Mod 3600000) / 60000)) '关键在这里，用INT取整，不用INT的话，每30秒进1,有点奇怪
m = cjlm '取得分钟
cjls = Int(((x Mod 3600000) Mod 60000) / 1000)
s = cjls '取得秒种
ms = (((x Mod 3600000) Mod 60000) Mod 1000)
If Len(Trim(Str(ms))) = 2 Then
cjlms = "0" & Trim(Str(ms))
End If
If Len(Trim(Str(ms))) >= 3 Then
cjlms = Trim(Str(ms))
End If
cjlms = Left(cjlms, 2) & Trim(Str(Int(Rnd * 9)))
Label1.Caption = IIf(Len(Trim(Str(h))) < 2, "0" & Trim(Str(h)), Trim(Str(h))) + ":" + IIf(Len(Trim(Str(m))) < 2, "0" & Trim(Str(m)), Trim(Str(m))) + ":" + IIf(Len(Trim(Str(s))) < 2, "0" & Trim(Str(s)), Trim(Str(s))) + "." + cjlms
End Sub

...全文

NTFS分区变成RAW别乱修！正确数据恢复与修复方法详解文件系统是操作系统管理存储数据的核心机制，NTFS作为Windows主流文件系统，一旦分区识别异常，常会显示为RAW格式。分区变RAW通常意味着文件系统入口信息损坏，而非数据物理消失，但若采用错误的修复方式，如直接对RAW分区执行chkdsk /f，可能因系统无法正确识别文件系统结构，导致写入操作落在错误偏移位置，二次破坏本可恢复的数据。正确的处理思路是：先停止一切写入操作，通过扇区级镜像备份保留原始现场，再分析DBR、分区表及$MFT状态，依据诊断结果选择修复或深度扫描恢复。实际排查中，常见问题如DBR记阅读详情

东方之珠

VB基础类 7,788 成员 197,583 内容

+ 关注 + 加入社区

切换为时间正序

砸死牛顿的苹果 2007-12-29

打赏
举报

做了下测试

Private Sub Command1_Click()

  Dim i As Long, t As Double, t2 As Double, x As Boolean

  Dim ts(19) As Double

  While i < 20

    x = True

    t = Timer

    Do While x

      t2 = Timer

      If t2 > t Then

        ts(i) = t2 - t

        t = t2

        x = False

      End If

    Loop

    i = i + 1

  Wend

  For i = 0 To 19

    Debug.Print ts(i) * 1000000

  Next

End Sub

输出结果

15999.9999959837
16000.0000032596
14999.9999994179
16000.0000032596
14999.9999994179
15999.9999959837
16000.0000032596
14999.9999994179
15999.9999959837
16000.0000032596
14999.9999994179
16000.0000032596
14999.9999994179
15999.9999959837
16000.0000032596
14999.9999994179
15999.9999959837
16000.0000032596
14999.9999994179
16000.0000032596



Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub Command1_Click()

  Dim i As Long, t As Double, t2 As Double, x As Boolean

  While i < 20

    x = True

    t = GetTickCount

    Do While x

      t2 = GetTickCount

      If t2 > t Then

        Debug.Print t

        t = t2

        x = False

      End If

    Loop

    i = i + 1

  Wend

End Sub

输出结果

16000
15000
16000
16000
15000
16000
15000
16000
16000
15000
16000
16000
15000
16000
15000
16000
16000
15000
16000
16000

'然后再试试老马提供的2个函数 QueryPerformanceFrequency,QueryPerformanceCounter

Private Type LARGE_INTEGER

    lowpart As Long

    highpart As Long

End Type



Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long



Private Sub Command1_Click()

  Dim i As Long, t As LARGE_INTEGER, t2 As LARGE_INTEGER, x As Boolean, tc As LARGE_INTEGER

  Dim ts(19) As Double

  QueryPerformanceFrequency tc

  Debug.Print tc.highpart, tc.lowpart

  While i < 20

    QueryPerformanceCounter t

    x = True

    Do While x

      QueryPerformanceCounter t2

      If (t2.lowpart <> t.lowpart) Then

        ts(i) = (t2.lowpart - t.lowpart)

        t = t2

        x = False

      End If

    Loop

    i = i + 1

  Wend

  For i = 0 To 19

    Debug.Print ts(i) / tc.lowpart * 1000000 '转化成微秒单位

  Next

End Sub

输出结果

0 3579545
2.51428603356013
1.67619068904009
1.9555558038801
1.67619068904009
1.9555558038801
1.67619068904009
1.9555558038801
1.9555558038801
1.67619068904009
1.9555558038801
1.9555558038801
1.67619068904009
1.67619068904009
1.67619068904009
1.9555558038801
1.67619068904009
1.9555558038801
1.67619068904009
1.9555558038801
1.67619068904009

这里的结果表示每次递增的时间单位都是微妙

东方之珠 2007-12-29

打赏
举报

感谢各位朋友的大力支持。
我已经找到原因了，我21楼那个代码，在高速频繁运行的代码中不能用VB函数IIF、LEN、TRIM、STR，会造成内存问题。这就是为什么，我21楼那个代码只能在VB开发环境下运行，而编译成EXE运行时只要一按“开始计时”立即崩溃，没有一次成功。结贴，谢谢大家！

zzyong00 2007-12-29

打赏
举报

'Example Name:Performance Counter

Private Type LARGE_INTEGER

    LowPart As Long

    HighPart As Long

End Type

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long

Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Sub Form_Load()

    'KPD-Team 2001

    'URL: http://www.allapi.net/

    'E-Mail: KPDTeam@Allapi.net

    Dim T As Long, liFrequency As LARGE_INTEGER, liStart As LARGE_INTEGER, liStop As LARGE_INTEGER

    Dim cuFrequency As Currency, cuStart As Currency, cuStop As Currency

    'Retrieve the frequency of the performance counter

    If QueryPerformanceFrequency(liFrequency) = 0 Then

        MsgBox "Your hardware doesn't support a high-resolution performance counter!", vbInformation

    Else

        'convert the large integer to currency

        cuFrequency = LargeIntToCurrency(liFrequency)

        'retrieve tick count

        QueryPerformanceCounter liStart

        'do something

        For T = 0 To 100000

            DoEvents

        Next T

        'retrieve tick count

        QueryPerformanceCounter liStop

        'convert large integers to currency's

        cuStart = LargeIntToCurrency(liStart)

        cuStop = LargeIntToCurrency(liStop)

        'calculate how many seconds passed, and show the result

        MsgBox "Time: " + CStr((cuStop - cuStart) / cuFrequency) + " seconds"

    End If

End Sub

Private Function LargeIntToCurrency(liInput As LARGE_INTEGER) As Currency

    'copy 8 bytes from the large integer to an ampty currency

    CopyMemory LargeIntToCurrency, liInput, LenB(liInput)

    'adjust it

    LargeIntToCurrency = LargeIntToCurrency * 10000

End Function

foxAPI例程

flyingscv 2007-12-29

打赏
举报

印象中timer只能精确到每秒18.2次,也就是硬件的时钟中断次数

KiteGirl 2007-12-29

打赏
举报

写一个精确到毫秒的秒表用这么麻烦吗？秒表只要记时精确到毫秒就可以了，追求显示精确有什么意义呢？
下面这个秒表直接用Timer函数写的，精确到1/10000秒，连清零过程产生的误差都会被体现出来。

Private priOnTimer As Double
Private priAddTimer As Double

Private Sub Command1_Click()
If Timer1.Enabled Then
priAddTimer = priAddTimer + Abs(priOnTimer - Timer)
End If
Timer1.Enabled = Not Timer1.Enabled
priOnTimer = Timer
ShowTimer
End Sub

Private Sub Command2_Click()
priAddTimer = 0
priOnTimer = Timer
ShowTimer
End Sub

Private Sub Timer1_Timer()
ShowTimer
End Sub

Sub ShowTimer()
Text1.Text = TimeStr(Abs(priOnTimer - Timer) + priAddTimer)
End Sub

Function TimeStr(ByVal pTimer As Double) As String
Dim tH As Long
Dim tM As Long
Dim tS As Long
Dim tMS As Long
Dim tAT As Double
tAT = pTimer * 10000
tMS = tAT Mod 10000
tS = tAT \ 10000 Mod 100
tM = tAT \ 600000 Mod 100
tH = tAT \ 36000000 Mod 100
TimeStr = Format(tH, "00") & ":" & Format(tM, "00") & ":" & Format(tS, "00") & ":" & Format(tMS, "0000")
End Function

东方之珠 2007-12-27

打赏
举报

用多媒体计数器做的真正的动态秒表。演示窗体下载地址 http://download.csdn.net/source/318216

东方之珠 2007-12-27

打赏
举报

重新发布，原来的作废。

是我错了，错了就是错了，既然要做就把它做好，否则对不起这位网友。
最后选择了多媒体计数器！运行一分钟误差十几毫秒，调用自定义的函数TimeLabel转换时间，付出了代价，花了些时间。
理论上，高精度频率计数器最精确，毕竟API QueryPerformanceFrequency,QueryPerformanceCounter可以精确到微秒级；但是，它要认计算机，跟什么样的主板和操作系统有关，通用性不好，同时，它还会受外界影响，比如：拖动窗体计数器会暂停响应；适合短时间计时。
实际上，多媒体计数器最适用，适合长时间计时，最适合计算机软件运行计时；同时，API函数timeSetEvent内部实现多线程，不会受外界影响。
------------------------------------------------------------------------------------------------------
遗憾的是，这几个VB代码只能在VB开发环境下运行，编译成EXE运行会崩溃，我还没来得及找是什么原因，各位朋友有兴趣的话帮我分析一下。
------------------------------------------------------------------------------------------------------
'标准模块：Module1.bas
Option Explicit

Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
Public Declare Function GetTickCount Lib "kernel32" () As Long

Public MediaCount As Single '累加量
Public TimeID As Long '返回多媒体记时器对象标识
Public StartTime As Long '开始时间
Public EndTime As Long '结束时间
Public h As Long, m As Long, s As Long, ms As Long
Public cjlms As String

'API函数timeSetEvent使用的回调过程
Public Sub TimeSEProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
Form1.Label1.Caption = TimeLabel(CLng(MediaCount * 1000))
MediaCount = MediaCount + 0.001
End Sub

Public Function TimeLabel(msTime As Long) As String '将毫秒时间转换成时间标签：时：分：秒.毫秒
Dim x As Long
x = msTime '单位毫秒
h = Int(x / 3600000) '计算小时
m = Int((x Mod 3600000) / 60000) '计算分钟
If m >= 60 Then
m = 0: h = h + 1
End If
s = Int((x Mod 3600000) Mod 60000) / 1000 '计算秒钟
If s >= 60 Then
s = 0: m = m + 1
End If
ms = ((x Mod 3600000) Mod 60000) Mod 1000 '计算毫秒数
If Len(Trim(Str(ms))) = 1 Then
cjlms = "00" & Trim(Str(ms))
End If
If Len(Trim(Str(ms))) = 2 Then
cjlms = "0" & Trim(Str(ms))
End If
If Len(Trim(Str(ms))) > 2 Then
cjlms = Trim(Str(ms))
End If
TimeLabel = IIf(Len(Trim(Str(h))) < 2, "0" & Trim(Str(h)), Trim(Str(h))) & ":" & IIf(Len(Trim(Str(m))) < 2, "0" & Trim(Str(m)), Trim(Str(m))) & ":" & IIf(Len(Trim(Str(s))) < 2, "0" & Trim(Str(s)), Trim(Str(s))) & "." & cjlms

End Function

'Form1的窗体模块
Option Explicit

Private Sub Form_Load()
Form1.Caption = "真正的动态秒表（小时：分：秒.毫秒）"
Form1.BackColor = &HFF8080
Command1.Caption = "开始计时[&S]"
Command2.Caption = "停止计时[&E]"
Command1.Enabled = True
Command2.Enabled = False
Label1.Alignment = 2 '居中对齐
Label1.Caption = "00:00:00.000"
Label2.Caption = "开始时间：" & "00:00:00.000"
Label3.Caption = "结束时间：" & "00:00:00.000"
Label4.Caption = "运行时间：" & "00:00:00.000"
Label1.BackColor = &H0&
Label1.ForeColor = &HFF00&
Label1.Font.Name = "Arial Rounded MT Bold"
Label1.Font.Size = 24
Label2.ForeColor = &HFFFF00
Label3.ForeColor = &HFFFF00
Label4.ForeColor = &HFFFF00
End Sub
Private Sub Command1_Click()
Command1.Enabled = False
Command2.Enabled = True
Label3.Caption = "结束时间：" & "00:00:00.000"
Label4.Caption = "运行时间：" & "00:00:00.000"
MediaCount = 0
StartTime = GetTickCount '记住开始时间
Label2.Caption = "开始时间：" & TimeLabel(StartTime)
TimeID = timeSetEvent(1, 0, AddressOf TimeSEProc, 1, 1) '间隔时间为1毫秒
End Sub
Private Sub Command2_Click()
Command2.Enabled = False
Command1.Enabled = True
Call timeKillEvent(TimeID)
EndTime = GetTickCount '记住结束时间
Label3.Caption = "结束时间：" & TimeLabel(EndTime)
Label4.Caption = "运行时间：" & TimeLabel(GetTickCount - StartTime)
Form1.Caption = "运行了" & IIf(Len(Trim(Str(h))) < 2, "0" & Trim(Str(h)), Trim(Str(h))) & "小时" & IIf(Len(Trim(Str(m))) < 2, "0" & Trim(Str(m)), Trim(Str(m))) & "分" & IIf(Len(Trim(Str(s))) < 2, "0" & Trim(Str(s)), Trim(Str(s))) & "秒" & cjlms & "毫秒"
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload Me
End Sub

laijianyong_dingling 2007-12-27

打赏
举报

我用过TIMER控件做实事控制，这个控件非常的不准，当其他的进程阻塞了，定时精度有时秒级都达不到.
我认为在VB中要精确定时还得靠API。

嗷嗷叫的老马 2007-12-27

打赏
举报

思路搞通了就OK了

今天好冷,早点睡.......

明天就有事干了.....新的控制器与马达发过来,我要写控制程序了.....

ZW_LM 2007-12-27

打赏
举报

个人认为还是使用Gettickcount可能比定时器更精确些。

东方之珠 2007-12-27

打赏
举报

老马这么一说，我有兴趣了！

嗷嗷叫的老马 2007-12-27

打赏
举报

QueryPerformanceFrequency,QueryPerformanceCounter不是要认机器....

用法没对头

先用QueryPerformanceFrequency得到一秒内本机可以完成的计数器值,保存;

以后计数时,就两次调用QueryPerformanceCounter,其差就是两次调用间计数器所完成的计数值;

再把此值除以QueryPerformanceFrequency得到的值,就可以得到经过的时间.....

这个可以达到微秒级~~

chouchou_0723 2007-12-26

打赏
举报

既然这么强，那就施舍点分吧

cangwu_lee 2007-12-26

打赏
举报

這個題目，用 TIMER 控件，本來就不對了。

a97191 2007-12-26

打赏
举报

接分

东方之珠 2007-12-26

打赏
举报

楼上说得没错，问题是很大。原因是用INT取整后，误差太大。
但也不是像你说的timer控件不能用来计时，Timer事件定时触发是很准的，只是我的算错了，看来要把误差加上，缩小些差距。

kuhe 2007-12-26

打赏
举报

楼主的代码可能是在P3的机器上写的，到了更高级的机器上水土不服。
使用Timer属性的话可以定义个模块级的Single型m_Start，在计时开始时给m_Start赋值：
m_Start=Timer
然后在Timer控件引发的事件中用Timer-m_Start即可以计算出经历的秒数，精度能够达到10ms级。

windlysnowly 2007-12-26

打赏
举报

up 学习

kuhe 2007-12-26

打赏
举报

我以前测试过Timer控件每秒内能够触发的最大次数，在P3机器上可以达到100次；但在P4机器上却只有64次。这是由硬件决定的。下面是测量Timer控件每秒内能够触发的最大次数的代码，你们可以试试，开始的时候把Timer的Inteval属性设成1（ms）：
Option Explicit

Private m_Count As Single, m_Time(99) As Single

Option Explicit

Private m_Count As Single, m_Time(99) As Single

Private Sub Command1_Click()
m_Count = 0
Timer1.Enabled = True
Command1.Enabled = False
End Sub

Private Sub Timer1_Timer()
m_Time(m_Count) = Timer
If m_Count = 99 Then
Timer1.Enabled = False
Command1.Enabled = True
Text1.Text = "每秒最多触发" & Format$(100 / (m_Time(99) - m_Time(0)), "0") & "次"
Else
m_Count = m_Count + 1
End If
End Sub

至于计时部分，由于Timer两次触发间的间隔在10ms量级，也就没必要使用QueryPerformanceCounter这样的高精度计时器，使用GetTickCount或timeGetTime即可，事实上Timer两次触发间的间隔正好也是后两个API所能分辨的最小间隔，这是完全匹配的。
当然要是偶的话直接用VB的Timer属性，Timer属性能分辨的最小间隔和后两个函数完全一样，但代码可以写的非常简单。

砸死牛顿的苹果 2007-12-26

打赏
举报

不算啥我也经常这样`

加载更多回复（11）

为一个网友写的真正的精确到毫秒级的动态秒表。顺便散分！

相关推荐