CodeArchiv für PB v4 - aktueller Status & Mithelfer gesu

[PureLust]

GetProcessorGHz.pb

Hmmm ... also bei meinem 3.6er P4 bekomme ich als Ergebnis: 0.0108 GHz

[Helle]

Ist etwas genauer :

Code: Alles auswählen

; German forum: http://www.purebasic.fr/german/viewtopic.php?t=2419 
; Author: Froggerprogger (updated for PB 4.00 by Andre) 
; Updated : 13/03/07 Progi1984 
; Date: 12. March 2005 
; OS: Windows 
; Demo: Yes 

; ghz.f = GetProcessorGHz(waitMs.l) 
; returns to get the processors speed and uses waitMs Milliseconds 
; for the calculation. (values >= 500 should give an accurate result) 
; by Froggerprogger 12.03.05 

; GetProcessorGHz(waitMs.l) liefert einen Float zurück, der die Geschwindigkeit 
; der CPU in GHz wiedergibt. Dabei kann die Dauer des Tests eingestellt werden, 
; "ein paar 100" ms sollten es aber schon sein, bei allem unter 100ms wird es 
; bei mir zumindest sehr ungenau. 

Procedure.f GetProcessorGHz(waitMs.l) 
  Protected Hi.l, Lo.l 

  SetPriorityClass_(GetCurrentProcess_(),#REALTIME_PRIORITY_CLASS)  ; switching to realtime priority 
  Sleep_(0)                  ; wait for new time-slice 

  !RDTSC                     ; load the proc's timestamp to eax & edx 
  !MOV [p.v_Lo], eax         ; store eax to Lo 
  !MOV [p.v_Hi], edx         ; store edx to Hi 

  Sleep_(waitMs)             ; wait for waitMs ms 

  !RDTSC                     ; load the proc's timestamp to eax & edx 
  !SUB eax, [p.v_Lo]         ; subtract Lo from eax 
  !SBB edx, [p.v_Hi]         ; subtract Hi from edx incl. carrybit 

  !MOV ecx, dword 1000       ; store 1000 to ecx 
  !DIV ecx                   ; divide edx & eax by ecx and store result in eax 

  !MOV [p.v_Lo], eax         ; copy result to Lo 

  SetPriorityClass_(GetCurrentProcess_(),#NORMAL_PRIORITY_CLASS)  ; switching back to normal priority 
  Val.f=  Lo / (1000.0 * waitMs) 
  ProcedureReturn Val 
EndProcedure 

MessageRequester("","Processorspeed is " + StrF(GetProcessorGHz(1000), 4) + " GHz") 

; IDE Options = PureBasic v4.02 (Windows - x86) 
; Folding = - 

Gruss
Helle

[Thomas]

Hi,
nur mal ne Frage:
wann gibts Version 4 zum runterladen (gezipt, oder so) ?

[Kaeru Gaman]

aktuelle version von Colors.pbi:

http://www.purebasic.fr/german/viewtopic.php?t=12595

...jetzt funktioniert es richtig, die werte sind literal vordefiniert.

[Progi1984]

A new code ready to use for replacing "http://www.purearea.net/temp/CodeArchiv ... roc_xxx.pb"

Code: Alles auswählen

ProcedureDLL IPNum(IPAdress.s) ; Return a numerical IP Adress from a IPString
  IpAddress.l=MakeIPAddress(Val(StringField(IPAdress,1,".")),Val(StringField(IPAdress,2,".")),Val(StringField(IPAdress,3,".")),Val(StringField(IPAdress,4,".")))
  ProcedureReturn IpAddress
EndProcedure

ProcedureDLL.s HostnameToIP(ConputerName.s) ; Return as a String
  If Len(ConputerName) > 0
    ResultIP.s=""   
    high.b = 1: low.b = 1
    Define wsaversion.w
    PokeB(@wsaversion, high)
    PokeB(@wsaversion + 1, low)
    If WSAStartup_(wsaversion, wsa.WSADATA) = #NOERROR ; Try to access Windows sockets stuff...
      *host.HOSTENT = gethostbyname_(ConputerName)       ; Get host information for named computer...
      If *host <> #Null     
        While PeekL(*host\h_addr_list  + AdressNumber * 4)
          IpAddress = PeekL(*host\h_addr_list  + AdressNumber * 4)
          ResultIP = StrU(PeekB(IpAddress),0)+"."+StrU(PeekB(IpAddress+1),0)+"."+StrU(PeekB(IpAddress+2),0)+"."+StrU(PeekB(IpAddress+3),0)
          AdressNumber + 1
        Wend
      EndIf
      WSACleanup_() ; Close Windows sockets stuff...
    EndIf
    ProcedureReturn ResultIP
  EndIf
EndProcedure

ProcedureDLL Ping(sIPAdress.s,TimeOut=500)
  ;/ Renvoie le temps en ms
  ;/ Renvoie -1 si hôte inaccessible
  ;/ Renvoie -2 si la résolution du nom de l'hôte en adresse Ip a échouée
 
  message.s="PING from PureBasic"
 
  ResultSize.l = SizeOf(ICMP_ECHO_REPLY) + Len(message)
  *Result = AllocateMemory(ResultSize)
  *Echo.ICMP_ECHO_REPLY = *Result
 
  If Len(sIPAdress ) > 0
    hFile.l = IcmpCreateFile_()
    IpAddress.l=MakeIPAddress(Val(StringField(sIPAdress,1,".")),Val(StringField(sIPAdress,2,".")),Val(StringField(sIPAdress,3,".")),Val(StringField(sIPAdress,4,"."))) 
    If IPAdresse = 0
      sIPAdress = HostnameToIP(sIPAdress)
      IpAddress.l=MakeIPAddress(Val(StringField(sIPAdress,1,".")),Val(StringField(sIPAdress,2,".")),Val(StringField(sIPAdress,3,".")),Val(StringField(sIPAdress,4,".")))
    EndIf
    If IpAddress > 0
     
      If IcmpSendEcho_(hFile, IpAddress, message, Len(message), 0, *Result, ResultSize, TimeOut) > 0                               
        ; PrintN("Ping " + sIPAdress + " Octets: " + Str(*Echo\DataSize) + " Temps: " + Str(*Echo\RoundTripTime) + " ms TTL:" + StrU(*Echo\Options\Ttl,#Byte))
      Else
        ;/ Hôte inaccessible
        FreeMemory(*Result)
        ProcedureReturn -1
      EndIf
     
      IcmpCloseHandle_(hFile)
    Else
      ;/ Nom d'hôte introuvable / inrésolvable
      FreeMemory(*Result)
      ProcedureReturn -2
    EndIf
  EndIf
  FreeMemory(*Result)
 
  ;/ Définition variables partagées
  PingTTL=*Echo\Options\Ttl & $000000FF ;/ Car résultat sur un octet
 
  ProcedureReturn *Echo\RoundTripTime
EndProcedure

Temps=Ping("www.voila.fr")

Select Temps
  Case -2
    MessageRequester("Ping","Echec résolution de noms")
  Case -1
    MessageRequester("Ping","Hôte injoignable")
  Default
    MessageRequester("Ping",Str(Temps)+" ms")
EndSelect

[Andre]

nur mal ne Frage:
wann gibts Version 4 zum runterladen (gezipt, oder so) ?

... diese Frage dürfte sich heute nun geklärt haben.

Siehe die Ankündigung: CodeArchiv v4 Beta veröffentlicht!


In diesem Thread sind natürlich trotzdem weiterhin Beiträge mit neuen oder aktualisierten Codes willkommen! Siehe dazu auch die Liste: http://www.purearea.net/temp/CodeArchiv ... nvert.html