System Uptime in Delphi 2009 - delphi

How can I code to see how long the computer has been on.
Simple examples of code if possible.

You use GetTickCount function see this example.
program Ticks;
{$APPTYPE CONSOLE}
uses
Windows,
SysUtils;
function TicksToStr(Ticks: Cardinal): string; //Convert Ticks to String
var
aDatetime : TDateTime;
begin
aDatetime := Ticks / SecsPerDay / MSecsPerSec;
Result := Format('%d days, %s', [Trunc(aDatetime), FormatDateTime('hh:nn:ss.z', Frac(aDatetime))]) ;
end;
begin
try
Writeln('Time Windows was started '+ TicksToStr(GetTickCount));
Readln;
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
end.
UPDATE
to get the info in other format just must edit this line,
Result := Format('%d days, %d hours %d minutes %d seconds ', [Trunc(aDatetime), HourOf(aDatetime),MinuteOf(aDatetime),SecondOf(aDatetime) ]) ;
and add the unit DateUtils.

Note that GetTickCount isn't really designed for accuracy.
For more reliable timing, use the QueryPerformanceCounter and QueryPerformanceFrequency api calls:
function SysUpTime : TDateTime;
var
Count, Freq : int64;
begin
QueryPerformanceCounter(count);
QueryPerformanceFrequency(Freq);
if (count<> 0) and (Freq <> 0) then
begin
Count := Count div Freq;
Result := Count / SecsPerDay;
end
else
Result := 0;
end;

Related

Fast way to get total line number of a large file

I'm dealing with large text files (bigger than 100MB). I need the total number of lines as fast as possible. I'm currently using the code below (update: added try-finally):
var
SR: TStreamReader;
totallines: int64;
str: string;
begin
SR:=TStreamReader.Create(myfilename, TEncoding.UTF8);
try
totallines:=0;
while not SR.EndOfStream do
begin
str:=SR.ReadLine;
inc(totallines);
end;
finally
SR.Free;
end;
end;
Is there any faster way to get totallines?
Program LineCount;
{$APPTYPE CONSOLE}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
{$SetPEFlags 1}
{ Compile with XE8 or above... }
USES
SysUtils,
BufferedFileStream;
VAR
LineCnt: Int64;
Ch: Char;
BFS: TReadOnlyCachedFileStream;
function Komma(const S: string; const C: Char = ','): string;
{ About 4 times faster than Comma... }
var
I: Integer; // loops through separator position
begin
Result := S;
I := Length(S) - 2;
while I > 1 do
begin
Insert(C, Result, I);
I := I - 3;
end;
end; {Komma}
BEGIN
writeln('LineCount - Copyright (C) 2020 by Walter L. Chester.');
writeln('Counts lines in the given textfile.');
if ParamCount <> 1 then
begin
writeln('USAGE: LineCount <filename>');
writeln;
writeln('No file size limit! Counts lines: takes 4 minutes on a 16GB file.');
Halt;
end;
if not FileExists(ParamStr(1)) then
begin
writeln('File not found!');
halt;
end;
writeln('Counting lines in file...');
BFS := TReadOnlyCachedFileStream.Create(ParamStr(1), fmOpenRead);
try
LineCnt := 0;
while BFS.Read(ch,1) = 1 do
begin
if ch = #13 then
Inc(LineCnt);
if (LineCnt mod 1000000) = 0 then
write('.');
end;
writeln;
writeln('Total Lines: ' + Komma(LineCnt.ToString));
finally
BFS.Free;
end;
END.
The answer is simply: No. Your algorithm is the fastest but the implementation isn't. You must read the whole file and count the lines. At least if lines are not fixed size.
How you read the file may impact the global performance.
Read the file block by block in a binary buffer (Array of bytes) as large as possible. Then count the lines in the buffer and loop with the block in same buffer.

Subtract two TDATETIME variables in Delphi and return the result in minutes

