读书人

这段代码哪里出有关问题了

发布时间: 2012-02-15 12:09:44 作者: rapoo

这段代码哪里出问题了?
功能:把文件夹内的文件修改时间和文件名合并在一起作为新的文件名

出现的问题是在有的机上能很好的运行,但在一些机子上出现遍历两次的情况(也就是文件名被改了两次,以致于有两个时间)

Sub GetNewFileName()
Dim nchar As Integer
Dim strPathName As String
Dim tFindData As WIN32_FIND_DATA
Dim sFileTime As String
Dim lngresult As Long
Dim lnghandle As Long
Dim closehandle As Long
Dim bll As Boolean

tFindData.cFileName = " " '初始化定长字符串

strPathName = Dir1.Path & "\ " & "*.MPG "

'获取句柄
lnghandle = FindFirstFile(strPathName, tFindData)

closehandle = lnghandle

Do While lnghandle <> INVALID_HANDLE_VALUE '如果获得文件句柄成功

strFileName = sGetCrtFileName(tFindData.cFileName)

sFileTime = Dir1.Path & "\ " & strFileName

lngresult = CreateFile(sFileTime, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)

If lngresult = INVALID_HANDLE_VALUE Then

Exit Sub

End If

'获得文件的时间信息
lngresult = GetFileTime(lngresult, ftCreatetime, ftAccesstime, ftModifyTime)
If lngresult <> 0 Then '如果获得文件时间信息成功
lngresult = FileTimeToLocalFileTime(ftModifyTime, ftlocal)
If lngresult <> 0 Then '如果转换本地时间到系统时间成功


'转换本地时间到系统时间
lngresult = FileTimeToSystemTime(ftlocal, ftSystem)
If lngresult <> 0 Then '如果转换本地时间到系统时间成功
With ftSystem
sMonth = CStr(.wMonth)
sDay = CStr(.wDay)
sHour = CStr(.wHour)
sMinute = CStr(.wMinute)
If Len(sMonth) = 1 Then
sMonth = "0 " & sMonth
End If
If Len(sDay) = 1 Then
sDay = "0 " & sDay
End If
If Len(sHour) = 1 Then
sHour = "0 " & sHour


End If
If Len(sMinute) = 1 Then
sMinute = "0 " & sMinute
End If
ModifyTime = CStr(.wYear) & ". " & sMonth & ". " & sDay & ". " & sHour & ". " & sMinute

sPrtTime = sHour & ". " & sMinute

End With
End If
End If
End If


If blPrint = True Then

nchar = Len(strFileName)
sOldName = Left$(strFileName, nchar - 4)
sNewName = Dir1.Path & "\ " & ModifyTime & sOldName & cmbAddress & ".MPG "
sOldName = Dir1.Path & "\ " & sOldName & ".MPG "


'命名新文件
bll = ReName(0, sOldName, sNewName)

Else
nchar = Len(strFileName)

sOldName = Left$(strFileName, nchar - 4)

If chkPrtTime.Value Then
sNewName = Dir1.Path & "\ " & sPrtTime & sOldName & ".MPG "
sOldName = Dir1.Path & "\ " & sOldName & ".MPG "
bll = ReName(0, sOldName, sNewName)
Else
sNewName = sOldName
End If

End If

tFindData.cFileName = " "

If FindNextFile(lnghandle, tFindData) = 0 Then '查询结束或发生错误
Close lngresult
FindClose (closehandle)
Exit Do
End If

Loop

Exit Sub

End Sub

[解决办法]
你的文件改名后,被作为新文件 Find 了。

Sub GetNewFileName()
Dim nchar As Integer
Dim strPathName As String
Dim tFindData As WIN32_FIND_DATA
Dim sFileTime As String
Dim lngresult As Long
Dim lnghandle As Long
Dim closehandle As Long
Dim bll As Boolean
Dim strMyFile() As String, i As Long

tFindData.cFileName = " " '初始化定长字符串



strPathName = Dir1.Path & "\ " & "*.MPG "

'获取句柄
i = 0
lnghandle = FindFirstFile(strPathName, tFindData)

closehandle = lnghandle

Do While lnghandle <> INVALID_HANDLE_VALUE '如果获得文件句柄成功

strFileName = sGetCrtFileName(tFindData.cFileName)

sFileTime = Dir1.Path & "\ " & strFileName

ReDim Preserve strMyFile(i)
strMyFile(i) = sFileTime

tFindData.cFileName = " "
If FindNextFile(lnghandle, tFindData) = 0 Then '查询结束或发生错误
Close lngresult
FindClose (closehandle)
Exit Do
End If

Loop

For i = 0 To Ubound(strMyFile)
lngresult = CreateFile(strMyFile(i), GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)

If lngresult = INVALID_HANDLE_VALUE Then

Exit Sub

End If

'获得文件的时间信息
lngresult = GetFileTime(lngresult, ftCreatetime, ftAccesstime, ftModifyTime)
If lngresult <> 0 Then '如果获得文件时间信息成功
lngresult = FileTimeToLocalFileTime(ftModifyTime, ftlocal)
If lngresult <> 0 Then '如果转换本地时间到系统时间成功
'转换本地时间到系统时间
lngresult = FileTimeToSystemTime(ftlocal, ftSystem)
If lngresult <> 0 Then '如果转换本地时间到系统时间成功
With ftSystem
sMonth = CStr(.wMonth)
sDay = CStr(.wDay)
sHour = CStr(.wHour)
sMinute = CStr(.wMinute)
If Len(sMonth) = 1 Then
sMonth = "0 " & sMonth
End If
If Len(sDay) = 1 Then
sDay = "0 " & sDay
End If
If Len(sHour) = 1 Then
sHour = "0 " & sHour
End If
If Len(sMinute) = 1 Then
sMinute = "0 " & sMinute
End If
ModifyTime = CStr(.wYear) & ". " & sMonth & ". " & sDay & ". " & sHour & ". " & sMinute

sPrtTime = sHour & ". " & sMinute

End With
End If
End If
End If


If blPrint = True Then

nchar = Len(strFileName)
sOldName = Left$(strFileName, nchar - 4)
sNewName = Dir1.Path & "\ " & ModifyTime & sOldName & cmbAddress & ".MPG "
sOldName = Dir1.Path & "\ " & sOldName & ".MPG "
'命名新文件
bll = ReName(0, sOldName, sNewName)

Else
nchar = Len(strFileName)

sOldName = Left$(strFileName, nchar - 4)

If chkPrtTime.Value Then
sNewName = Dir1.Path & "\ " & sPrtTime & sOldName & ".MPG "


sOldName = Dir1.Path & "\ " & sOldName & ".MPG "
bll = ReName(0, sOldName, sNewName)
Else
sNewName = sOldName
End If

End If

Next i
Exit Sub

End Sub

读书人网 >VB

热点推荐