Quelltexte/ Codesnippets | | | | | 
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...
KompilierenMarkierenSeparieren {$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 ▲ |
| | |
| |  | | Sehr nett - und funktioniert! Es wird GMT+0 ausgegeben - genau wie gewünscht! |
| | | | | | |
| | 
p.specht
 | | Kann man das auf X4-Assembler umstricken? Bei mir stürzt der Compi immer ab... |
| | | | XProfan 11Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 19.12.2020 ▲ |
| | |
| | 
RGH | | | | | XProfan X4Intel 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 ▲ |
| | |
| |
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: [...] 
$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 X4Intel 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 ▲ |
| | |
| |
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 ▲ |
| | |
| |
p.specht
| 
WindowTitle "UNIXTIME für 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 ▲ |
| | |
| |
p.specht
| Experimentell, ohne jede Garantie:
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
|
| | | | Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 26.12.2020 ▲ |
| | |
|
Zum QuelltextThemenoptionen | 6.522 Betrachtungen |
ThemeninformationenDieses Thema hat 4 Teilnehmer: |
(320)
Deutsch
English
Français
Español
Italia