(1.116)  S'inscrire

Français
Source/ Codesnippets

Api Dossier date Lesen Per écrivons Zeit - 2

 

KompilierenMarqueSéparation
'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/clé/'>Key = 2)

        ProgEnde% = 1

    EndIf

Endwhile

end
 
15.07.2007  ▲
 



Zum Quelltext


Topictitle, max. 100 marque.
 

Systemprofile:

ne...aucune Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

s'il te plaît s'inscrire um une Beitrag trop verfassen.
 

Options du sujet

Unreaded
abonner
La liste de voeux
Notes
guests
Effacer
Permanent
Done

5.060 Views

Untitledvor 0 min.
H.Brill09.10.2022
Walter23.10.2019
p.specht03.01.2019
E.T.01.04.2015
plus...

Themeninformationen

cet Thema hat 1 participant:

unbekannt (1x)


Admins  |  AGB  |  Applications  |  Auteurs  |  Chat  |  protection des données  |  Télécharger  |  Entrance  |  Aider  |  Merchantportal  |  Empreinte  |  Mart  |  Interfaces  |  SDK  |  Services  |  Jeux  |  cherche  |  Support

un projet aller XProfaner, qui il y a!


Mon XProfan
Privé Nouvelles
Eigenes Ablageforum
Sujets-La liste de voeux
Eigene Posts
Eigene Sujets
Zwischenablage
Annuler
 Deutsch English Français Español Italia
Traductions

protection des données


Wir verwenden Cookies seulement comme Session-Cookies à cause de qui technischen Notwendigkeit et chez uns gibt es aucun Cookies de Drittanbietern.

si du ici sur unsere Webseite klickst ou bien navigierst, stimmst du unserer Erfassung de Informationen dans unseren Cookies sur XProfan.Net trop.

Weitere Informationen trop unseren Cookies et en supplément, comment du qui Kontrolle par-dessus behältst, findest du dans unserer nachfolgenden Datenschutzerklärung.

d'accordDatenschutzerklärung
je voudrais keinen Cookie