I have two TDateTime variables, like this:
s := StrToDateTime('03/03/2017 10:10:12');
e := StrToDateTime('04/04/2017 10:10:12');
I need to find out the difference between them, in hh:mm:ss format.
The ...Between() functions are not helping me here.
Use the DateUtils.SecondsBetween function:
Uses
DateUtils,SysUtils;
function TimeDiffStr(const s1,s2: String): String;
var
t1,t2: TDateTime;
secs: Int64;
begin
t1 := StrToDateTime(s1);
t2 := StrToDateTime(s2);
secs := SecondsBetween(t1,t2);
Result := Format('%2.2d:%2.2d:%2.2d',[secs div SecsPerHour,(secs div SecsPerMin) mod SecPerMin,secs mod SecsPerMin]);
end;
begin
WriteLn(TimeDiffStr('03/03/2017 10:10:12','04/04/2017 10:10:12'));
ReadLn;
end.
From the number of seconds, calculate the hours,minutes and remaining seconds.
If you want the difference in minutes, use the DateUtils.MinutesBetween function:
function TimeDiffStr(const s1,s2: String): String;
var
t1,t2: TDateTime;
minutes: Int64;
begin
t1 := StrToDateTime(s1);
t2 := StrToDateTime(s2);
minutes := MinutesBetween(t1,t2);
Result := Format('%2.2d:%2.2d:%2.2d',[minutes div MinsPerHour,minutes mod MinsPerHour,0]);
end;
You can use TTimeSpan (from the System.TimeSpan unit).
program Project1;
{$APPTYPE CONSOLE}
uses
System.SysUtils, System.TimeSpan;
var
StartDate, EndDate: TDateTime;
TS: TTimeSpan;
Temp: string;
begin
StartDate := StrToDateTime('03/03/2017 10:10:12');
EndDate := StrToDateTime('04/04/2017 10:10:12');
TS := TTimeSpan.Subtract(EndDate, StartDate);
Temp := TS;
WriteLn(Temp); // Outputs 32.00:00:00
// The next line outputs the same as the one above
WriteLn(Format('%.2d:%.2d:%.2d:%.2d', [TS.Days, TS.Hours, TS.Minutes, TS.Seconds]));
WriteLn(TS.TotalMinutes); // Outputs 4.60800000000000E+0004
WriteLn(Trunc(TS.TotalMinutes)); // Outputs 46080
// This one will give the output you want (768:00:00)
WriteLn(Format('%.2d:%.2d:%.2d', [TS.Days * 24 + TS.Hours, TS.Minutes, TS.Seconds]));
ReadLn;
end.
First off, don't use hard-coded strings for date/time values. That is subject to localization issues, and it is just wasted overhead anyway. Use the SysUtils.EncodeDate() and SysUtils.EncodeTime() functions, or the DateUtils.EncodeDateTime() function.
Second, the ...Between() functions can indeed be usedneed, in particular SecondsBetween(). You can calculate the individual components from that return value.
Try something like this:
uses
..., SysUtils, DateUtils;
var
s, e: TDateTime;
diff: Int64;
days, hours, mins, secs: Integer;
s: string;
begin
s := EncodeDateTime(2017, 3, 3, 10, 10, 12, 0);
e := EncodeDateTime(2017, 4, 4, 10, 10, 12, 0);
diff := SecondsBetween(e, s);
days := diff div SecsPerDay;
diff := diff mod SecsPerDay;
hours := diff div SecsPerHour;
diff := diff mod SecsPerHour;
mins := diff div SecsPerMin;
diff := diff mod SecsPerMin;
secs := diff;
s := Format('%d:%d:%d:%d', [days, hours, mins, secs]);
end;

Delphi Countdown timer

