How to get the date & time of the last boot / reboot / restart on Windows 2008/2003 machine?
I know from command prompt we can use "net statistics", but how to do it via Delphi?
Thanks.
You can use the LastBootUpTime property of the Win32_OperatingSystem WMI Class, which return the Date and time the operating system was last restarted (Note : the returned value of this property is in UTC format).
Check this sample app
{$APPTYPE CONSOLE}
uses
SysUtils,
ActiveX,
Variants,
ComObj;
//Universal Time (UTC) format of YYYYMMDDHHMMSS.MMMMMM(+-)OOO.
//20091231000000.000000+000
function UtcToDateTime(const V : OleVariant): TDateTime;
var
Dt : OleVariant;
begin
Result:=0;
if VarIsNull(V) then exit;
Dt:=CreateOleObject('WbemScripting.SWbemDateTime');
Dt.Value := V;
Result:=Dt.GetVarDate;
end;
procedure GetWin32_OperatingSystemInfo;
const
WbemUser ='';
WbemPassword ='';
WbemComputer ='localhost';
wbemFlagForwardOnly = $00000020;
var
FSWbemLocator : OLEVariant;
FWMIService : OLEVariant;
FWbemObjectSet: OLEVariant;
FWbemObject : OLEVariant;
oEnum : IEnumvariant;
iValue : LongWord;
begin;
FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
FWMIService := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_OperatingSystem','WQL',wbemFlagForwardOnly);
oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
if oEnum.Next(1, FWbemObject, iValue) = 0 then
begin
Writeln(Format('Last BootUp Time %s',[FWbemObject.LastBootUpTime]));// In utc format
Writeln(Format('Last BootUp Time %s',[formatDateTime('dd-mm-yyyy hh:nn:ss',UtcToDateTime(FWbemObject.LastBootUpTime))]));// Datetime
end;
end;
begin
try
CoInitialize(nil);
try
GetWin32_OperatingSystemInfo;
finally
CoUninitialize;
end;
except
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.
Here is a complete command line application that does what you are talking about.
I've modified this to avoid the GetTickCount overflow issues without relying on external function calls.
Example output:
Windows was last rebooted at: 06/29/2011 9:22:47 AM
Have fun!
program lastboottime;
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows;
function UptimeInDays: double;
const
c_SecondsInADay = 86400;
var
cnt, freq: Int64;
begin
QueryPerformanceCounter(cnt);
QueryPerformanceFrequency(freq);
Result := (cnt / freq) / c_SecondsInADay;
end;
function LastBootTime: TDateTime;
begin
Result := Now() - UptimeInDays;
end;
begin
try
WriteLn('Windows was last rebooted at: ' + DateTimeToStr(LastBootTime));
ReadLn;
except on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Here's a bit of code that uses GetTickCount64 if available and falls back to GetTickCount if unavailable to compute the date and time of system startup. This is not a perfect solution because GetTickCount64 is only supported on Vista+ : if you're on older Windows, the counter goes back to 0 every 49 days.
program Project29;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows;
type
TGetTickCount64 = function : Int64; stdcall;
var
H_K32: HMODULE;
Tick64Proc: TGetTickCount64;
function BootTime: TDateTime;
var UpTime: Int64;
Seconds, Minutes, Hours: Int64;
begin
if H_K32 = 0 then
begin
H_K32 := LoadLibrary(kernel32);
if H_K32 = 0 then
RaiseLastOSError
else
begin
Tick64Proc := GetProcAddress(H_K32, 'GetTickCount64');
end;
end;
if Assigned(Tick64Proc) then
UpTime := Tick64Proc
else
UpTime := GetTickCount;
Result := Now - EncodeTime(0, 0, 0, 1) * UpTime;
end;
begin
WriteLn(DateTimeToStr(BootTime));
ReadLn;
end.
The GetTickCount function (see MSDN) returns the number of milliseconds that have elapsed since the system was started, so divide it with 1000 to get seconds, with 60 000 to get minutes etc.
The topic I linked also contains this bit:
To obtain the time elapsed since the computer was started, retrieve the System Up Time counter in the performance data in the registry key HKEY_PERFORMANCE_DATA. The value returned is an 8-byte value. For more information, see Performance Counters.
Related
I need to recognize and fire an event when a file is going to be executed or run by an application. I know I can do it by hooking windows procedures, but I don't know what procedure or event of windows fires.
For example, when an autorun file going to execute, my application should recognize it, Like an antivirus application.
I'm not sure that hooking is useful for my purpose, if solution isn't hooking, please give me a true solution.
try using the PsSetCreateProcessNotifyRoutine, this function adds a driver-supplied callback routine to, or removes it from, a list of routines to be called whenever a process is created or deleted.
you can find a very nice sample int this link written in c++
Detecting Windows NT/2K process execution
UPDATE
Another option is use the WMI events, check the Win32_Process class, the ExecNotificationQuery method and the SWbemEventSource.NextEvent function.
Check this sample tested in delphi 7 and Windows 7, you must run this application from outside of the Delphi IDE or disable the exception notification for the EOleException exception (check this link), to avoid the EOleException wich is intercepted by the IDE.
program GetWMI_InstanceCreationEvent;
{$APPTYPE CONSOLE}
uses
SysUtils
,Windows
,ComObj
,ActiveX
,Variants;
Function KeyPressed:boolean; //detect if an key is pressed
var
NumEvents : DWORD;
ir : _INPUT_RECORD;
bufcount : DWORD;
StdIn : THandle;
begin
Result:=false;
StdIn := GetStdHandle(STD_INPUT_HANDLE);
NumEvents:=0;
GetNumberOfConsoleInputEvents(StdIn,NumEvents);
if NumEvents<> 0 then
begin
PeekConsoleInput(StdIn,ir,1,bufcount);
if bufcount <> 0 then
begin
if ir.EventType = KEY_EVENT then
begin
if ir.Event.KeyEvent.bKeyDown then
result:=true
else
FlushConsoleInputBuffer(StdIn);
end
else
FlushConsoleInputBuffer(StdIn);
end;
end;
end;
function VarStrNUll(VarStr:OleVariant):string;//dummy function to handle null variants
begin
Result:='';
if not VarIsNull(VarStr) then
Result:=VarToStr(VarStr);
end;
function GetWMIObject(const objectName: String): IDispatch; //create a wmi object instance
var
chEaten: Integer;
BindCtx: IBindCtx;
Moniker: IMoniker;
begin
OleCheck(CreateBindCtx(0, bindCtx));
OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));
OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));
end;
Procedure GetWin32_InstanceCreationEvent;
var
objWMIService : OLEVariant;
colMonitoredProcesses : OLEVariant;
objLatestProcess : OLEVariant;
begin
objWMIService := GetWMIObject('winmgmts:\\localhost\root\cimv2');
colMonitoredProcesses := objWMIService.ExecNotificationQuery('Select * From __InstanceCreationEvent Within 1 Where TargetInstance ISA ''Win32_Process'''); //Get the event listener
while not KeyPressed do
begin
try
objLatestProcess := colMonitoredProcesses.NextEvent(100);//set the max time to wait (ms)
except
on E:EOleException do
if EOleException(E).ErrorCode=HRESULT($80043001) then //Check for the timeout error wbemErrTimedOut 0x80043001
objLatestProcess:=Null
else
raise;
end;
if not VarIsNull(objLatestProcess) then
begin
Writeln('Process Started '+VarStrNUll(objLatestProcess.TargetInstance.Name));
Writeln('CommandLine '+VarStrNUll(objLatestProcess.TargetInstance.CommandLine));
Writeln('PID '+VarStrNUll(objLatestProcess.TargetInstance.ProcessID));
end;
end;
end;
begin
try
CoInitialize(nil);
try
Writeln('Press Any key to exit');
GetWin32_InstanceCreationEvent;
finally
CoUninitialize;
end;
except
on E:Exception do
Begin
Writeln(E.Classname, ': ', E.Message);
Readln;
End;
end;
end.
I use a code library that contains a function to calculate the amount of memory avaliable.
For hosted PC's (hosted by Windows 2008 R2 x64) I sometimes see the free amount calculated in a funny way.
It gets reported as
physical memory : 1400/1400 MB (free/total)
Which cant really be true, since several applications are running. How can that happen?
My interest here is whether this phenomenon points to a memory problem. Sometimes my application runs out of memory when hosted on a VM with limited memory like 1400 MB. So when I see a bug report with the available meory wrongly reported as 1400 MB could it be that it really is zero?
Here is the code
function GetMemoryStatus : UnicodeString;
type
TMemoryStatusEx = record
dwLength : dword;
dwMemoryLoad : dword;
ullTotalPhys : int64;
ullAvailPhys : int64;
ullTotalPageFile : int64;
ullAvailPageFile : int64;
ullTotalVirtual : int64;
ullAvailVirtual : int64;
ullAvailExtendedVirtual : int64;
end;
var gmse : function (var mse: TMemoryStatusEx) : bool; stdcall;
ms : TMemoryStatus;
mse : TMemoryStatusEx;
begin
gmse := GetProcAddress(GetModuleHandle(kernel32), 'GlobalMemoryStatusEx');
if #gmse <> nil then begin
mse.dwLength := sizeOf(mse);
gmse(mse);
end else begin
ms.dwLength := sizeOf(ms);
GlobalMemoryStatus(ms);
mse.ullAvailPhys := ms.dwAvailPhys;
mse.ullTotalPhys := ms.dwTotalPhys;
end;
result := IntToStrExW((mse.ullAvailPhys + $80000) div $100000) + '/' +
IntToStrExW((mse.ullTotalPhys + $80000) div $100000) + ' MB (free/total)';
end;
Thanks!
Jacob
I can't reproduce your problem. The only difference is some changes to the calculations you're doing in the Result line, because I don't have MadExcept on the system I'm on right now (will rectify that soon). Here's the code I used:
type
TMemoryStatusEx = record
dwLength : dword;
dwMemoryLoad : dword;
ullTotalPhys : int64;
ullAvailPhys : int64;
ullTotalPageFile : int64;
ullAvailPageFile : int64;
ullTotalVirtual : int64;
ullAvailVirtual : int64;
ullAvailExtendedVirtual : int64;
end;
type
TGlobalMemoryStatusEx = function (var mse: TMemoryStatusEx) : bool; stdcall;
function GetMemoryStatus : string;
var
GlobalMemoryStatusEX: TGlobalMemoryStatusEx;
MemStatEx : TMemoryStatusEx;
begin
GlobalMemoryStatusEx := GetProcAddress(GetModuleHandle(kernel32),
'GlobalMemoryStatusEx');
if #GlobalMemoryStatusEx <> nil then
begin
MemStatEx.dwLength := sizeOf(MemStatEx);
GlobalMemoryStatusEx(MemStatEx);
Result := Format('%d / %d KB (free/total), ',
[MemStatEx.ullAvailPhys div 1024,
MemStatEx.ullTotalPhys div 1024 ]);
end;
end;
procedure TForm3.FormShow(Sender: TObject);
begin
Label1.Caption := GetMemoryStatus;
end;
Here's the output of the app (with Task Manager's Physical Memory pane beneath it for comparison), running in a Windows XP Mode virtual machine on Windows 7. The VM was set up with 1GB of RAM, and has this test app, Task Manager, and a single Windows Explorer instance running. (The app was written in D2007 on Win 7 64-bit, and then copied/pasted into the VM and started by double-clicking in Explorer.)
I am trying to get the same Created, Accessed and Modified dates as appears in the windows properties as in:
But am finding the times are consistently 30 minutes out:
Believe it may have something to do with timezones/daylight savings but have been unable to find a solution. Have tried looking at:
TimeZone Bias and adjusting and looking at different methods including:
How to get create/last modified dates of a file in Delphi?
Current code:
var
MyFd TWin32FindData;
FName: string;
MyTime: TFileTime;
MySysTime: TSystemTime;
myDate, CreateTime, AccessTime, ModTime: TDateTime;
Begin
...
FindFirstFile(PChar(FName), MyFd);
MyTime:=MyFd.ftCreationTime;
FileTimeToSystemTime(MyTime, MySysTime);
myDate := EncodeDateTime(MySysTime.wYear, MySysTime.wMonth, MySysTime.wDay, MySysTime.wHour,
MySysTime.wMinute, MySysTime.wSecond, MySysTime.wMilliseconds);
Memo1.Lines.Add('Created: '+ FormatDateTime('dddd, d mmmm yyyy, hh:mm:ss ampm', MyDate));
...
Any help appreciated
Thanks
Paul
I'm not sure what's wrong with your current code, but I believe this code will do what you need, using standard Windows API calls.
procedure TMyForm.ReportFileTimes(const FileName: string);
procedure ReportTime(const Name: string; const FileTime: TFileTime);
var
SystemTime, LocalTime: TSystemTime;
begin
if not FileTimeToSystemTime(FileTime, SystemTime) then
RaiseLastOSError;
if not SystemTimeToTzSpecificLocalTime(nil, SystemTime, LocalTime) then
RaiseLastOSError;
Memo1.Lines.Add(Name + ': ' + DateTimeToStr(SystemTimeToDateTime(LocalTime)));
end;
var
fad: TWin32FileAttributeData;
begin
if not GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, #fad) then
RaiseLastOSError;
Memo1.Clear;
Memo1.Lines.Add(FileName);
ReportTime('Created', fad.ftCreationTime);
ReportTime('Modified', fad.ftLastWriteTime);
ReportTime('Accessed', fad.ftLastAccessTime);
end;
procedure TMyForm.Button1Click(Sender: TObject);
begin
ReportFileTimes(Edit1.Text);
end;
You should be able to use the code below to transform a UTC date time value to a local date time vale:
uses
Windows;
function UTCTimeToLocalTime(const aValue: TDateTime): TDateTime;
var
lBias: Integer;
lTZI: TTimeZoneInformation;
begin
lBias := 0;
case GetTimeZoneInformation(lTZI) of
TIME_ZONE_ID_UNKNOWN:
lBias := lTZI.Bias;
TIME_ZONE_ID_DAYLIGHT:
lBias := lTZI.Bias + lTZI.DaylightBias;
TIME_ZONE_ID_STANDARD:
lBias := lTZI.Bias + lTZI.StandardBias;
end;
// UTC = local time + bias
// bias is in number of minutes, TDateTime is in days
Result := aValue - (lBias / (24 * 60));
end;
Judging from your images your offset is actually 10 hours and 30 minutes. Are you located in South Australia?
I need to recognize and fire an event when a file is going to be executed or run by an application. I know I can do it by hooking windows procedures, but I don't know what procedure or event of windows fires.
For example, when an autorun file going to execute, my application should recognize it, Like an antivirus application.
I'm not sure that hooking is useful for my purpose, if solution isn't hooking, please give me a true solution.
try using the PsSetCreateProcessNotifyRoutine, this function adds a driver-supplied callback routine to, or removes it from, a list of routines to be called whenever a process is created or deleted.
you can find a very nice sample int this link written in c++
Detecting Windows NT/2K process execution
UPDATE
Another option is use the WMI events, check the Win32_Process class, the ExecNotificationQuery method and the SWbemEventSource.NextEvent function.
Check this sample tested in delphi 7 and Windows 7, you must run this application from outside of the Delphi IDE or disable the exception notification for the EOleException exception (check this link), to avoid the EOleException wich is intercepted by the IDE.
program GetWMI_InstanceCreationEvent;
{$APPTYPE CONSOLE}
uses
SysUtils
,Windows
,ComObj
,ActiveX
,Variants;
Function KeyPressed:boolean; //detect if an key is pressed
var
NumEvents : DWORD;
ir : _INPUT_RECORD;
bufcount : DWORD;
StdIn : THandle;
begin
Result:=false;
StdIn := GetStdHandle(STD_INPUT_HANDLE);
NumEvents:=0;
GetNumberOfConsoleInputEvents(StdIn,NumEvents);
if NumEvents<> 0 then
begin
PeekConsoleInput(StdIn,ir,1,bufcount);
if bufcount <> 0 then
begin
if ir.EventType = KEY_EVENT then
begin
if ir.Event.KeyEvent.bKeyDown then
result:=true
else
FlushConsoleInputBuffer(StdIn);
end
else
FlushConsoleInputBuffer(StdIn);
end;
end;
end;
function VarStrNUll(VarStr:OleVariant):string;//dummy function to handle null variants
begin
Result:='';
if not VarIsNull(VarStr) then
Result:=VarToStr(VarStr);
end;
function GetWMIObject(const objectName: String): IDispatch; //create a wmi object instance
var
chEaten: Integer;
BindCtx: IBindCtx;
Moniker: IMoniker;
begin
OleCheck(CreateBindCtx(0, bindCtx));
OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));
OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));
end;
Procedure GetWin32_InstanceCreationEvent;
var
objWMIService : OLEVariant;
colMonitoredProcesses : OLEVariant;
objLatestProcess : OLEVariant;
begin
objWMIService := GetWMIObject('winmgmts:\\localhost\root\cimv2');
colMonitoredProcesses := objWMIService.ExecNotificationQuery('Select * From __InstanceCreationEvent Within 1 Where TargetInstance ISA ''Win32_Process'''); //Get the event listener
while not KeyPressed do
begin
try
objLatestProcess := colMonitoredProcesses.NextEvent(100);//set the max time to wait (ms)
except
on E:EOleException do
if EOleException(E).ErrorCode=HRESULT($80043001) then //Check for the timeout error wbemErrTimedOut 0x80043001
objLatestProcess:=Null
else
raise;
end;
if not VarIsNull(objLatestProcess) then
begin
Writeln('Process Started '+VarStrNUll(objLatestProcess.TargetInstance.Name));
Writeln('CommandLine '+VarStrNUll(objLatestProcess.TargetInstance.CommandLine));
Writeln('PID '+VarStrNUll(objLatestProcess.TargetInstance.ProcessID));
end;
end;
end;
begin
try
CoInitialize(nil);
try
Writeln('Press Any key to exit');
GetWin32_InstanceCreationEvent;
finally
CoUninitialize;
end;
except
on E:Exception do
Begin
Writeln(E.Classname, ': ', E.Message);
Readln;
End;
end;
end.
This question already has answers here:
Closed 12 years ago.
Possible Duplicates:
Getting Machine’s MAC Address — Good Solution?
How do I get the MAC address of a network card using Delphi?
I am using MAC address as hardware id for protection(ofcourse I have encrypted this data)
I am using below code to get MAC address on user computer
function MacAddress: string;
var
Lib: Cardinal;
Func: function(GUID: PGUID): Longint; stdcall;
GUID1, GUID2: TGUID;
begin
Result := '';
Lib := LoadLibrary('rpcrt4.dll');
if Lib <> 0 then
begin
#Func := GetProcAddress(Lib, 'UuidCreateSequential');
if Assigned(Func) then
begin
if (Func(#GUID1) = 0) and
(Func(#GUID2) = 0) and
(GUID1.D4[2] = GUID2.D4[2]) and
(GUID1.D4[3] = GUID2.D4[3]) and
(GUID1.D4[4] = GUID2.D4[4]) and
(GUID1.D4[5] = GUID2.D4[5]) and
(GUID1.D4[6] = GUID2.D4[6]) and
(GUID1.D4[7] = GUID2.D4[7]) then
begin
Result :=
IntToHex(GUID1.D4[2], 2) + '-' +
IntToHex(GUID1.D4[3], 2) + '-' +
IntToHex(GUID1.D4[4], 2) + '-' +
IntToHex(GUID1.D4[5], 2) + '-' +
IntToHex(GUID1.D4[6], 2) + '-' +
IntToHex(GUID1.D4[7], 2);
end;
end;
end;
end;
above code works perfectly on windows XP
but its giving different values in windows7 ,the value changing every time after computer resratred :(
is there any chance of getting MAC address thats constant (unless user changed his MAC address)
or is there any good code which retrvies constant data on all OS ?
thanks in advance
#steve0, to retrieve the mac address of an Network Adapter you can use the WMI and the Win32_NetworkAdapterConfiguration Class and check the MACAddress property.
Check this code:
program WMI_MAC;
{$APPTYPE CONSOLE}
uses
SysUtils
,ActiveX
,ComObj
,Variants;
function VarToStrNil(Value:Variant):string; //Dummy function to onvert an variant value to string
begin
if VarIsNull(Value) then
Result:=''
else
Result:=VarToStr(Value);
end;
Procedure GetMacAddress;
var
objWMIService : OLEVariant;
colItems : OLEVariant;
colItem : OLEVariant;
oEnum : IEnumvariant;
iValue : LongWord;
wmiHost, root, wmiClass: string;
function GetWMIObject(const objectName: String): IDispatch;
var
chEaten: Integer;
BindCtx: IBindCtx;//for access to a bind context
Moniker: IMoniker;//Enables you to use a moniker object
begin
OleCheck(CreateBindCtx(0, bindCtx));
OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));//Converts a string into a moniker that identifies the object named by the string
OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));//Binds to the specified object
end;
begin
wmiHost := '.';
root := 'root\CIMV2';
wmiClass := 'Win32_NetworkAdapterConfiguration';
objWMIService := GetWMIObject(Format('winmgmts:\\%s\%s',[wmiHost,root]));
colItems := objWMIService.ExecQuery(Format('SELECT * FROM %s',[wmiClass]),'WQL',0);
oEnum := IUnknown(colItems._NewEnum) as IEnumVariant;
while oEnum.Next(1, colItem, iValue) = 0 do
//if VarToStrNil(colItem.MACAddress)<>'' then //uncomment if you only want list the interfaces with mac adress
//if colItem.IPEnabled then // uncomment if you only want list the active interfaces
begin
WriteLn('Card Description '+VarToStrNil(colItem.Caption));
WriteLn('MACAddress '+VarToStrNil(colItem.MACAddress));
end;
end;
begin
try
CoInitialize(nil);
try
GetMacAddress;
Readln;
finally
CoUninitialize;
end;
except
on E:Exception do
Begin
Writeln(E.Classname, ': ', E.Message);
Readln;
End;
end;
end.
Here is some code working well for any computer on your network - may try it to get your own, using '127.0.0.1' as IP:
function GetRemoteMacAddress(const IP: AnsiString): TSockData;
// implements http://msdn.microsoft.com/en-us/library/aa366358(VS.85).aspx
type
TSendARP = function(DestIp: DWORD; srcIP: DWORD; pMacAddr: pointer; PhyAddrLen: Pointer): DWORD; stdcall;
const
HexChars: array[0..15] of AnsiChar = '0123456789ABCDEF';
var dwRemoteIP: DWORD;
PhyAddrLen: Longword;
pMacAddr : array [0..7] of byte;
I: integer;
P: PAnsiChar;
SendARPLibHandle: THandle;
SendARP: TSendARP;
begin
result := '';
SendARPLibHandle := LoadLibrary('iphlpapi.dll');
if SendARPLibHandle<>0 then
try
SendARP := GetProcAddress(SendARPLibHandle,'SendARP');
if #SendARP=nil then
exit; // we are not under 2K or later
dwremoteIP := inet_addr(pointer(IP));
if dwremoteIP<>0 then begin
PhyAddrLen := 8;
if SendARP(dwremoteIP, 0, #pMacAddr, #PhyAddrLen)=NO_ERROR then begin
if PhyAddrLen=6 then begin
SetLength(result,12);
P := pointer(result);
for i := 0 to 5 do begin
P[0] := HexChars[pMacAddr[i] shr 4];
P[1] := HexChars[pMacAddr[i] and $F];
inc(P,2);
end;
end;
end;
end;
finally
FreeLibrary(SendARPLibHandle);
end;
end;
This code is extracted from our freeware and open source framework, unit SynCrtSock.pas. See http://synopse.info/fossil