PureBasic Forums - English

Code: Select all

#PDH_FMT_LARGE=$00000400
#PDH_FMT_1000=$00002000

Structure PDH_FMT_COUNTERVALUE
  CStatus.l
  dummy.l
  StructureUnion
    longValue.l
    doubleValue.d
    largeValue.q
    *AnsiStringValue
    *WideStringValue
  EndStructureUnion
EndStructure

CompilerIf #PB_Compiler_Unicode
  Prototype PdhVbAddCounter(hQuery, CounterPath.p-ascii, *hCounter)
CompilerElse
  Prototype PdhVbAddCounter(hQuery, CounterPath.s, *hCounter)
CompilerEndIf

Prototype PdhGetFormattedCounterValue(hCounter, dwFormat, lpdwType, *Value)
Prototype PdhCollectQueryData(hQuery)
Prototype PdhVbOpenQuery(*hQuery)
Prototype PdhCloseQuery(hQuery)

;/ Uptime is in milliseconds
Procedure GetSystemUptime()
  Protected LibID.i
  Protected Ptr.i
  Protected PDHError.i
  Protected hQuery.i
  Protected hCounter.i
  Protected ElapsedTime.PDH_FMT_COUNTERVALUE
  Protected PdhVbOpenQuery.PdhVbOpenQuery
  Protected PdhVbAddCounter.PdhVbAddCounter
  Protected PdhGetFormattedCounterValue.PdhGetFormattedCounterValue
  Protected PdhCollectQueryData.PdhCollectQueryData
  Protected PdhCloseQuery.PdhCloseQuery
  Protected ElapsedTimeQ.q
  Protected ElapsedTime49.l ;/ Elapsed uptime only accurate up to 49.7 days
  
  ;/ This method is the most accurate but is only supported by Vista and above
  Ptr=GetProcAddress_(GetModuleHandle_("Kernel32.dll"),"GetTickCount64")
  If Ptr
    ProcedureReturn CallFunctionFast(Ptr)
  EndIf
  
  LibID=OpenLibrary(#PB_Any,"pdh.dll")
  
  If Not LibID
    PDHError=#True
  EndIf
  
  If Not PDHError
    PdhVbOpenQuery=GetFunction(LibID,"PdhVbOpenQuery")
    PdhVbAddCounter=GetFunction(LibID,"PdhVbAddCounter")
    PdhGetFormattedCounterValue=GetFunction(LibID,"PdhGetFormattedCounterValue")
    PdhCollectQueryData=GetFunction(LibID,"PdhCollectQueryData")
    PdhCloseQuery=GetFunction(LibID,"PdhCloseQuery")
  EndIf
  
  If Not PdhVbOpenQuery&PdhVbAddCounter&PdhGetFormattedCounterValue&PdhCollectQueryData&PdhCloseQuery
    PDHError=#True
    ProcedureReturn #False
  EndIf
  
  If Not PDHError And PdhVbOpenQuery(@hQuery)
    PDHError=#True
  EndIf
  
  If Not PDHError And PdhVbAddCounter(hQuery,"\System\System Up Time",@hCounter)
    PDHError=#True
  EndIf
  
  If Not PDHError And PdhCollectQueryData(hQuery)
    PDHError=#True
  EndIf
  
  If Not PDHError And PdhGetFormattedCounterValue(hCounter,#PDH_FMT_LARGE|#PDH_FMT_1000,0,@ElapsedTime)
    PDHError=#True
  EndIf
  
  If hQuery
    PdhCloseQuery(hQuery)
  EndIf
  
  If LibID
    CloseLibrary(LibID)
  EndIf
  
  ;/ If the clock has been set backwards such that the uptime would be
  ;/ a negative value, the result will be "0"
  ElapsedTimeQ.q=ElapsedTime\largeValue
  
  ;/ Even though GetTickCount is only valid for up to 49.7 days, it should still be evaluated. On
  ;/ 2000/XP/2003 systems, The performance counter method will fail and return 0 if the system
  ;/ clock has been rolled back to a date from before its startup date where ElapsedTime.q would
  ;/ have been negative. Also on 2000/XP/2003 systems, it will return a future date if the system
  ;/ clock has been adjusted into the future. GetTickCount will still be positive if the
  ;/ performance counter fails, even if it may be wrong. If the performance counter is failing
  ;/ then it is suggestive that the system clock is being manipulated and attempting to calculate
  ;/ uptime is moot anyways.
  Ptr=GetProcAddress_(GetModuleHandle_("Kernel32.dll"),"GetTickCount")
  If Ptr
    ElapsedTime49=CallFunctionFast(Ptr)
    
    If ElapsedTime49>ElapsedTimeQ.q
      ElapsedTimeQ.q=ElapsedTime49
    EndIf
  EndIf
  
  ProcedureReturn ElapsedTimeQ.q
EndProcedure

Code: Select all

---------------------------
PureBasic
---------------------------
Line 8: Structure not found: PDH_FMT_COUNTERVALUE.
---------------------------
OK
---------------------------

Code: Select all

Procedure.s UpTime() ; For XP or higher. Takes a couple of seconds to execute. :(
  p=RunProgram("systeminfo","","",#PB_Program_Hide|#PB_Program_Open|#PB_Program_Read)
  If p
    While ProgramRunning(p) : o$+ReadProgramString(p)+#CRLF$ : Wend : CloseProgram(p)
    up$=Trim(Mid(o$,FindString(o$,"Time:",1)+5)) : up$=Left(up$,FindString(up$,#CRLF$,1)-1)
  EndIf
  ProcedureReturn up$
EndProcedure

Debug UpTime()

Code: Select all

Original Install Date:     11/13/2010, 4:57:02 AM
System Boot Time:          11/13/2010, 6:18:45 PM