VB代码转VB.NET后无法正常运行
以下代码在VB6.0下测试能成功修改《测试文件》的时间，代码如下：
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Sub SetModiTime(ByVal m_Path As String, ByVal m_Date As Date)
Dim lngHandle As Long
Dim udtFileTime As FILETIME
Dim udtLocalTime As FILETIME
Dim udtSystemTime As SYSTEMTIME
udtSystemTime.wYear = Year(m_Date)
udtSystemTime.wMonth = Month(m_Date)
udtSystemTime.wDay = Day(m_Date)
udtSystemTime.wDayOfWeek = Weekday(m_Date) - 1
udtSystemTime.wHour = Hour(m_Date)
udtSystemTime.wMinute = Minute(m_Date)
udtSystemTime.wSecond = Second(m_Date)
udtSystemTime.wMilliseconds = 0
' convert system time to local time
SystemTimeToFileTime udtSystemTime, udtLocalTime
' convert local time to GMT
LocalFileTimeToFileTime udtLocalTime, udtFileTime
' open the file to get the filehandle
lngHandle = CreateFile(m_Path, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
' change date/time property of the file
SetFileTime lngHandle, udtFileTime, udtFileTime, udtFileTime
' close the handle
CloseHandle lngHandle
MsgBox "The date of the file has been changed to " + Str$(m_Date), vbInformation + vbOKOnly, App.Title
End Sub
Private Sub Command1_Click()
Call SetModiTime("D:\Users\Desktop\修改时间测试\测试文件.rar", #5/31/1993#)
End Sub
转为VB.NET后，在Visual Studio 2015下测试无法修改《测试文件》的时间，没有提示错误，代码如下：
Public Class 批量修改文件属性
Public Structure FILETIME
Public dwLowDateTime As Long
Public dwHighDateTime As Long
End Structure
Public Structure SYSTEMTIME
Public wYear As Integer
Public wMonth As Integer
Public wDayOfWeek As Integer
Public wDay As Integer
Public wHour As Integer
Public wMinute As Integer
Public wSecond As Integer
Public wMilliseconds As Integer
End Structure
Dim GENERIC_WRITE = &H40000000
Dim OPEN_EXISTING = 3
Dim FILE_SHARE_READ = &H1
Dim FILE_SHARE_WRITE = &H2
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Public Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Sub SetModiTime(ByVal m_Path As String, ByVal m_Date As Date)
Dim lngHandle As Long
Dim udtFileTime As FILETIME
Dim udtLocalTime As FILETIME
Dim udtSystemTime As SYSTEMTIME '系统时间
udtSystemTime.wYear = Year(m_Date)
udtSystemTime.wMonth = Month(m_Date)
udtSystemTime.wDay = Microsoft.VisualBasic.DateAndTime.Day(m_Date)
udtSystemTime.wDayOfWeek = Weekday(m_Date) - 1
udtSystemTime.wHour = Hour(m_Date)
udtSystemTime.wMinute = Minute(m_Date)
udtSystemTime.wSecond = Second(m_Date)
udtSystemTime.wMilliseconds = 0
'将系统时间转换为本地时间
SystemTimeToFileTime（udtSystemTime, udtLocalTime）
'将当地时间转换为格林威治时间
LocalFileTimeToFileTime（udtLocalTime, udtFileTime）
'打开文件以获取文件句柄
lngHandle = CreateFile(m_Path, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0, 0)
'更改文件的日期/时间属性
SetFileTime（lngHandle, udtFileTime, udtFileTime, udtFileTime）
'关闭前面获取句柄对应文件
CloseHandle（lngHandle）
MsgBox（"文件的日期已更改"）
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
SetModiTime("D:\Users\Desktop\修改时间测试\测试文件.rar", #5/31/2020#)
End Sub
End Class
运行结果：未能成功修改文件时间。
请问VB代码转VB.NET后问题出在哪，正确的VB.NET代码是？
下面是vb6代码：
Private Declare Function sndPlaySound Lib "Winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Const SND_ASYNC = &H1 ' play asynchronously
Private Const SND_FILENAME = &H20000 ' name is a file name
Private Const SND_LOOP = &H8 ' loop the sound until next sndPlaySound
Public MusicUrl1, MusicUrl2, MusicUrl3
Dim stuname As New Collection
Public intLuNum As Integer
'Private Sub Form_Paint()
' PicUrl = App.Path & "\images\b.jpg"
' Me.PaintPicture LoadPicture(PicUrl), 0, 0, Me.ScaleWidth, Me.ScaleHeight
'End Sub
Private Sub addcoll(ids) '向集合中加入元素，原型为add(Item [,key])
'Dim i As Integer
If ids <> "" Then
stuname.Add ids '向集合中加入一个元素，key的类型必须为string
End If
'i = stuname.Count
'Print i, Text1, stuname(i)
End Sub
Private Sub Command1_Click()
Dim rowNum As Integer
Command1.Caption = IIf(Command1.Caption = "开始", "停止", "开始")
Music_Play
intLuNum = Int(getLnNum(Label1.Caption))
If Command1.Caption = "停止" Then
If intLuNum > 1 Then
If intLuNum <= 5 Then
rowNum = 3
Else
If Format(Sqr(intLuNum), 0) = Sqr(intLuNum) And Int(Sqr(intLuNum)) <= 5 Then
rowNum = Sqr(intLuNum)
Else
rowNum = 3
End If
End If
Call creatLabel((intLuNum - 1), rowNum, 6)
End If
End If
Set stuname = New Collection '清空上次集合内容重新填充集合
Call OpenCn
If addFlag = True Then
Call openRs("SELECT * FROM people where uMark=0")
mCount = rs.RecordCount
If mCount = 0 Then
MsgBox "无可选人员"
Exit Sub
Unload Form1
End If
Do While Not rs.EOF
ids = rs!uName
addcoll (ids) '把uName加入集合
rs.MoveNext
Loop
While Command1.Caption = "停止"
DoEvents
Randomize
Dim rID
If Command1.Caption = "开始" Then
Exit Sub
End If
If intLuNum > 1 Then
For i = 0 To (intLuNum - 1)
rID = Format(Int((mCount - 1) * Rnd + 1), "000000")
b = stuname.Item(Val(rID))
Label2(i).Caption = b
Next
ElseIf intLuNum = 1 Then
rID = Format(Int((mCount - 1) * Rnd + 1), "000000")
b = stuname.Item(Val(rID))
Label3.FontSize = 128
Label3.Caption = b
End If
Wend
If intLuNum > 1 Then
If Label2(0).Caption <> "" Then
For i = 0 To (intLuNum - 1)
cNames = Label2(i).Caption
strNames = strNames & getID(cNames) & ","
Next
End If
ElseIf intLuNum = 1 Then
If Label3.Caption <> "" Then
strNames = getID(Label3.Caption)
End If
End If
End If
Call markName(strNames)
strTitle = Label1.Caption
luName = Mid(strTitle, 5, Len(strTitle))
Call writeResult(topicTimeID, strNames, luName)
cloRs '关闭上面的Rs
'改变奖项参数中已抽数
finSql = "select * from LuckConfig where luName = " & "'" & luName & "'"
Call openRs(finSql)
rs!isFinis = rs!isFinis + intLuNum
rs.upDate
'******************
If Int(getLnNum(Label1.Caption)) = 0 Then
Command1.Enabled = False
End If
End Sub
Private Sub configAdd_Click()
Load Form3
Form3.Show
'Form1.Hide
End Sub
Private Sub Form_Load()
PicUrl = App.Path & "\images\b.jpg"
Set Picture = LoadPicture(PicUrl)
MusicUrl1 = App.Path & "\music\1.wav"
MusicUrl2 = App.Path & "\music\2.wav"
MusicUrl3 = App.Path & "\music\3.wav"
Dim Result As Long
Result = sndPlaySound(MusicUrl1, SND_ASYNC Or SND_LOOP)
Call OpenCn
If addFlag = True Then
Call openRs("select * from people order by id")
If rs.RecordCount = 0 Then
MsgBox "请录入候选信息！", vbInformation, "数据空值"
Exit Sub
' Load Form2
' Form2.Show
End If
End If
reSetMark
showTitle
finSql = "update LuckConfig set isFinis = 0 where isFinis <> 0"
Call doSql(finSql)
topicTimeID = Format(Now, "YYYYMMDDhmmss")
Command1.Caption = "开始"
End Sub
Private Sub nameManage_Click()
Load Form2
Form2.Show
End Sub
Private Sub showTitle()
strTitle = Form4.Label1.Caption
If strTitle = "" Then
strTitle = "等待抽奖"
Else
strTitle = "正在抽取" & strTitle
End If
Label1.Caption = strTitle
End Sub
Private Sub creatLabel(labelNum As Integer, rowNum As Integer, fontNumPerLabel As Integer)
'****************************************************
'LabelNum 要生成的label的个数
'rowNum 每行默认个数
'fontNumPerLabel 每个label最大字符数
'假定Label2(0)放在起始位置，所有的Label2都是一样大小。
'*****************************************************
For i = 1 To labelNum
Load Label2(i)
Row = i \ rowNum '这个Label应该在的行数
Col = i Mod rowNum '这个Label应该在的列数
Label2(i).Move Label2(0).Left + (Label2(0).Width + (Me.ScaleWidth - Label2(0).Width * rowNum) / rowNum) * Col, Label2(0).Top + Label2(0).Top * Row
'Label2(i).Font.Size = 36
Label2(i).Visible = True
Next
End Sub
Private Sub deletLabel(labelNum As Integer)
If labelNum > 1 Then
If Label2(0).Caption <> "" Then
For i = 0 To (labelNum - 1)
cNames = Label2(i).Caption
strNames = strNames & getID(cNames) & ","
Label2(i).Caption = ""
If i > 0 Then
Unload Label2(i)
End If
Next
End If
ElseIf labelNum = 1 Then
If Label3.Caption <> "" Then
strNames = getID(Label3.Caption)
Label3.Caption = ""
End If
End If
End Sub
Private Function getLnNum(strTitle As String)
Dim restNum As Integer
luName = Mid(strTitle, 5, Len(strTitle))
Call OpenCn
If addFlag = True Then
Call openRs("select * from LuckConfig where luName =" & "'" & luName & "'")
luNum = rs!luNum
luStepNum = rs!luStepNum
isFinis = rs!isFinis
restNum = luNum - isFinis
' If isFinis > 0 Then
If Command1.Caption = "停止" Then
NoNum = isFinis / luStepNum
If luStepNum <> luNum Then
Label4.Caption = "第" & NoNum + 1 & "次"
End If
End If
' End If
If restNum = 0 Then
Command1.Enabled = False
getLnNum = luNum
End If
If restNum > luStepNum Then
getLnNum = luStepNum
' ElseIf restNum = luStepNum Then
' getLnNum = 0
Else
getLnNum = restNum
End If
End If
End Function
Private Sub choseLuckName_Click()
Load Form4
Form4.Show
Label4.Caption = ""
If Label1.Caption <> "等待抽奖" Then
Call deletLabel(intLuNum)
End If
End Sub
Private Sub quit_Click()
If Label1.Caption <> "等待抽奖" Then
Call deletLabel(getLnNum(Label1.Caption))
End If
Unload Form1
Unload Form2
Unload Form3
Unload Form4
Result = sndPlaySound(0, SND_ASYNC)
End Sub
Private Sub markName(strName)
Call OpenCn
If addFlag = True Then
sql = "UPDATE people SET uMark = 1 WHERE id in (" & strName & ")"
Call doSql(sql)
End If
End Sub
Private Function getID(cName)
Call OpenCn
If addFlag = True Then
sql = "SELECT * FROM people where uName =" & "'" & cName & "'"
Call openRs(sql)
showID = rs!id
End If
getID = showID
End Function
Private Sub reSetMark()
Call OpenCn
If addFlag = True Then
sql = "SELECT * FROM people where uMark=1"
Call openRs(sql)
Do While Not rs.EOF
rs!uMark = 0
rs.upDate
rs.MoveNext
Loop
End If
End Sub
Private Sub writeResult(topicTimeID, strNames, luName)
Call OpenCn
If addFlag = True Then
sql = "SELECT * FROM people where id in (" & strNames & ")"
Call openRs(sql)
Do While Not rs.EOF
'DoEvents
rName = rs!uName
'Print rName
Call upResult(topicTimeID, luName, rName)
rs.MoveNext
Loop
End If
End Sub
Private Sub upResult(topicTimeID, luName, rName)
Call OpenCn
If addFlag = True Then
sql = "INSERT INTO luResult (topicTimeID,luName,rName) VALUES ('" & topicTimeID & "','" & luName & "','" & rName & "') "
Call doSql(sql)
End If
End Sub
Private Sub viewResult_Click()
Load Form5
Form5.Show
End Sub
Private Sub Music_Play()
If Command1.Caption = "停止" Then
Result = sndPlaySound(0, SND_ASYNC)
Result = sndPlaySound(MusicUrl2, SND_ASYNC Or SND_LOOP)
ElseIf Command1.Caption = "开始" Then
Result = sndPlaySound(MusicUrl3, SND_ASYNC)
End If
End Sub