Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing MainForm.frm (21.40 KB)
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form MainForm
BorderStyle = 1 'Fixed Single
Caption = "File Date/Time Modifier"
ClientHeight = 2535
ClientLeft = 45
ClientTop = 330
ClientWidth = 4500
Icon = "MainForm.frx":0000
MaxButton = 0 'False
ScaleHeight = 2535
ScaleWidth = 4500
StartUpPosition = 2 'CenterScreen
Begin VB.CheckBox Check3
Caption = "&Accessed"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 3000
TabIndex = 12
Top = 1200
Value = 1 'Checked
Width = 975
End
Begin VB.CheckBox Check2
Caption = "&Modified"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 2040
TabIndex = 11
Top = 1200
Value = 1 'Checked
Width = 900
End
Begin VB.CheckBox Check1
Caption = "&Created"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 1080
TabIndex = 10
Top = 1200
Value = 1 'Checked
Width = 880
End
Begin VB.CommandButton Command5
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 4080
Picture = "MainForm.frx":0742
Style = 1 'Graphical
TabIndex = 8
ToolTipText = "Options..."
Top = 840
Width = 290
End
Begin VB.CommandButton Command4
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 4080
Picture = "MainForm.frx":0AA5
Style = 1 'Graphical
TabIndex = 5
ToolTipText = "Options..."
Top = 480
Width = 290
End
Begin VB.CommandButton Command2
Caption = "&Set File Date/Time"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1080
Style = 1 'Graphical
TabIndex = 13
Top = 1560
Width = 2895
End
Begin VB.TextBox Text3
BeginProperty DataFormat
Type = 0
Format = "hh:mm:ss AMPM"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1033
SubFormatType = 0
EndProperty
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1080
MaxLength = 11
TabIndex = 7
ToolTipText = "Format: h:mm:ss"
Top = 840
Width = 2895
End
Begin VB.TextBox Text2
BeginProperty DataFormat
Type = 0
Format = "MM/dd/yyyy"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1033
SubFormatType = 0
EndProperty
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1080
MaxLength = 10
TabIndex = 4
ToolTipText = "Format: mm/dd/yyyy"
Top = 480
Width = 2895
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 240
Top = 1560
_ExtentX = 847
_ExtentY = 847
_Version = 393216
DialogTitle = "Open File"
Filter = "All Files (*.*)|*.*"
End
Begin VB.CommandButton Command1
Caption = "..."
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 4080
Style = 1 'Graphical
TabIndex = 2
ToolTipText = "Browse..."
Top = 120
Width = 290
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1080
MaxLength = 128
TabIndex = 1
Top = 120
Width = 2895
End
Begin VB.Label Label6
Alignment = 1 'Right Justify
Caption = "Set Options:"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 0
TabIndex = 9
Top = 1200
Width = 975
End
Begin VB.Label Label5
Alignment = 1 'Right Justify
Caption = "About:"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 480
TabIndex = 15
Top = 2040
Width = 495
End
Begin VB.Label Label4
AutoSize = -1 'True
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 1080
TabIndex = 14
Top = 2040
Width = 45
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
Caption = "New &Time:"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 6
Top = 900
Width = 855
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "New &Date:"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 3
Top = 540
Width = 855
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "&File:"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 0
Top = 180
Width = 855
End
Begin VB.Menu DateBtnPopupMenu
Caption = "DateBtnPopupMenu"
Visible = 0 'False
Begin VB.Menu GetSystemDateMenu
Caption = "Get &System Date"
End
Begin VB.Menu GetFileCDateMenu
Caption = "Get File &Created Date"
End
Begin VB.Menu GetFileMDateMenu
Caption = "Get File &Modified Date"
End
Begin VB.Menu GetFileADateMenu
Caption = "Get File &Accessed Date"
End
End
Begin VB.Menu TimeBtnPopupMenu
Caption = "TimeBtnPopupMenu"
Visible = 0 'False
Begin VB.Menu GetSystemTimeMenu
Caption = "Get &System Time"
End
Begin VB.Menu GetFileCTimeMenu
Caption = "Get File &Created Time"
End
Begin VB.Menu GetFileMTimeMenu
Caption = "Get File &Modified Time"
End
Begin VB.Menu GetFileATimeMenu
Caption = "Get File &Accessed Time"
End
End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWrtTime As FILETIME) As Long
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWrtTime As FILETIME) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Const CREATE_ALWAYS As Long = 2
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const OPEN_ALWAYS As Long = 4
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 Sub Command1_Click()
On Error GoTo FixErr
With CommonDialog1
.ShowOpen
Text1.Text = .FileName
End With
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
FixErr:
End Sub
Private Sub Command2_Click()
On Error GoTo ErrAlert
Dim FileHandle As Long
Dim FileName As String
Dim fDate As Date
Dim CreatedTime As FILETIME
Dim LastAccTime As FILETIME
Dim LastWrtTime As FILETIME
Dim SysTime As SYSTEMTIME
FileName = Text1.Text
If Dir(FileName, vbArchive + vbHidden + vbNormal + vbReadOnly + vbSystem) = "" Then
MsgBox "Unable to open file.", vbCritical
Exit Sub
End If
If Check1.Value = 0 And Check2.Value = 0 And Check3.Value = 0 Then
MsgBox "At least one set option must be checked.", vbExclamation
Exit Sub
End If
FileHandle = CreateFile(FileName, GENERIC_WRITE Or GENERIC_READ, 0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
If FileHandle <> INVALID_HANDLE_VALUE Then
fDate = Text2.Text & " " & Text3.Text
SysTime.wYear = CInt(Format(fDate, "yyyy"))
SysTime.wMonth = CInt(Format(fDate, "m"))
SysTime.wDayOfWeek = CInt(Format(fDate, "w")) - 1
SysTime.wDay = CInt(Format(fDate, "d"))
SysTime.wHour = (CInt(Format(fDate, "h")) - 19) + 24
If SysTime.wHour >= 24 Then SysTime.wHour = SysTime.wHour - 23
SysTime.wMinute = CInt(Format(fDate, "n"))
SysTime.wSecond = CInt(Format(fDate, "s"))
GetFileTime FileHandle, CreatedTime, LastAccTime, LastWrtTime
If Check1.Value = 1 Then SystemTimeToFileTime SysTime, CreatedTime
If Check2.Value = 1 Then SystemTimeToFileTime SysTime, LastWrtTime
If Check3.Value = 1 Then SystemTimeToFileTime SysTime, LastAccTime
If SetFileTime(FileHandle, CreatedTime, LastAccTime, LastWrtTime) Then
MsgBox "File Date/Time Modified Successfully.", vbExclamation
Else
MsgBox "An error occurred during the File Date/Time modification process.", vbCritical
End If
End If
CloseHandle FileHandle
Exit Sub
ErrAlert:
MsgBox "An error occurred during the modification process.", vbCritical
CloseHandle FileHandle
End Sub
Private Sub Command4_Click()
PopupMenu DateBtnPopupMenu, , Command4.Left + Command4.Width, Command4.Top
End Sub
Private Sub Command5_Click()
PopupMenu TimeBtnPopupMenu, , Command5.Left + Command5.Width, Command5.Top
End Sub
Private Sub Form_Load()
CommonDialog1.Flags = cdlOFNFileMustExist + cdlOFNOverwritePrompt + cdlOFNLongNames + cdlOFNHideReadOnly
Label4.Caption = "Copyright � 1999 - 2000 Jason's PC Software" + vbCrLf + "jasonspc69@hotmail.com"
CButton Command1
CButton Command2
End Sub
Private Sub GetFileADateMenu_Click()
Dim FileHandle As Long
Dim FileName As String
Dim CreatedTime As FILETIME
Dim LastAccTime As FILETIME
Dim LastWrtTime As FILETIME
Dim SysTime As SYSTEMTIME
FileName = Text1.Text
If Dir(FileName, vbArchive + vbHidden + vbNormal + vbReadOnly + vbSystem) = "" Then
MsgBox "Unable to open file.", vbCritical
Exit Sub
End If
FileHandle = CreateFile(FileName, GENERIC_WRITE Or GENERIC_READ, 0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
If FileHandle <> INVALID_HANDLE_VALUE Then
GetFileTime FileHandle, CreatedTime, LastAccTime, LastWrtTime
FileTimeToSystemTime LastAccTime, SysTime
Text2.Text = Format(SysTime.wMonth & "/" & SysTime.wDay & "/" & SysTime.wYear, "mm/dd/yyyy")
CloseHandle FileHandle
End If
End Sub
Private Sub GetFileATimeMenu_Click()
Dim FileHandle As Long
Dim FileName As String
Dim CreatedTime As FILETIME
Dim LastAccTime As FILETIME
Dim LastWrtTime As FILETIME
Dim SysTime As SYSTEMTIME
FileName = Text1.Text
If Dir(FileName, vbArchive + vbHidden + vbNormal + vbReadOnly + vbSystem) = "" Then
MsgBox "Unable to open file.", vbCritical
Exit Sub
End If
FileHandle = CreateFile(FileName, GENERIC_WRITE Or GENERIC_READ, 0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
If FileHandle <> INVALID_HANDLE_VALUE Then
GetFileTime FileHandle, CreatedTime, LastAccTime, LastWrtTime
FileTimeToSystemTime LastAccTime, SysTime
Text3.Text = Format(IIf((SysTime.wHour + 19) - 24 < 1, SysTime.wHour + 19, (SysTime.wHour + 19) - 24) & ":" & SysTime.wMinute & ":" & SysTime.wSecond, "h:mm:ss")
CloseHandle FileHandle
End If
End Sub
Private Sub GetFileCDateMenu_Click()
Dim FileHandle As Long
Dim FileName As String
Dim CreatedTime As FILETIME
Dim LastAccTime As FILETIME
Dim LastWrtTime As FILETIME
Dim SysTime As SYSTEMTIME
FileName = Text1.Text
If Dir(FileName, vbArchive + vbHidden + vbNormal + vbReadOnly + vbSystem) = "" Then
MsgBox "Unable to open file.", vbCritical
Exit Sub
End If
FileHandle = CreateFile(FileName, GENERIC_WRITE Or GENERIC_READ, 0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
If FileHandle <> INVALID_HANDLE_VALUE Then
GetFileTime FileHandle, CreatedTime, LastAccTime, LastWrtTime
FileTimeToSystemTime CreatedTime, SysTime
Text2.Text = Format(SysTime.wMonth & "/" & SysTime.wDay & "/" & SysTime.wYear, "mm/dd/yyyy")
CloseHandle FileHandle
End If
End Sub
Private Sub GetFileCTimeMenu_Click()
Dim FileHandle As Long
Dim FileName As String
Dim CreatedTime As FILETIME
Dim LastAccTime As FILETIME
Dim LastWrtTime As FILETIME
Dim SysTime As SYSTEMTIME
FileName = Text1.Text
If Dir(FileName, vbArchive + vbHidden + vbNormal + vbReadOnly + vbSystem) = "" Then
MsgBox "Unable to open file.", vbCritical
Exit Sub
End If
FileHandle = CreateFile(FileName, GENERIC_WRITE Or GENERIC_READ, 0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
If FileHandle <> INVALID_HANDLE_VALUE Then
GetFileTime FileHandle, CreatedTime, LastAccTime, LastWrtTime
FileTimeToSystemTime CreatedTime, SysTime
Text3.Text = Format(IIf((SysTime.wHour + 19) - 24 < 1, SysTime.wHour + 19, (SysTime.wHour + 19) - 24) & ":" & SysTime.wMinute & ":" & SysTime.wSecond, "h:mm:ss")
CloseHandle FileHandle
End If
End Sub
Private Sub GetFileMDateMenu_Click()
Dim FileHandle As Long
Dim FileName As String
Dim CreatedTime As FILETIME
Dim LastAccTime As FILETIME
Dim LastWrtTime As FILETIME
Dim SysTime As SYSTEMTIME
FileName = Text1.Text
If Dir(FileName, vbArchive + vbHidden + vbNormal + vbReadOnly + vbSystem) = "" Then
MsgBox "Unable to open file.", vbCritical
Exit Sub
End If
FileHandle = CreateFile(FileName, GENERIC_WRITE Or GENERIC_READ, 0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
If FileHandle <> INVALID_HANDLE_VALUE Then
GetFileTime FileHandle, CreatedTime, LastAccTime, LastWrtTime
FileTimeToSystemTime LastWrtTime, SysTime
Text2.Text = Format(SysTime.wMonth & "/" & SysTime.wDay & "/" & SysTime.wYear, "mm/dd/yyyy")
CloseHandle FileHandle
End If
End Sub
Private Sub GetFileMTimeMenu_Click()
Dim FileHandle As Long
Dim FileName As String
Dim CreatedTime As FILETIME
Dim LastAccTime As FILETIME
Dim LastWrtTime As FILETIME
Dim SysTime As SYSTEMTIME
FileName = Text1.Text
If Dir(FileName, vbArchive + vbHidden + vbNormal + vbReadOnly + vbSystem) = "" Then
MsgBox "Unable to open file.", vbCritical
Exit Sub
End If
FileHandle = CreateFile(FileName, GENERIC_WRITE Or GENERIC_READ, 0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
If FileHandle <> INVALID_HANDLE_VALUE Then
GetFileTime FileHandle, CreatedTime, LastAccTime, LastWrtTime
FileTimeToSystemTime LastWrtTime, SysTime
Text3.Text = Format(IIf((SysTime.wHour + 19) - 24 < 1, SysTime.wHour + 19, (SysTime.wHour + 19) - 24) & ":" & SysTime.wMinute & ":" & SysTime.wSecond, "h:mm:ss")
CloseHandle FileHandle
End If
End Sub
Private Sub GetSystemDateMenu_Click()
Text2.Text = Format(Date, "Short Date")
End Sub
Private Sub GetSystemTimeMenu_Click()
Text3.Text = Format(Time, "h:mm:ss")
End Sub
Private Sub Option1_Click(Index As Integer)
End Sub