Source / code snippets | | | | | 
Michael
Wodrich | iF having angeregt, The PHP-function time() nachzubilden.
These supply The verstrichene Time since 1.1.1970 00:00:00 UTC as LongInt.
The Datumsanzeige in the example have I using, around the with iFs PHP-code abzuchecken.
whether the Longint-worth but really UTC or MEZ supply, must iF time gegenprüfen...
CompileMarkSeparation {$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. | 01/30/06 ▲ |
| | |
| |  | | Very nice - and functions! it'll GMT+0 outputted - very How desired! |
| | | | | | |
| | 
p.specht
 | | Can the on X4-Assembler umstricken? by me crashes the Compi always ex... |
| | | | XProfan 11Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 12/19/20 ▲ |
| | |
| | 
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 | 12/20/20 ▲ |
| | |
| |
RGH | so goes it:
- the @ mark Adressen of imporrtierten functions, wozu too The Assemblerefunktionen belong and is either wegzulassen or through @@ To supplant, How one it with manchen Delphi-Source code finds.
- a few not XProfan known Assemblerfunktionen are through $H (Hexcodes insert) einzufügen. The suitable Hexcodes finds one slight on this 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 institute of technology1
inc edi
neg eax
adc edx,0
neg edx
mov [esi],eax
mov [esi+4],edx
institute of technology1:
mov ebx,[esi+8]
mov esi,[esi+12]
or esi,esi
jns institute of technology2
inc edi
neg ebx
adc esi,0
neg esi
institute of technology2:
jnz institute of technology3
or ebx,ebx
jz institute of technology8
mov ecx,eax
mov eax,edx
xor edx,edx
div ebx
xchg eax,ecx
div ebx
jmp institute of technology6
institute of technology3:
// 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 institute of technology4
cmp edx,[esi+4]
Yes institute of technology4
jb institute of technology5
cmp eax,[esi]
jbe institute of technology5
institute of technology4:
dec ebx
institute of technology5:
pop esi
xor ecx,ecx
mov eax,ebx
institute of technology6:
dec edi
jnz institute of technology7
neg eax
adc ecx,0
neg ecx
institute of technology7:
mov esi,par1
mov [esi+24],eax
mov [esi+28],ecx
jmp exit
institute of technology8:
xor eax,eax
dec eax
mov ecx, $7fffffff
jmp institute of technology6
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 | 12/20/20 ▲ |
| | |
| |
p.specht
| thanks, RGH!
Runs with small Changes (SBB, ADC) too in the Alpha.
Sekundengenau übereinstimmend with online-Unixtime [...] . supply Greenwich-sec ex 1.01.1970 00:00 watch UTC durchlaufend, means without The gegebenfalls halbjährlichen Schaltsekunden. |
| | | | Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 12/20/20 ▲ |
| | |
| |
p.specht
| 
Window Title "UNIXTIME for XProfan-11"
Window Style 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'... | 12/26/20 ▲ |
| | |
| |
p.specht
| Experimentell, without each warranty:
Window Title "PRÜFSUMME FOR HEXSTRING"
Var c$="5589E58B75088B068B56042B46101b5614890689560431FF09D2790EFFC7F7D883d200F7DA89068956048B5E088B760C0"+\
"9F67909FFC7F7DB83d200F7DE751509DB745D89C189D031D2F7F387C8F7F3E9330000000fbdceFEC1530fadf30fadd0d3eaF7F389C3F7"+\
"E689C158568B7508F7E301CA720B3B5604770672063B067602FFCB5E31C989D8FFCF7507F7D883d100F7D98B7508894618894E1CE90E000000"+\
"31C0FFC8B9FFFFFF7FE9D9FFFFFF89EC5DC20400"
Declare p$,w&,s!,l%,m%
l%=Len(c$):Casenote 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$=stature$("%g",s!)
ClearClip:PutClip p$'<<< ought to in the Echtprogramm out!!!!!!!!!!!!
Print " HEXSTRING-PRÜFSUMME = ";P$
If P$="2980236":Print "\n PRÜFSUMME OK."
Else: Print "\n *** FEHLER: PRÜFSUMME STIMMT NOT! ***"
Sound 1300,400:WaitInput:End
EndIf
WaitInput 1000
Beep:Print "\n\n HAUPTPROGRAMM: CALL-commands would statthaft!"
WaitInput
|
| | | | Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 12/26/20 ▲ |
| | |
|
Zum QuelltextThemeninformationenthis Topic has 4 subscriber: |
(1.872)
Deutsch
English
Français
Español
Italia