XProfan

Italia

Michael
Wodrich

iF hatte angeregt, die PHP-Funktion time() nachzubilden.

Diese liefert die verstrichene Zeit seit 1.1.1970 00:00:00 UTC als LongInt.
Die Datumsanzeige im Beispiel habe ich benutzt, um das mit iFs PHP-Code abzuchecken.

Ob der Longint-Wert aber wirklich UTC oder MEZ liefert, muß iF mal gegenprüfen...
Kompilieren Markieren Separieren

 {$cleq}
 $H C:ProfanIncludeWindows.ph

Proc unixtime

    Declare Buffer#, BufferPtr&, zeit&
    ist Struct TimeBuffer = FTimeLo&, FTimeHi&, DivLo&, DivHi&, BiasLo&, BiasHi&, ErgebnisLo&, ErgebnisHi&
    Dim Buffer#,32
    BufferPtr& = Addr(Buffer#)
    ~GetSystemTimeAsFileTime( Buffer# )
    Long Buffer#,8 = $00989680, 0, $D53E8000, $019DB1DE

    AsmStart _tounix(BufferPtr&)

        mov esi,para1
        mov eax,[esi]
        mov edx,[esi+4]
        sub eax,[esi+16]
        sbb edx,[esi+20]
        mov [esi],eax
        mov [esi+4],edx
        xor edi,edi
        or  edx,edx
        jns @tu1
        inc edi
        neg eax
        adc edx,0
        neg edx
        mov [esi],eax
        mov [esi+4],edx
        @tu1:
        mov ebx,[esi+8]
        mov esi,[esi+12]
        or  esi,esi
        jns @tu2
        inc edi
        neg ebx
        adc esi,0
        neg esi
        @tu2:
        jnz @tu3
        or  ebx,ebx
        jz  @tu8
        mov ecx,eax
        mov eax,edx
        xor edx,edx
        div ebx
        xchg eax,ecx
        div ebx
        jmp @tu6
        @tu3:
        bsr ecx,esi
        inc cl
        push ebx
        shrd ebx,esi,cl
        shrd eax,edx,cl
        shr edx,cl
        div ebx
        mov ebx,eax
        mul esi
        mov ecx,eax
        pop eax
        push esi
        mov esi,para1
        mul ebx
        add edx,ecx
        jc @tu4
        cmp edx,[esi+4]
        ja  @tu4
        jb  @tu5
        cmp eax,[esi]
        jbe @tu5
        @tu4:
        dec ebx
        @tu5:
        pop esi
        xor ecx,ecx
        mov eax,ebx
        @tu6:
        dec edi
        jnz @tu7
        neg eax
        adc ecx,0
        neg ecx
        @tu7:
        mov esi,para1
        mov [esi+24],eax
        mov [esi+28],ecx
        jmp @exit
        @tu8:
        xor eax,eax
        dec eax
        mov ecx,7fffffffh
        jmp @tu6
        @exit:

    AsmEnd (zeit&)

    Dispose Buffer#
    Return zeit&

EndProc

Cls
Print
Print unixtime()
Print Date$(5)
Print

While 1

    WaitInput

    If %Key = 2

        Break

    EndIf

    Print unixtime()
    Print Date$(5)
    Print

EndWhile

End

Programmieren, das spannendste Detektivspiel der Welt.

30.01.2006 ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione

Sehr nett - und funktioniert! Es wird GMT+0 ausgegeben - genau wie gewünscht!

30.01.2006 ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione

p.specht

Kann man das auf X4-Assembler umstricken? Bei mir stürzt der Compi immer ab...

XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...

19.12.2020 ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione

RGH

Ich schaue mal ...

XProfan X4
Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4

20.12.2020 ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione

RGH

So geht es:

- Das @ kennzeichnet Adressen von imporrtierten Funktionen, wozu auch die Assemblerefunktionen gehören und ist entweder wegzulassen oder durch @@ zu ersetzen, wie man es bei manchen Delphi-Quellcodes findet.
- Einige wenige nicht in XProfan bekannte Assemblerfunktionen sind durch $H (Hexcodes einfügen) einzufügen. Die passenden Hexcodes findet man leicht auf dieser Seite: [...]

Kompilieren Markieren Separieren

 $H Windows.ph
Asm "_tounix", 1// BufferPtr&
mov esi,par1
mov eax,[esi]
mov edx,[esi+4]
sub eax,[esi+16]
sbb edx,[esi+20]
mov [esi],eax
mov [esi+4],edx
xor edi,edi
or  edx,edx
jns tu1
inc edi
neg eax
adc edx,0
neg edx
mov [esi],eax
mov [esi+4],edx
tu1:
mov ebx,[esi+8]
mov esi,[esi+12]
or  esi,esi
jns tu2
inc edi
neg ebx
adc esi,0
neg esi
tu2:
jnz tu3
or  ebx,ebx
jz  tu8
mov ecx,eax
mov eax,edx
xor edx,edx
div ebx
xchg eax,ecx
div ebx
jmp tu6
tu3:
//        bsr ecx,esi
dh "0fbdce"
inc cl
push ebx
//        shrd ebx,esi,cl
dh "0fadf3"
//        shrd eax,edx,cl
dh "0fadd0"
//        shr edx,cl
dh "d3ea"
div ebx
mov ebx,eax
mul esi
mov ecx,eax
pop eax
push esi
mov esi,par1
mul ebx
add edx,ecx
jc tu4
cmp edx,[esi+4]
ja  tu4
jb  tu5
cmp eax,[esi]
jbe tu5
tu4:
dec ebx
tu5:
pop esi
xor ecx,ecx
mov eax,ebx
tu6:
dec edi
jnz tu7
neg eax
adc ecx,0
neg ecx
tu7:
mov esi,par1
mov [esi+24],eax
mov [esi+28],ecx
jmp exit
tu8:
xor eax,eax
dec eax
mov ecx, $7fffffff
jmp tu6
exit:
EndAsm

Proc unixtime

    Declare Buffer#, BufferPtr&, zeit&
    Struct TimeBuffer = FTimeLo&, FTimeHi&, DivLo&, DivHi&, BiasLo&, BiasHi&, ErgebnisLo&, ErgebnisHi&
    Dim Buffer#,32
    BufferPtr& = Addr(Buffer#)
    ~GetSystemTimeAsFileTime( Buffer# )
    Long Buffer#,8 = $00989680, 0, $D53E8000, $019DB1DE
    zeit& = _tounix(BufferPtr&)
    Dispose Buffer#
    Return zeit&

EndProc

Cls
Print
Print unixtime()
Print Date$(5)
Print

While 1

    WaitInput

    If %Key = 2

        Break

    EndIf

    Print unixtime()
    Print Date$(5)
    Print

EndWhile

End

XProfan X4
Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4

20.12.2020 ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione

p.specht

Danke, RGH!

Läuft mit kleinen Änderungen (SBB, ADC) auch in der Alpha.
Sekundengenau übereinstimmend mit online-Unixtime [...]

. Liefert Greenwich-Sekunden ab 1.01.1970 00:00 Uhr UTC durchlaufend, also ohne die gegebenfalls halbjährlichen Schaltsekunden.

Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...

20.12.2020 ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione

p.specht

Kompilieren Markieren Separieren

WindowTitle "UNIXTIME per XProfan-11"
WindowStyle 24:CLS $FF0000
var UxTime$="5589E58B75088B068B56042B46101b5614890689560431FF09D2790EFFC7F7D883d200F7DA89068956048B5E088B760C0"+\
"9F67909FFC7F7DB83d200F7DE751509DB745D89C189D031D2F7F387C8F7F3E9330000000fbdceFEC1530fadf30fadd0d3eaF7F389C3F7"+\
"E689C158568B7508F7E301CA720B3B5604770672063B067602FFCB5E31C989D8FFCF7507F7D883d100F7D98B7508894618894E1CE90E000000"+\
"31C0FFC8B9FFFFFF7FE9D9FFFFFF89EC5DC20400":Declare UxTime#:Dim UxTime#,len(UxTime$)\2
:whileloop 0,Sizeof(UxTime#)-1:Byte UxTime#,&Loop=val("$"+mid$(UxTime$,2*&Loop+1,2)):EndWhile

Proc Unixtime

    Declare Buffer#,BufferPtr&,zeit&
    Struct TimeBuffer=FTimeLo&,FTimeHi&,DivLo&,DivHi&,BiasLo&,BiasHi&,ErgebnisLo&,ErgebnisHi&
    Dim Buffer#,32:BufferPtr& = Addr(Buffer#)
    External("kernel32.dll","GetSystemTimeAsFileTime",Buffer#)
    Long Buffer#,8=$00989680,0,$D53E8000,$019DB1DE
    zeit&=Call(UxTime#,BufferPtr&):Dispose Buffer#:Return zeit&

EndProc

While 1

    Case %Key = 2:BREAK
    Print unixtime(),Tab(26);Date$(5)
    WaitInput 1000

EndWhile

Dispose UxTime#
WaitInput 1000
End

Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...

26.12.2020 ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione

p.specht

Experimentell, ohne jede Garantie:

Kompilieren Markieren Separieren

WindowTitle "PRÜFSUMME FÜR HEXSTRING"
Var c$="5589E58B75088B068B56042B46101b5614890689560431FF09D2790EFFC7F7D883d200F7DA89068956048B5E088B760C0"+\
"9F67909FFC7F7DB83d200F7DE751509DB745D89C189D031D2F7F387C8F7F3E9330000000fbdceFEC1530fadf30fadd0d3eaF7F389C3F7"+\
"E689C158568B7508F7E301CA720B3B5604770672063B067602FFCB5E31C989D8FFCF7507F7D883d100F7D98B7508894618894E1CE90E000000"+\
"31C0FFC8B9FFFFFF7FE9D9FFFFFF89EC5DC20400"
Declare p$,w&,s!,l%,m%
l%=Len(c$):CaseNot l%:c$="0000"
l%=Len(c$):m%=l% Mod 4

If m%=1:c$=c$+"000"

ElseIf m%=2:c$=c$+"00"

ElseIf m%=3:c$=c$+"0"

EndIf

s!=1'<<< your salt
l%=Len(c$)

WhileLoop 0,l%-4,4

    s!=s!+Val("$"+Mid$(c$,&Loop+1,4))

EndWhile

P$=Format$("%g",s!)
ClearClip:PutClip p$'<<< sollte im Echtprogramm raus!!!!!!!!!!!!
Print "  HEXSTRING-PRÜFSUMME = ";P$

If P$="2980236":Print "\n  PRÜFSUMME OK."

    Else: Print "\n  *** FEHLER: PRÜFSUMME STIMMT NICHT! ***"
    Sound 1300,400:WaitInput:End

EndIf

WaitInput 1000
Beep:Print "\n\n  HAUPTPROGRAMM: CALL-Befehl wäre statthaft!"
WaitInput