(1.130)  Login

English
Source / code snippets

Api File date reading Per write Time - 2

 

CompileMarkSeparation
'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 (%./../Function-References/XProfan/key/'>Key = 2)

        ProgEnde% = 1

    EndIf

EndWhile

end
 
07/15/07  ▲
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

Unreaded
subscribe
Remember-List
Notes
guests
Delete
Permanent
Done

5.053 Views

Untitledvor 0 min.
H.Brill10/09/22
Walter10/23/19
p.specht01/03/19
E.T.04/01/15
More...

Themeninformationen

this Topic has 1 subscriber:

unbekannt (1x)


Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.

all rightDatenschutzerklärung
i want none Cookie