I am trying to make a countdown timer, the idea is to set the time in text edit property and after i click set timer(button), that time to be sent to Label, which will then start the countdown to 0. I have gotten to this part, but i cant figure out a way to make seconds countdown, If any of you guys can help I would appreciate it.
I tried this from an example I found online but it didnt work because this is Firemonkey application.
dec(TotalTime); {decrement the total time counter}
// Timer code..
procedure TForm1.ButtonSetTimerClick(Sender: TObject);
var
GetTime : TDateTime;
begin
Timer3.Enabled := True;
Label11.Text := Edit1.Text;
ButtonSetTimer.Enabled := False;
Edit1.Enabled := False;
GetTime := StrToTime(Edit1.Text);
end;
procedure TForm1.ButtonStopTimerClick(Sender: TObject);
begin
Timer3.Enabled := False;
ButtonSetTimer.Enabled := True;
Edit1.Enabled := True;
end;
procedure TForm1.Timer3Timer(Sender: TObject);
var
GetTime : TDateTime;
Hour, Min, Sec, MSec: Word;
begin
DecodeTime(GetTime, Hour, Min, Sec, Msec);
Label11.Text := TimeToStr(GetTime);
Label11.Text := IntToStr(Hour) + ':'+ IntToStr(Min) + ':'+ IntToStr(Sec);
Label11.Text := Format('%2.2u:%2.2u:%2.2u',[Hour,Min,Sec]);
end;
Cheers.
You did not say how (in which format) the time is to be entered in the TEdit, so here are three alternative time entry possibilities. The output is anyway formatted as H:M:S.
I modified the code from yesterday to use TryStrToInt / TryStrToTime to catch errors. Also, a Seconds counter together with OnTimer event as in my previous example has a poor accuracy and can drift several seconds within 5 minutes. Edijs solution to compare Now with a calculated end time is insensitive to the inaccuracy of OnTimer events, so I adopted that too.
var
TimeOut: TDateTime;
function SecsToHmsStr(ASecs: integer):string;
begin
Result := Format('%2d:%2.2d:%2.2d',
[ASecs div 3600, ASecs mod 3600 div 60, ASecs mod 3600 mod 60]);
;end;
procedure TForm6.Timer1Timer(Sender: TObject);
begin
Label1.Caption := SecsToHmsStr(SecondsBetween(Now, TimeOut));
if Now > Timeout then Timer1.Enabled := False;
end;
Time entry alternative one, Timeout after a given number of seconds
// Timeout after a given number of seconds
procedure TForm6.Button1Click(Sender: TObject);
var
Seconds: integer;
begin
if TryStrToInt(Edit1.Text, Seconds) then
begin
TimeOut := IncSecond(Now, Seconds);
Timer1.Enabled := True;
Label1.Caption := SecsToHmsStr(SecondsBetween(Now, TimeOut));
end
else
ShowMessage('Error in number of seconds');
end;
Time entry alternative two, Timeout after a given number of hours, minutes and seconds
// Timeout after a given number of hours, minutes and seconds
procedure TForm6.Button2Click(Sender: TObject);
begin
if TryStrToTime(Edit1.Text, TimeOut) then
begin
TimeOut := Now + TimeOut;
Timer1.Enabled := True;
Label1.Caption := SecsToHmsStr(SecondsBetween(Now, TimeOut));
end
else
ShowMessage('Error in time format');
end;
Time entry alternative three, Timeout at a given time within 24 hours
// Timeout at a given time within 24 hours
procedure TForm6.Button3Click(Sender: TObject);
begin
if TryStrToTime(Edit1.Text, TimeOut) then
begin
if TimeOut <= Time then
TimeOut := Tomorrow + TimeOut
else
TimeOut := Today + TimeOut;
Timer1.Enabled := True;
Label1.Caption := SecsToHmsStr(SecondsBetween(Now, TimeOut));
end
else
ShowMessage('Error in time format');
end;
This should do it:
Uses
System.DateUtils;
type
..
private
FDateTimeTo: TDateTime;
end;
function IntToTimeStr(const ASeconds: Int64): string;
begin
Result := Format('%2d:%2.2d:%2.2d', [ASeconds div 3600, ASeconds mod 3600 div 60,
ASeconds mod 3600 mod 60]);
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
FDateTimeTo := StrToDateTime(FormatDateTime('yyyy' + FormatSettings.DateSeparator + 'mm' +
FormatSettings.DateSeparator + 'dd 00:00:00', Now)) + StrToTime(Edit1.Text);
if CompareDateTime(Now, FDateTimeTo) = 1 then
FDateTimeTo := IncDay(FDateTimeTo);
end;
procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
Label1.Caption := IntToTimeStr(SecondsBetween(Now, FDateTimeTo));
end;

Delphi StrToDateTime function

Is possible to convert
'Thu Jul 17 17:20:38 2014'
with this function? Tried my best, but no result. This format uses justin.tv API, for twitch.tv i use code below and it works. Thanks for help.
var
t1, t2: Tdate;
dzien: integer;
begin
t1 := StrToDateTime('"2014-07-21T12:49:08Z"');
t2 := TTimeZone.Local.ToUniversalTime(Now);
dzien := trunc(t2 - t1);
if dzien > 0 then
Result := (Format('%d days, %s', [dzien, FormatDateTime('hh:nn:ss',
Frac(t2 - t1))]))
else
Result := (Format('%s', [FormatDateTime('hh:nn:ss', Frac(t2 - t1))]));
end;
It is easy enough to parse the string yourself. Like this:
uses
Types, SysUtils, DateUtils, StrUtils;
function DecodeJustinTvDateTime(const Value: string): TDateTime;
function MonthNumber(const MonthStr: string): Integer;
var
FormatSettings: TFormatSettings;
begin
FormatSettings := TFormatSettings.Create('en-us');
for Result := low(FormatSettings.ShortMonthNames) to high(FormatSettings.ShortMonthNames) do begin
if SameText(MonthStr, FormatSettings.ShortMonthNames[Result]) then begin
exit;
end;
end;
raise EConvertError.Create('Unrecognised month name');
end;
var
items: TStringDynArray;
Day, Month, Year, Time, Hour, Minute, Second: string;
begin
items := SplitString(Value, ' ');
if Length(items)<>5 then begin
raise EConvertError.Create('Unrecognised date time format');
end;
// items[0] is day of the week which we can ignore
Month := items[1];
Day := items[2];
Time := items[3];
Year := items[4];
items := SplitString(Time, ':');
Assert(Length(items)=3);
if Length(items)<>3 then begin
raise EConvertError.Create('Unrecognised time format');
end;
Hour := items[0];
Minute := items[1];
Second := items[2];
Result := EncodeDateTime(
StrToInt(Year),
MonthNumber(Month),
StrToInt(Day),
StrToInt(Hour),
StrToInt(Minute),
StrToInt(Second),
0
);
end;
The error checking here is a little lame and you might care to improve on it.
procedure TForm6.Button1Click(Sender: TObject);
var
t1: TDateTime;
ts:TFormatSettings;
begin
ts:=TFormatSettings.Create;
ts.ShortDateFormat:='yyyy-MM-dd';
ts.DateSeparator:='-';
ts.TimeSeparator:=':';
t1 := StrToDateTime('2014-07-21T12:49:08Z',ts);
end;
t1 contains date and time from your string.

