Hitta ursprungligt installationsdatum

[Sven^]

Finns det någon API eller något liknande som kan användas för att få fram det ursprungliga installationsdatumet?

 

Det som kommer fram när man skriver systeminfo i kommandotolken...

 

//TheEvilMan

 

[ZilverZtream]

Hittade ingen API till dig som tog fram informationen du sökte (finns säkerligen dock).

Men skapade denna funktion som hämtar informationen ifrån just systeminfo (en commandbutton e allt som behövs):

 

 

Option Explicit

Dim sCommand As String
Dim bProcessing As Boolean                                       'Raised when you can start the reading

Private Declare Function CreatePipe Lib "kernel32" ( _
   phReadPipe As Long, _
   phWritePipe As Long, _
   lpPipeAttributes As Any, _
   ByVal nSize As Long) As Long

Private Declare Function ReadFile Lib "kernel32" ( _
   ByVal hFile As Long, _
   ByVal lpBuffer As String, _
   ByVal nNumberOfBytesToRead As Long, _
   lpNumberOfBytesRead As Long, _
   ByVal lpOverlapped As Any) As Long

Private Type SECURITY_ATTRIBUTES
   nLength As Long
   lpSecurityDescriptor As Long
   bInheritHandle As Long
End Type

Private Type STARTUPINFO
   cb As Long
   lpReserved As Long
   lpDesktop As Long
   lpTitle As Long
   dwX As Long
   dwY As Long
   dwXSize As Long
   dwYSize As Long
   dwXCountChars As Long
   dwYCountChars As Long
   dwFillAttribute As Long
   dwFlags As Long
   wShowWindow As Integer
   cbReserved2 As Integer
   lpReserved2 As Long
   hStdInput As Long
   hStdOutput As Long
   hStdError As Long
End Type

Private Type PROCESS_INFORMATION
   hProcess As Long
   hThread As Long
   dwProcessId As Long
   dwThreadID As Long
End Type

Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
   lpApplicationName As Long, ByVal lpCommandLine As String, _
   lpProcessAttributes As Any, lpThreadAttributes As Any, _
   ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
   ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
   lpStartupInfo As Any, lpProcessInformation As Any) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESTDHANDLES = &H100&
Private Const STARTF_USESHOWWINDOW = &H1
Private Const SW_HIDE = 0

Dim strData As String


Public Function ExecuteApp(sCmdline As String) As String
   Dim proc As PROCESS_INFORMATION, ret As Long
   Dim start As STARTUPINFO
   Dim sa As SECURITY_ATTRIBUTES
   Dim hReadPipe As Long
   Dim hWritePipe As Long
   Dim sOutput As String
   Dim lngBytesRead As Long, sBuffer As String * 256
   bProcessing = True
   sa.nLength = Len(sa)
   sa.bInheritHandle = True

   ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
   If ret = 0 Then
       bProcessing = False
       MsgBox "CreatePipe failed." & vbCrLf & Err.LastDllError
       Exit Function
   End If

   start.cb = Len(start)
   start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
   ' Redirect the standard output and standard error to the same pipe
   start.hStdOutput = hWritePipe
   start.hStdError = hWritePipe
   start.wShowWindow = SW_HIDE


   ret = CreateProcessA(0&, Environ("ComSpec") & " /c " & sCmdline, sa, sa, True, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
   If ret = 0 Then
       bProcessing = False
       MsgBox "CreateProcess failed." & vbCrLf & Err.LastDllError
       Exit Function
   End If

   CloseHandle hWritePipe

   Do
       DoEvents
       ret = ReadFile(hReadPipe, sBuffer, 256, lngBytesRead, 0&)
       sOutput = Left$(sBuffer, lngBytesRead)
       If ret = 0 Then
           strData = strData & Replace(Replace(sOutput, Chr(13), ""), Chr(10), vbNewLine)
           Exit Do
       Else
           strData = strData & Replace(Replace(sOutput, Chr(13), ""), Chr(10), vbNewLine)
       End If
       DoEvents
   Loop While ret <> 0

   CloseHandle proc.hProcess
   CloseHandle proc.hThread
   CloseHandle hReadPipe
   bProcessing = False
End Function

Public Function GetBetween(IStringStr As String, IBefore As String, IPast As String)
   Dim iString As String
   iString = IStringStr
   iString = Right(iString, Len(iString) - InStr(iString, IBefore) - Len(IBefore) + 1)
   iString = Mid(iString, 1, InStr(iString, IPast) - 1)
   GetBetween = iString
End Function

Private Sub Command1_Click()
   strData = ""
   ExecuteApp "systeminfo"
   MsgBox GetBetween(strData, "Original Install Date:     ", vbCrLf)
End Sub