XProfan

'Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
'Datei: Datum und Zeit per API lesen und schreiben
'read and write File date and time by API
'Author: Dieter Zornow
'the time of last access is unchangable
'on NT based systems, XP or W2000 you will need administrator rights for change the date of a file
'feel free to use the code for own purpose
'tested with XProfan 8.0a, only Windows 9xx, Windows XP
Declare cfile$, Button&[], ProgEnde%
 $I profalt.inc
DEF GETSYSCOLOR(1) !"USER32","GetSysColor"
Def CreateFile(7) ! "kernel32","CreateFileA"
Def CloseHandle(1) ! "kernel32","CloseHandle"
Def GetFileTime(4) ! "kernel32","GetFileTime"
Def FileTimeToLocalFileTime(2) ! "kernel32","FileTimeToLocalFileTime"
Def FileTimeToSystemTime(2) ! "kernel32","FileTimeToSystemTime"
Def SetFileTime(4) ! "kernel32","SetFileTime"'handle, 3 x Filetime
Def GetSystemTimeAsFileTime(1) ! "kernel32","GetSystemTimeAsFileTime"'filetime
Def SystemTimeToFileTime(2) ! "kernel32","SystemTimeToFileTime"'sysstruc,filetime
Def LocalFileTimeToFileTime(2) ! "kernel32","LocalFileTimeToFileTime"'filetime,filetime

