On linux endtime return results 0. It should be return number in miliseconds for given sleep function. On label on GUI it shows 0.
Here is code:
var starttime: longint;
var endtime: longint;
function GetTickCount : DWORD;
begin
{$IFDEF MSWINDOWS}
Result := Windows.GetTickCount mod High(LongInt);
{$ELSE}
Result := GetTickCount mod High(LongInt);
{$ENDIF}
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
starttime:=getTickCount;
// something do...
Sleep(1500); // sleep in miliseconds, works!
endtime:=getTickCount-starttime;
Label1.Caption:=inttostr(endtime); // returns 0 ?
end;
The gettickcount in the {$else} of the gettickcount function is interpreted as the return value of a procedure. (result in Delphi)
Depending on mode, this might lead to eternal recursion
Solution: just like in the windows case, qualify with unitname so
{$else}
Result := SysUtils.GetTickCount mod High(LongInt);
Related
When pressing Ctrl-c there is almost always additional output. I'd like to ensure that after receiving the Ctrl-c the program doesn't show anything other than possibly "^C".
I found what is mostly the same question but, it was for Linux and my attempts to "port" the solution from Linux to Windows have not succeeded.
At this point, I'm out of things to try and can use some help, which I will definitely appreciate. Thank you.
The short example program below suffers from that problem.
{$APPTYPE CONSOLE}
program _SetConsoleCtrlHandler;
uses
Windows,
SysUtils
;
function CtrlHandler(CtrlType : DWORD) : BOOL; stdcall;
begin
result := FALSE;
case CtrlType of
CTRL_C_EVENT,
CTRL_BREAK_EVENT:
begin
result := TRUE;
ExitProcess(7);
end;
end;
end;
var
s : shortstring;
begin
SetConsoleCtrlHandler(#CtrlHandler, TRUE);
while TRUE do
begin
write('press <ctrl-c> to end this program : ');
readln(s);
end;
end.
The way I usually do this is to have a separate unit that is signaled and a simple wait, like the following. In the main console project you call WaitForCtrlC instead of Readln(). You could also use a TEvent and wait on the event instead of looping, like I show in this example:
uses
{$IFDEF LINUX}
Posix.Signal,
{$ENDIF}
{$IFDEF MSWINDOWS}
Windows,
{$ENDIF}
SysUtils;
procedure WaitForCtrlC;
implementation
var
Control_C: Boolean = False;
{$IFDEF MSWINDOWS}
function ConsoleCtrlHandler(dwCtrlType: DWORD): BOOL; stdcall;
begin
if (dwCtrlType = CTRL_C_EVENT) then
Control_C := True;
Result := True;
end;
{$ENDIF}
{$IFDEF LINUX}
var
sigIntHandler: sigaction_t;
procedure SigHandler(SigNum: Integer); cdecl;
begin
Control_C := True;
end;
{$ENDIF}
procedure WaitForCtrlC;
begin
while not Control_C do
Sleep(25);
end;
initialization
{$IFDEF MSWINDOWS}
Windows.SetConsoleCtrlHandler(#ConsoleCtrlHandler, True);
{$ENDIF}
{$IFDEF LINUX}
sigIntHandler._u.sa_handler := #SigHandler;
sigemptyset(sigIntHandler.sa_mask);
sigIntHandler.sa_flags := 0;
sigaction(SIGINT, #sigIntHandler, nil);
{$ENDIF}
I have some code which uses EnumFontFamiliesEX to determine whether a particular font (using its "facename") is installed. The code was working fine in 32-bit. When I compile and run it as 64-bit, it kept throwing an exception in the callback routine.
I have now gotten it to work under both BUT only if instead of passing the function FindFontbyFaceName's result as the 4th parameter to EnumFontFamiliesEX, I pass a local (or global) variable - MYresult in this case. (And then set result from it). I don't understand what is going on? Can anyone explain or point me to a better way. (I'm not so much interested in the mechanics of the fonts, as the basic callback mechanics).
// single font find callback
function FindFontFace( {$IFDEF CPUX86} lpelf: PLogFont; {$ENDIF}
{$IFDEF CPUX64} lpelf: PEnumLogFontEx; {$ENDIF}
lpntm: PNewTextMetricEx;
AFontType: DWORD; var Aresult: lparam): integer ; stdcall;
begin
result := 0; // 1 shot only please - not interested in any variations in style etc
if (lpelf <> nil) then
Aresult := -1 // TRUE
else
Aresult := 0;
end;
function FindFontbyFaceName(ACanvas: TCanvas; const AFacename: string): boolean;
var
lf: TLogFont;
Myresult: boolean;
begin
MYresult := false;
FillChar(lf, SizeOf(lf), 0);
StrLCopy(lf.lfFaceName, PChar(AFacename), 32);
lf.lfCharSet := DEFAULT_CHARSET;
// this works in both 32 and 64 bit
EnumFontFamiliesEX(ACanvas.Handle, lf, #FindFontFace, lparam(#MYresult), 0);
result := MYresult;
// this works in 32 bit but throws exception in callback in 64 bit
// EnumFontFamiliesEX(ACanvas.Handle, lf, #FindFontFace, lparam(#result), 0);
end;
function FindFont(const AFacename: string): boolean;
var
AImage: TImage;
begin
AImage := Timage.Create(nil);
try
result := FindFontbyFaceName(AImage.Canvas, Afacename);
finally
Aimage.Free;
end;
end;
Your callback function is not declared correctly. You are declaring the last parameter as a var LPARAM, which is wrong. The lParam parameter is passed by value, not by reference. When calling EnumFontFamiliesEx() you are passing a pointer to a Boolean as the lParam value.
Your callback is trying to write sizeof(LPARAM) number of bytes to a memory address that only has SizeOf(Boolean) bytes available (and why are you trying to write a -1 to a Boolean?). So you are overwriting memory. When using a pointer to a local variable as the lParam, you are likely just overwriting memory on the calling function's call stack that does not really matter, so you don't see a crash.
You need to either:
remove the var and typecast the lParam parameter to a PBoolean:
function FindFontFace( lpelf: PLogFont;
lpntm: PTextMetric;
FontType: DWORD;
lParam: LPARAM): Integer ; stdcall;
begin
PBoolean(lParam)^ := True;
Result := 0; // 1 shot only please - not interested in any variations in style etc
end;
Or:
function FindFontFace( lpelf: PLogFont;
lpntm: PTextMetric;
FontType: DWORD;
lParam: PBoolean): Integer ; stdcall;
begin
lParam^ := True;
Result := 0; // 1 shot only please - not interested in any variations in style etc
end;
leave the var but change the parameter type to Boolean instead of LPARAM:
function FindFontFace( var lpelf: TLogFont;
var lpntm: TTextMetric;
FontType: DWORD;
var lParam: Boolean): Integer ; stdcall;
begin
lParam := True;
Result := 0; // 1 shot only please - not interested in any variations in style etc
end;
Either approach will allow you to pass #Result as the lParam to EnumFontFamiliesEx() in both 32bit and 64bit:
function FindFontbyFaceName(ACanvas: TCanvas; const AFacename: string): Boolean;
var
lf: TLogFont;
begin
Result := False;
FillChar(lf, SizeOf(lf), 0);
StrLCopy(lf.lfFaceName, PChar(AFacename), 32);
lf.lfCharSet := DEFAULT_CHARSET;
EnumFontFamiliesEX(ACanvas.Handle, lf, #FindFontFace, LPARAM(#Result), 0);
end;
On a side note, creating a TImage just to have a canvas to enumerate with is wasteful. You don't need it at all:
function FindFontFace( lpelf: PLogFont;
lpntm: PTextMetric;
FontType: DWORD;
lParam: LPARAM): integer ; stdcall;
begin
PBoolean(lParam)^ := True;
Result := 0; // 1 shot only please - not interested in any variations in style etc
end;
function FindFont(const AFacename: string): Boolean;
var
lf: TLogFont;
DC: HDC;
begin
Result := False;
FillChar(lf, SizeOf(lf), 0);
StrLCopy(lf.lfFaceName, PChar(AFacename), 32);
lf.lfCharSet := DEFAULT_CHARSET;
DC := GetDC(0);
EnumFontFamiliesEx(DC, lf, #FindFontFace, LPARAM(#Result), 0);
ReleaseDC(0, DC);
end;
That being said, you can simplify the code if you use the TScreen.Fonts property instead of calling EnumFontFamiliesEx() directly:
function FindFont(const AFacename: string): Boolean;
begin
Result := (Screen.Fonts.IndexOf(AFacename) <> -1);
end;
I would like to have a single neat (close and self contained) function (let's call it GetDesktopHandle) that returns a handle to the Desktop window. I use the code below. But it only works in the DeskHandle is a global var.
How to get rid of this global variable? If I make it local I get an AV in getDesktopWnd when I try to DeskHandle := hChild
VAR DeskHandle : HWND;
function GetDesktopHandle: HWND;
function getDesktopWnd (Handle: HWND; NotUsed: Longint): bool; stdcall; { Callback function }
VAR hChild : HWND;
begin
if handle <> 0 then
begin
hChild := FindWindowEx(handle, 0, 'SHELLDLL_DefView', nil);
if hChild <> 0 then
begin
hChild := FindWindowEx(hChild, 0, 'SysListView32', nil);
if hChild <> 0
then DeskHandle := hChild;
end;
end;
Result:= TRUE;
end;
begin
DeskHandle := 0;
EnumWindows(#getDesktopWnd, 0);
Result:= DeskHandle;
end;
The main question is: can I write this code as a single function or AT LEAST, can I get rid of the external/global var?
Possible solution:
The documentation says that the second parameter is only a IN parameter.
lParam [in]
Type: LPARAM
An application-defined value to be passed to the callback function.
https://msdn.microsoft.com/en-us/library/windows/desktop/ms633497%28v=vs.85%29.aspx
Would it be wrong to use it to pass the result back?
Local functions cannot be used as callbacks. If you hadn't used the # operator to pass your function, the compiler would have told you that. (Using the operator turns the argument into an ordinary untyped pointer, so the compiler can't check anymore.)
You'll have to make your callback be a standalone function.
To pass data between the callback and the caller, use the second parameter, which you've currently named NotUsed. For example, you could pass a pointer to a handle variable, and then the callback could dereference the pointer to return a result.
type
TMyData = record
Handle: HWND;
Pid: DWORD;
Caption: String;
ClassName: String;
end;
PMyData = ^TMyData;
function GetWindowClass(const Handle: HWND): String;
begin
SetLength(Result, MAX_PATH);
SetLength(Result, GetClassName(Handle, PChar(Result), Length(Result)));
end;
function GetWindowCaption(const Handle: HWND): String;
begin
SetLength(Result, MAX_PATH);
SetLength(Result, GetWindowText(Handle, PChar(Result), Length(Result)));
end;
function EnumChildWindowsProc(Handle: THandle; MyData: PMyData): BOOL; stdcall;
var
ClassName: String;
Caption: String;
Pid: DWORD;
begin
ClassName := GetWindowClass(Handle);
Caption := GetWindowCaption(Handle);
Result := (ClassName = 'SysListView32') and (Caption = 'FolderView');
if Result then
begin
MyData.Handle := Handle;
GetWindowThreadProcessId(Handle, MyData.Pid);
MyData.Caption := Caption;
MyData.ClassName := ClassName;
end;
// To continue enumeration, the callback function must return TRUE;
// to stop enumeration, it must return FALSE
Result := not Result;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
MyData: TMyData;
begin
ZeroMemory(#MyData, SizeOf(MyData));
EnumChildWindows(GetDesktopWindow, #EnumChildWindowsProc, NativeInt(#MyData));
if MyData.Handle > 0 then
begin
ShowMessageFmt('Found Window in Pid %d', [MyData.Pid]);
end
else begin
ShowMessage('Window not found!');
end;
end;
I have prepared simple script that displays image under ProgressGauge bar on wpInstalling Page.
But... I need more complex functionality.
What I need is multiple images show, each after X (e.g. 7) seconds (with loop when installation longer then X secs * number of images) or each after X (e.g. 10) percent of installation. I have tried to embed images display in ProgressGauge.Position, but I failed.
Here is what I have:
procedure CurPageChanged(CurPageID: Integer);
var
BmpFile: TBitmapImage;
begin
ExtractTemporaryFile('01.bmp');
ExtractTemporaryFile('02.bmp');
ExtractTemporaryFile('03.bmp');
if CurPageID = wpInstalling then
begin
BmpFile:= TBitmapImage.Create(WizardForm);
BmpFile.Bitmap.LoadFromFile(ExpandConstant('{tmp}\01.bmp'));
BmpFile.Width:= ScaleX(420);
BmpFile.Height:= ScaleY(180);
BmpFile.Left := WizardForm.ProgressGauge.Left + ScaleX(0);
BmpFile.Top := WizardForm.ProgressGauge.Top + ScaleY(35);
// BmpFile.Parent:= WizardForm.InstallingPage;
// BmpFile:= TBitmapImage.Create(WizardForm);
// BmpFile.Bitmap.LoadFromFile(ExpandConstant('{tmp}\03.bmp'));
// BmpFile.Width:= ScaleX(420);
// BmpFile.Height:= ScaleY(400);
// BmpFile.Left := WizardForm.ProgressGauge.Left + ScaleX(0);
// BmpFile.Top := WizardForm.ProgressGauge.Top + ScaleY(35);
// BmpFile.Parent:= WizardForm.InstallingPage;
// BmpFile:= TBitmapImage.Create(WizardForm);
// BmpFile.Bitmap.LoadFromFile(ExpandConstant('{tmp}\03.bmp'));
// BmpFile.Width:= ScaleX(420);
// BmpFile.Height:= ScaleY(400);
// BmpFile.Left := WizardForm.ProgressGauge.Left + ScaleX(0);
// BmpFile.Top := WizardForm.ProgressGauge.Top + ScaleY(35);
// BmpFile.Parent:= WizardForm.InstallingPage;
end;
end;
The goal is:
On the wpInstalling there should be X images displayed, every next per X seconds or after X percent of installation.
Since the ProgressGauge has no progress change events and there is no way to process setup application messages you will need to use the Windows API timer. This timer needs a callback function which you can't define in Inno Setup script unfortunately so you will need some external library to do this job for you. However there's the InnoCallback library which can do exactly this.
For the following code copy the InnoCallback.dll library into your setup directory, merge this code with your Inno Setup script and implement some kind of a slideshow page turning in the OnSlideTimer event which will be called periodically (with the current settings each second).
[Files]
Source: "InnoCallback.dll"; DestDir: "{tmp}"; Flags: dontcopy
[code]
var
TimerID: Integer;
type
TTimerProc = procedure(Wnd: HWND; Msg: UINT; TimerID: UINT_PTR;
SysTime: DWORD);
function WrapTimerProc(Callback: TTimerProc; ParamCount: Integer): LongWord;
external 'wrapcallback#files:InnoCallback.dll stdcall';
function SetTimer(hWnd: HWND; nIDEvent, uElapse: UINT;
lpTimerFunc: UINT): UINT; external 'SetTimer#user32.dll stdcall';
function KillTimer(hWnd: HWND; uIDEvent: UINT): BOOL;
external 'KillTimer#user32.dll stdcall';
procedure OnSlideTimer(Wnd: HWND; Msg: UINT; TimerID: UINT_PTR;
SysTime: DWORD);
begin
{ here you can turn your slideshow pages; use some variable to store the }
{ current index of the slide you are on, note that this procedure is called }
{ periodically each 1000 ms (see below why), so here you can also check the }
{ progress value, if you want to }
end;
procedure StartSlideTimer;
var
TimerCallback: LongWord;
begin
TimerCallback := WrapTimerProc(#OnSlideTimer, 4);
{ third parameter here is the timer's timeout value in milliseconds }
TimerID := SetTimer(0, 0, 1000, TimerCallback);
end;
procedure KillSlideTimer;
begin
if TimerID <> 0 then
begin
if KillTimer(0, TimerID) then
TimerID := 0;
end;
end;
function InitializeSetup: Boolean;
begin
Result := True;
TimerID := 0;
end;
procedure DeinitializeSetup;
begin
KillSlideTimer;
end;
procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID = wpInstalling then
StartSlideTimer
else
KillSlideTimer;
end;
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.