Source/ Codesnippets | | | | | 
Michael
Wodrich | iF hatte angeregt, qui PHP-Funktion time() nachzubilden.
cet liefert qui verstrichene Zeit depuis 1.1.1970 00:00:00 UTC comme LongInt.
qui Datumsanzeige im Beispiel habe je benutzt, um cela avec iFs PHP-Code abzuchecken.
si qui Longint-Wert mais wirklich UTC ou bien MEZ liefert, doit iF la fois gegenprüfen...
KompilierenMarqueSéparation {$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
Fin
|
| | | | Programmieren, das spannendste Detektivspiel der Welt. | 30.01.2006 ▲ |
| | |
| |  | | très gentil - et funktioniert! Es wird GMT+0 ausgegeben - oui c'est ca comment gewünscht! |
| | | | | | |
| | 
p.specht
 | | peux on cela sur X4-Assembler umstricken? chez mir stürzt qui Compi toujours 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 ca va:
- cela @ kennzeichnet Adressen de imporrtierten Funktionen, wozu aussi qui Assemblerefunktionen gehören et ist entweder wegzulassen ou bien par @@ trop ersetzen, comment on es chez manchen Delphi-Quellcodes findet.
- quelques wenige pas dans XProfan bekannte Assemblerfunktionen sommes par $H (Hexcodes insérer) einzufügen. qui passenden Hexcodes findet on léger sur cette page: [...] 
$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]
oui 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
Déclarer Buffer#, BufferPtr&, zeit&
Struct TimeBuffer = FTimeLo&, FTimeHi&, DivLo&, DivHi&, BiasLo&, BiasHi&, ErgebnisLo&, ErgebnisHi&
Faible Buffer#,32
BufferPtr& = Addr(Buffer#)
~GetSystemTimeAsFileTime( Buffer# )
Long Buffer#,8 = $00989680, 0, $D53E8000, $019DB1DE
zeit& = _tounix(BufferPtr&)
Dispose Buffer#
Retour zeit&
ENDPROC
Cls
Imprimer
Imprimer unixtime()
Imprimer Date$(5)
Imprimer
Tandis que 1
WaitInput
Si %Key = 2
Pause
EndIf
Imprimer unixtime()
Imprimer Date$(5)
Imprimer
Endwhile
Fin
|
| | | | 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
| merci, RGH!
Läuft avec kleinen Changements (SBB, ADC) aussi dans qui Alpha.
Sekundengenau übereinstimmend avec online-Unixtime [...] . Liefert Greenwich-Sekunden ab 1.01.1970 00:00 montre UTC durchlaufend, alors sans qui 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
| 
Titre de la fenêtre "UNIXTIME pour XProfan-11"
Fenêtre Style 24:CLS $FF0000
var UxTime$="5589E58B75088B068B56042B46101b5614890689560431FF09D2790EFFC7F7D883d200F7DA89068956048B5E088B760C0"+\
"9F67909FFC7F7DB83d200F7DE751509DB745D89C189D031D2F7F387C8F7F3E9330000000fbdceFEC1530fadf30fadd0d3eaF7F389C3F7"+\
"E689C158568B7508F7E301CA720B3B5604770672063B067602FFCB5E31C989D8FFCF7507F7D883d100F7D98B7508894618894E1CE90E000000"+\
"31C0FFC8B9FFFFFF7FE9D9FFFFFF89EC5DC20400":Déclarer UxTime#:Faible UxTime#,len(UxTime$)\2
:whileloop 0,Sizeof(UxTime#)-1:Byte UxTime#,&Boucle=val("$"+mid$(UxTime$,2*&Boucle+1,2)):Endwhile
Proc Unixtime
Déclarer Buffer#,BufferPtr&,zeit&
Struct TimeBuffer=FTimeLo&,FTimeHi&,DivLo&,DivHi&,BiasLo&,BiasHi&,ErgebnisLo&,ErgebnisHi&
Faible Buffer#,32:BufferPtr& = Addr(Buffer#)
Externe("kernel32.dll","GetSystemTimeAsFileTime",Buffer#)
Long Buffer#,8=$00989680,0,$D53E8000,$019DB1DE
zeit&=Call(UxTime#,BufferPtr&):Dispose Buffer#:Retour zeit&
ENDPROC
Tandis que 1
Cas %Key = 2:BREAK
Imprimer unixtime(),Tab(26);Date$(5)
WaitInput 1000
Endwhile
Dispose UxTime#
WaitInput 1000
Fin
|
| | | | Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 26.12.2020 ▲ |
| | |
| |
p.specht
| Experimentell, sans chacun garantie:
Titre de la fenêtre "PRÜFSUMME D' HEXSTRING"
Var c$="5589E58B75088B068B56042B46101b5614890689560431FF09D2790EFFC7F7D883d200F7DA89068956048B5E088B760C0"+\
"9F67909FFC7F7DB83d200F7DE751509DB745D89C189D031D2F7F387C8F7F3E9330000000fbdceFEC1530fadf30fadd0d3eaF7F389C3F7"+\
"E689C158568B7508F7E301CA720B3B5604770672063B067602FFCB5E31C989D8FFCF7507F7D883d100F7D98B7508894618894E1CE90E000000"+\
"31C0FFC8B9FFFFFF7FE9D9FFFFFF89EC5DC20400"
Déclarer p$,w&,s!,l%,m%
l%=Len(c$):Casenote l%:c$="0000"
l%=Len(c$):m%=l% Mod 4
Si 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$,&Boucle+1,4))
Endwhile
P$=Format $("%g",s!)
ClearClip:PutClip p$'<<< sollte im Echtprogramm raus!!!!!!!!!!!!
Imprimer " HEXSTRING-PRÜFSUMME = ";P$
Si P$="2980236":Imprimer "\n PRÜFSUMME OK."
D'autre: Imprimer "\n *** FEHLER: PRÜFSUMME STIMMT NICHT! ***"
Sound 1300,400:WaitInput:Fin
EndIf
WaitInput 1000
Beep:Imprimer "\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 QuelltextOptions du sujet | 7.394 Views |
Themeninformationencet Thema hat 4 participant: |
(887)
Deutsch
English
Français
Español
Italia