How can I generate continuous tones of varying frequencies?

I want to generate and play a continuous sound with specific frequencies and amplitudes that change over time. I don't want to have a delay between sounds. How can I do this with Delphi or C++ Builder?
This very simple example should get you started.
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows, MMSystem;
type
TWaveformSample = integer; // signed 32-bit; -2147483648..2147483647
TWaveformSamples = packed array of TWaveformSample; // one channel
var
Samples: TWaveformSamples;
fmt: TWaveFormatEx;
procedure InitAudioSys;
begin
with fmt do
begin
wFormatTag := WAVE_FORMAT_PCM;
nChannels := 1;
nSamplesPerSec := 44100;
wBitsPerSample := 32;
nAvgBytesPerSec := nChannels * nSamplesPerSec * wBitsPerSample div 8;
nBlockAlign := nChannels * wBitsPerSample div 8;
cbSize := 0;
end;
end;
// Hz // msec
procedure CreatePureSineTone(const AFreq: integer; const ADuration: integer;
const AVolume: double { in [0, 1] });
var
i: Integer;
omega,
dt, t: double;
vol: double;
begin
omega := 2*Pi*AFreq;
dt := 1/fmt.nSamplesPerSec;
t := 0;
vol := MaxInt * AVolume;
SetLength(Samples, Round((ADuration / 1000) * fmt.nSamplesPerSec));
for i := 0 to high(Samples) do
begin
Samples[i] := round(vol*sin(omega*t));
t := t + dt;
end;
end;
procedure PlaySound;
var
wo: integer;
hdr: TWaveHdr;
begin
if Length(samples) = 0 then
begin
Writeln('Error: No audio has been created yet.');
Exit;
end;
if waveOutOpen(#wo, WAVE_MAPPER, #fmt, 0, 0, CALLBACK_NULL) = MMSYSERR_NOERROR then
try
ZeroMemory(#hdr, sizeof(hdr));
with hdr do
begin
lpData := #samples[0];
dwBufferLength := fmt.nChannels * Length(Samples) * sizeof(TWaveformSample);
dwFlags := 0;
end;
waveOutPrepareHeader(wo, #hdr, sizeof(hdr));
waveOutWrite(wo, #hdr, sizeof(hdr));
sleep(500);
while waveOutUnprepareHeader(wo, #hdr, sizeof(hdr)) = WAVERR_STILLPLAYING do
sleep(100);
finally
waveOutClose(wo);
end;
end;
begin
try
InitAudioSys;
CreatePureSineTone(400, 1000, 0.7);
PlaySound;
except
on E: Exception do
begin
Writeln(E.Classname, ': ', E.Message);
Readln;
end;
end;
end.
Notice in particular the neat interface you get:
InitAudioSys;
CreatePureSineTone(400, 1000, 0.7);
PlaySound;
By using WaveAudio library it's possible to generate a continous cosinus wave.
I was gonna post some code but I can't figure out how to do it properly so I won't.
But all you need to do is use TLiveAudioPlayer and then override the OnData event.
And also set Async to true if there is no message pump.
Update in dec 2021, I just came across my answer by chance... so I would like to update it, I used this ASIO library in 2009 I think and later, great library below:*
I would recommend ASIO library for Delphi !
https://sourceforge.net/projects/delphiasiovst/
Using this is super easy, not all files have to be included, start with the main one and add the rest from there, also see the examples.
Ultimately it's as easy as OnSomeEvent/OnSomeBuffer
and then simply filling an array with floating point values.
Don't remember the exact name of the OnEvent but you'll find it easily in the examples.
Another thing to do is set some component to active/true and voila.
The nice thing about ASIO is very low latency, it's even possible to get it down to 50 microseconds or even lower.
It does require an ASIO driver for your sound chip.
ASIO = audio stream input output
API designed by audio engineers !
It probably doesn't get any better than this ! ;)

Resources