20CN网络安全小组论坛 - 编程破解

论坛: 编程破解标题: VB历史记录

作者: hongliubo1 [hongliubo1]

论坛用户

Option Explicit
Dim A_Name As String
Dim S_Name As String
Const MaxRFiles = 4
Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Command2_Click()
ClearRecentFiles
End Sub

Private Sub Command3_Click()
Text1 = GetSetting(A_Name, S_Name, "File0", "")
Text2 = GetSetting(A_Name, S_Name, "File1", "")
Text3 = GetSetting(A_Name, S_Name, "File2", "")
Text4 = GetSetting(A_Name, S_Name, "File3", "")
Text5 = GetSetting(A_Name, S_Name, "FirstFile", "")
End Sub

Private Sub Form_Load()
A_Name = "Demo"
S_Name = "Rfile"
ReadRecentFiles
End Sub

Private Sub mExit_Click()
Unload Me
End Sub

Private Sub mLastFile_Click(Index As Integer)
UpdateRecentFiles Index
End Sub

Private Sub mOpen_Click()
Dim fIndex As Integer

On Error Resume Next

CommonDialog2.CancelError = True ' Causes a trappable error to occur when the user hits the 'Cancel' button
CommonDialog2.DialogTitle = "打开文件"
CommonDialog2.FileName = ""
CommonDialog2.Filter = "Executables(*.*)|*.*"
CommonDialog2.FilterIndex = 1
CommonDialog2.Flags = cdlOFNCreatePrompt + cdlOFNHideReadOnly

CommonDialog2.ShowOpen
If Err = cdlCancel Then ' 'Cancel' button was hit
' Add your own code here when the user hits the 'Cancel' button
Else

fIndex = InRecentFiles(CommonDialog2.FileName)
If fIndex > MaxRFiles Then
WriteRecentFiles CommonDialog2.FileName
Else
UpdateRecentFiles fIndex
End If
End If

End Sub
Private Sub WriteRecentFiles(FileName As String)
Dim fileptr As Integer
If Len(Trim(FileName)) Then
fileptr = Val(GetSetting(A_Name, S_Name, "FirstFile", "0"))
fileptr = Iif(fileptr - 1 >= 0, fileptr - 1, MaxRFiles - 1)
SaveSetting A_Name, S_Name, "FirstFile", fileptr & ""
SaveSetting A_Name, S_Name, "File" & fileptr, FileName
ReadRecentFiles
End If
End Sub

Private Sub ReadRecentFiles()
Dim I As Integer
Dim fileptr As Integer
Dim rFile As String
Dim rCount As Integer
'第一个文件的位置
fileptr = Val(GetSetting(A_Name, S_Name, "FirstFile", "0"))
rFile = GetSetting(A_Name, S_Name, "File" & fileptr, "")
rCount = 0
Do While Len(rFile) And rCount < MaxRFiles
mLastFile(rCount).Caption = "&" & (rCount + 1) & " " & rFile
mLastFile(rCount).Visible = True
fileptr = Iif(fileptr + 1 < MaxRFiles, fileptr + 1, 0)
rFile = GetSetting(A_Name, S_Name, "File" & fileptr, "")
rCount = rCount + 1
Loop
If rCount = 0 Then
mLastFile(rCount).Visible = True
mLastFile(rCount).Caption = "无历史文件"
rCount = 1
End If
For I = rCount To MaxRFiles - 1
mLastFile(I).Visible = False
Next
End Sub

Private Function InRecentFiles(strFile As String) As Integer
Dim I As Integer
Dim bFound As Boolean

'Look for the file specified in strFile
For I = 0 To MaxRFiles - 1
If mLastFile(I).Visible And strFile = Mid$(mLastFile(I).Caption, 4) Then
InRecentFiles = I
Exit Function
End If
Next
InRecentFiles = MaxRFiles + 1
End Function

Public Sub ClearRecentFiles()
On Error Resume Next
Dim I As Integer
DeleteSetting A_Name, S_Name, "FirstFile"
For I = 0 To MaxRFiles
DeleteSetting A_Name, S_Name, "File" & I
Next
mLastFile(0).Visible = True
mLastFile(0).Caption = "无历史文件"
For I = 1 To MaxRFiles - 1
mLastFile(I).Visible = False
Next
End Sub

Public Sub UpdateRecentFiles(fIndex As Integer)
Dim I As Integer
Dim fileptr As Integer, FirstPtr As Integer
Dim FilePtr1 As Integer
Dim rFile As String, OldFile As String
Dim rCount As Integer
If fIndex = 0 Then Exit Sub
'第一个文件的位置
FirstPtr = Val(GetSetting(A_Name, S_Name, "FirstFile", "0"))
'FirstPtr = Iif(FirstPtr - 1 >= 0, FirstPtr - 1, MaxRFiles - 1)
If fIndex = MaxRFiles - 1 Then
FirstPtr = Iif(FirstPtr - 1 >= 0, FirstPtr - 1, MaxRFiles - 1)
SaveSetting A_Name, S_Name, "FirstFile", CStr(FirstPtr)
ReadRecentFiles
Exit Sub
End If
fileptr = fIndex + FirstPtr
If fileptr >= MaxRFiles Then fileptr = fileptr - MaxRFiles
OldFile = GetSetting(A_Name, S_Name, "File" & fileptr, "")
FilePtr1 = Iif(fileptr - 1 >= 0, fileptr - 1, MaxRFiles - 1)
'FilePtr1 = Iif(fileptr + 1 < MaxRFiles, fileptr + 1, 0)
rFile = GetSetting(A_Name, S_Name, "File" & FilePtr1, "")

Do While FirstPtr <> fileptr And Len(rFile) > 0
SaveSetting A_Name, S_Name, "File" & fileptr, rFile
fileptr = FilePtr1
FilePtr1 = Iif(fileptr - 1 >= 0, fileptr - 1, MaxRFiles - 1)
'FilePtr1 = Iif(fileptr + 1 < MaxRFiles, fileptr + 1, 0)
rFile = GetSetting(A_Name, S_Name, "File" & FilePtr1, "")
Loop

SaveSetting A_Name, S_Name, "File" & FirstPtr, OldFile
'SaveSetting A_Name, S_Name, "FirstFile", CStr(fileptr)
ReadRecentFiles
' WriteRecentFiles OldFile

End Sub

地主发表时间: 05-01-14 21:39

论坛: 编程破解