Proc GetHandle

    parameters file$,flag%
    declare file#,hndl&,secAt#
    Dim file#,len(file$)+1
    Dim secAt#,8
    String file#,0 = file$
    word secAt#,0 = 8'for NT parameter 4
    long secAt#,2 = 0
    word secAt#,6 = 0
    case Flag% = 0:hndl& = CreateFile(file#,$80000000,$01,0,4,$8000080,0)'read
    case Flag% = 1:hndl& = CreateFile(file#,$40000000,$01,0,4,$8000080,0)'write
    dispose file#
    dispose secAt#
    Return hndl&

endproc

proc writecurrentDate

    parameters hndl&,flag%
    Declare filetime#,succ&
    Dim filetime#,8
    GetSystemTimeAsFileTime(filetime#)

    if flag% = 1

        succ& = SetFileTime(hndl&,Filetime#,0,0)

    Elseif flag% = 2

        succ& = SetFileTime(hndl&,0,Filetime#,0)

    Elseif flag% = 3

        succ& = SetFileTime(hndl&,0,0,Filetime#)

    endif

    dispose filetime#

    if succ& = 0

        Messagebox("The date couldn't be changed","Access fault",64)

    endif

endproc

proc setdateForm

    parameters time$,flag%

    if flag% = 1

        settext ewday&,substr$(time$,1,"|")
        settext eday&,substr$(time$,2,"|")
        settext emonth&,substr$(time$,3,"|")
        settext eyear&,substr$(time$,4,"|")
        settext ehour&,substr$(time$,5,"|")
        settext eminute&,substr$(time$,6,"|")
        settext esec&,substr$(time$,7,"|")
        settext ems&,substr$(time$,8,"|")

    elseif flag% = 2

        settext zwday&,substr$(time$,1,"|")
        settext zday&,substr$(time$,2,"|")
        settext zmonth&,substr$(time$,3,"|")
        settext zyear&,substr$(time$,4,"|")
        settext zhour&,substr$(time$,5,"|")
        settext zminute&,substr$(time$,6,"|")
        settext zsec&,substr$(time$,7,"|")
        settext zms&,substr$(time$,8,"|")

    elseif flag% = 3

        settext swday&,substr$(time$,1,"|")
        settext sday&,substr$(time$,2,"|")
        settext smonth&,substr$(time$,3,"|")
        settext syear&,substr$(time$,4,"|")
        settext shour&,substr$(time$,5,"|")
        settext sminute&,substr$(time$,6,"|")
        settext ssec&,substr$(time$,7,"|")
        settext sms&,substr$(time$,8,"|")

    endif

endproc

proc GFT

    parameters hndl&,flag%
    declare Filetime#,systime#,y&,mo&,dw&,d&,h&,min&,sec&,ms&,time$
    Dim filetime#,8
    Dim systime#,16
    case flag% = 1:GetFileTime(hndl&,Filetime#,0,0)
    case flag% = 2:GetFileTime(hndl&,0,Filetime#,0)
    case flag% = 3:GetFileTime(hndl&,0,0,Filetime#)
    FileTimeToLocalFileTime(filetime#,filetime#)
    FileTimeToSystemTime(filetime#,systime#)
    y& = WORD(systime#,0)
    mo& = WORD(systime#,2)
    dw& = WORD(systime#,4)
    d& =  WORD(systime#,6)
    h& =  WORD(systime#,8)
    min& = WORD(systime#,10)
    sec& = WORD(systime#,12)
    ms& =  WORD(systime#,14)
    Dispose systime#
    Dispose filetime#

    If dw& = 0

        time$ = "Sunday"

    ElseIf dw& = 1

        time$ = "Monday"

    ElseIf dw& = 2

        time$ = "Tuesday"

    ElseIf dw& = 3

        time$ = "Wednesday"

    ElseIf dw& = 4

        time$ = "Thursday"

    ElseIf dw& = 5

        time$ = "Friday"

    ElseIf dw& = 6

        time$ = "Saturday"

    endif

    time$ = Time$+"|"+@Format$("00",d&)+"|"+@Format$("00",mo&)+"|"+str$(y&)+"|"+@Format$("00",h&)+"|"\
    +@Format$("00",min&)+"|"+@Format$("00",sec&)+"|"+@Format$("000",ms&)
    return time$

endproc

PROC showfiletime

    parameters file$
    DECLARE DLG&, DIALOGENDE%,Zday&,Zmonth&,Zyear&,Sday&,Smonth&,Syear&,Ehour&,Esec&,Eminute&,Ems&
    DECLARE Zhour&,Zsec&,Zminute&,Zms&,Shour&,Ssec&,Sminute&,Sms&,dat&,Ewday&,Eday&,Emonth&,Eyear&
    DECLARE Zwday&,Swday&,change&,bye&,gr1&,gr2&,gr3&,set3&,set2&,set1&,th&
    DECLARE TEXT2&,TEXT3&,TEXT4&,TEXT6&,TEXT7&,TEXT9&,TEXT10&,TEXT11&,TEXT12&
    Declare Filetime1#,Filetime2#,Filetime3#,systime1#,systime2#,systime3#,succ&
    WINDOWSTYLE 31
    DLG&=CREATE("DIALOG",%HWND,"File date and time",SUB(DIV(%MAXX,2),DIV(429,2)),SUB(DIV(%MAXY,2),DIV(494,2)),429,494)
    USEFONT "MS Sans Serif",13,0,0,0,0
    SETDIALOGFONT 1
    dat& =@CREATE("EDIT",DLG&,"",0010,0010,0400,0020)
    gr1& = @CREATE("GROUPBOX",DLG&,"Creation Time:",0005,0035,0210,0120)
    TEXT2& =@CREATE("TEXT",DLG&,"Weekday:",0010,0060,0070,0020)
    Ewday& =@CREATE("EDIT",DLG&,"",0085,0060,0120,0020)
    text3& =@CREATE("TEXT",DLG&,"Date:",0010,0090,0070,0020)
    Eday& =@CREATE("EDIT",DLG&,"",0085,0090,0020,0020)
    Emonth& =@CREATE("EDIT",DLG&,"",0115,0090,0020,0020)
    Eyear& =@CREATE("EDIT",DLG&,"",0145,0090,0030,0020)
    TEXT4& =@CREATE("TEXT",DLG&,"Time:",0010,0120,0070,0020)
    Ehour& =@CREATE("EDIT",DLG&,"",0085,0120,0020,0020)
    Eminute& =@CREATE("EDIT",DLG&,"",0115,0120,0020,0020)
    Esec& =@CREATE("EDIT",DLG&,"",0145,0120,0020,0020)
    Ems& =@CREATE("EDIT",DLG&,"",0175,0120,0030,0020)
    set1& =@CREATE("BUTTON",DLG&,"&write current date",0230,0085,0150,0025)'aktuell
    gr2& = @CREATE("GROUPBOX",DLG&,"Last Access:",0005,0158,0210,0120)
    TEXT6& =@CREATE("TEXT",DLG&,"Weekday:",0010,0181,0070,0020)
    Zwday& =@CREATE("EDIT",DLG&,"",0085,0182,0120,0020)
    TEXT11& =@CREATE("TEXT",DLG&,"Date:",0010,0215,0070,0020)
    Zday& =@CREATE("EDIT",DLG&,"",0085,0215,0020,0020)
    Zmonth& =@CREATE("EDIT",DLG&,"",0115,0215,0020,0020)
    Zyear& =@CREATE("EDIT",DLG&,"",0145,0215,0030,0020)
    TEXT7& =@CREATE("TEXT",DLG&,"Time:",0010,0245,0070,0020)
    Zhour& =@CREATE("EDIT",DLG&,"",0085,0245,0020,0020)
    Zminute& =@CREATE("EDIT",DLG&,"",0115,0245,0020,0020)
    Zsec& =@CREATE("EDIT",DLG&,"",0145,0245,0020,0020)
    Zms& =@CREATE("EDIT",DLG&,"",0175,0245,0030,0020)
    set2& =@CREATE("BUTTON",DLG&,"w&rite current date",0230,0210,0150,0025)'aktuell
    gr3& = @CREATE("GROUPBOX",DLG&,"Last written:",0005,0282,0210,0120)
    TEXT9& =@CREATE("TEXT",DLG&,"Weekday:",0010,0303,0070,0020)
    Swday& =@CREATE("EDIT",DLG&,"",0084,0303,0120,0020)
    TEXT12& =@CREATE("TEXT",DLG&,"Date:",0010,0338,0070,0020)
    Sday& =@CREATE("EDIT",DLG&,"",0085,0338,0020,0020)
    Smonth& =@CREATE("EDIT",DLG&,"",0115,0338,0020,0020)
    Syear& =@CREATE("EDIT",DLG&,"",0145,0338,0030,0020)
    TEXT10& =@CREATE("TEXT",DLG&,"Time:",0013,0372,0070,0020)
    Shour& =@CREATE("EDIT",DLG&,"",0085,0372,0020,0020)
    Sminute& =@CREATE("EDIT",DLG&,"",0115,0372,0020,0020)
    Ssec& =@CREATE("EDIT",DLG&,"",0145,0372,0020,0020)
    Sms& =@CREATE("EDIT",DLG&,"",0175,0372,0030,0020)
    set3& =@CREATE("BUTTON",DLG&,"wr&ite current date",0230,0330,0150,0025)'aktuell
    change& =@CREATE("BUTTON",DLG&,"&Change Date",0022,0414,0100,0025)
    bye& =@CREATE("BUTTON",DLG&,"&End",0315,0414,0070,0025)
    enablewindow dat&,0
    enablewindow ewday&,0
    enablewindow zwday&,0
    enablewindow swday&,0
    SETFOCUS(DLG&)
    LET DIALOGENDE%=0

    if file$ <> ""

        settext dat&,file$
        GetHandle file$,0
        th& = @&(0)

        if th& <> -1

            GFT th&,1
            setdateForm @$(0),1
            GFT th&,2
            setdateForm @$(0),2
            GFT th&,3
            setdateForm @$(0),3

        endif

    endif

    WHILENOT DIALOGENDE%

        WAITINPUT

        If @EQU(%KEY,2)

            LET DIALOGENDE%= 1

        ELSEIF GETFOCUS(set1&)'BUTTON 'aktuell

            CloseHandle(th&)
            GetHandle file$,1
            th& = @&(0)
            case th& = -1:Messagebox("File couldn't be opened for a write operation.\nRemove a possible write protection","Access fault",16)

            if th& > -1

                writecurrentDate th&,1
                GFT th&,1
                setdateForm @$(0),1

            endif

        ELSEIF GETFOCUS(set2&)'BUTTON 'aktuell

            CloseHandle(th&)
            GetHandle file$,1
            th& = @&(0)
            case th& = -1:Messagebox("File couldn't be opened for a write operation.\nRemove a possible write protection","Access fault",16)

            if th& > -1

                writecurrentDate th&,2
                GFT th&,2
                setdateForm @$(0),2

            endif

        ELSEIF GETFOCUS(set3&)'BUTTON 'aktuell

            CloseHandle(th&)
            GetHandle file$,1
            th& = @&(0)
            case th& = -1:Messagebox("File couldn't be opened for a write operation.\nRemove a possible write protection","Access fault",16)

            if th& > -1

                writecurrentDate th&,3
                GFT th&,3
                setdateForm @$(0),3

            endif

        ELSEIF GETFOCUS(change&)'BUTTON

            CloseHandle(th&)
            GetHandle file$,1
            th& = @&(0)
            case th& = -1:Messagebox("File couldn't be opened for a write operation.\nRemove a possible write protection","Access fault",16)

            if th& > -1

                Dim Filetime1#,8
                Dim Filetime2#,8
                Dim Filetime3#,8
                Dim systime1#,16
                Dim systime2#,16
                Dim systime3#,16
                'Creation
                WORD systime1#,0 = val(Gettext$(eyear&))
                WORD systime1#,2 = val(Gettext$(emonth&))
                WORD systime1#,4 = 1
                WORD systime1#,6 = val(Gettext$(eday&))
                WORD systime1#,8 = val(Gettext$(ehour&))
                WORD systime1#,10 = val(Gettext$(eminute&))
                WORD systime1#,12 = val(Gettext$(esec&))
                WORD systime1#,14 = val(Gettext$(ems&))
                SystemTimeToFileTime(systime1#,filetime1#)
                LocalFileTimeToFileTime(filetime1#,filetime1#)
                'Last access
                WORD systime2#,0 = val(Gettext$(zyear&))
                WORD systime2#,2 = val(Gettext$(zmonth&))
                WORD systime2#,4 = 1
                WORD systime2#,6 = val(Gettext$(zday&))
                WORD systime2#,8 = val(Gettext$(zhour&))
                WORD systime2#,10 = val(Gettext$(zminute&))
                WORD systime2#,12 = val(Gettext$(zsec&))
                WORD systime2#,14 = val(Gettext$(zms&))
                SystemTimeToFileTime(systime2#,filetime2#)
                LocalFileTimeToFileTime(filetime2#,filetime2#)
                'Last written
                WORD systime3#,0 = val(Gettext$(syear&))
                WORD systime3#,2 = val(Gettext$(smonth&))
                WORD systime3#,4 = 1
                WORD systime3#,6 = val(Gettext$(sday&))
                WORD systime3#,8 = val(Gettext$(shour&))
                WORD systime3#,10 = val(Gettext$(sminute&))
                WORD systime3#,12 = val(Gettext$(ssec&))
                WORD systime3#,14 = val(Gettext$(sms&))
                SystemTimeToFileTime(systime3#,filetime3#)
                LocalFileTimeToFileTime(filetime3#,filetime3#)
                succ& = SetFileTime(th&,filetime1#,filetime2#,filetime3#)
                Dispose Filetime1#
                Dispose Filetime2#
                Dispose Filetime3#
                Dispose systime1#
                Dispose systime2#
                Dispose systime3#

                if succ& = 0

                    Messagebox("The date couldn't be changed","Access fault",64)

                else

                    GFT th&,1
                    setdateForm @$(0),1
                    GFT th&,2
                    setdateForm @$(0),2
                    GFT th&,3
                    setdateForm @$(0),3

                endif

            endif

        ELSEIF GETFOCUS(bye&)'BUTTON

            LET DIALOGENDE%= 1

        ENDIF

    WEND

    case th& > -1:CloseHandle(th&)
    @DESTROYWINDOW(DLG&)

ENDPROC

WINDOWTITLE "File date and time"
WINDOWSTYLE 1024 + 16 + 8 + 512
WINDOW 200,150
Button&[1] = @Create("Button",%HWnd,"Einzelne Datei laden",10,10,170,25)
Button&[2] = @Create("Button",%HWnd,"Verzeichnis laden",10,40,170,25)
Button&[3] = @Create("Button",%HWnd,"Programm beenden",10,80,170,25)
Clear ProgEnde%

WhileNot ProgEnde%

    waitinput

    If @Clicked(Button&[1])

        cfile$ = @LoadFile$("open file:","*.*")
        case cfile$ <> "":showfiletime cfile$

    ElseIf @Clicked(Button&[2])

    ElseIf  (@Clicked(Button&[3])) OR (%./../funktionsreferenzen/XProfan/key/'>Key = 2)

        ProgEnde% = 1

    EndIf

EndWhile

end