Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 4 days ago.
Improve this question
I want to write a pascal script to charge a battery for a specified time period or until the upper voltage limit is achieved. I also want to read the battery current and voltage at specific time interval while the charging continues.
I will supply the set voltage, set current , lower voltage limit, upper voltage limit and read the output voltage, output current parameters using a DC power supply used for this process.
program BatteryCharging;
uses DateUtils,sysUtils;
var
temp: string;
Voltage, Current: string;
OverVoltageLimit: Double;
TimeInterval: Integer;
StartTime: TDateTime;
begin
// Set parameters
temp:= 'CH 1' + #13#10;
ComSendstr(temp);
writeln(temp);
temp:= 'SO:VO 1.00' + #13#10;
ComSendstr(temp);
temp:= 'SO:CU 0.50' + #13#10;
ComSendstr(temp);
temp:= 'SO:UV 0.10' + #13#10;
ComSendstr(temp);
temp:= 'SO:OV 5.00' + #13#10;
ComSendstr(temp);
temp:= 'OUTP 1' + #13#10;
ComSendstr(temp);
// Battery charging loop
TimeInterval := 2; // set time interval to 2 seconds
while True do
begin
// read voltage and current
temp := 'VOLT?' + #13#10;
ComSendstr(temp);
Voltage := ComRecstr(20);
temp := 'CURR?' + #13#10;
ComSendstr(temp);
Current := ComRecstr(20);
temp := 'SO:OV' + #13#10;
ComSendstr(temp);
OverVoltageLimit := StrToFloat(ComRecstr(20));
StartTime :=Now;
// check if overvoltage limit has been exceeded
if StrToFloat(Voltage) >= OverVoltageLimit then
begin
writeln('Overvoltage limit exceeded. Stopping charging process.');
Break;
end;
// check if time interval has elapsed
if MilliSecondsBetween(Now, StartTime) >= TimeInterval * 1000 then
begin
// save data to file or display on screen
// you can modify this to suit your needs
writeln('Time: ', TimeToStr(Now), ' Voltage: ', Voltage, ' Current:
', Current);
// reset start time
StartTime := Now;
end;
// wait for specified time interval
Sleep(1000);
end;
temp := 'OUTP 0' + #13#10;
ComSendstr(temp);
temp := 'EXIT' + #13#10;
ComSendstr(temp);
end.
The parameter set part is working fine and the instrument accepts the set value. But there is some error in the loop. It shows error 1521. But I don't understand why?
Related
I get the following when communicating with a custom client.
With custom client i mean a housemade PCB with a FPGA which runs the Triple-Speed Ethernet Intel FPGA IP. It does not make a difference if a switch is between the PC and the PCB.
Workflow seen from the Server(Windows PC) where i detect this behaviour with wireshark:
Connect to client (Syn - Syn/Ack - Ack) Winsock2.connect
Sending data > MTU with Winsock2.WSASend (4092 Bytes on a 4088 Bytes MTU)
Packet gets "fragmented" into 2 packets - do not fragment bit is set
A Retransmission happens (because the client answered too slow?)
I am using delphi 10.4 and use the Winsock2 functions. Bevore each send i check with select if fdwrite is set if FD_Isset. Nagle is deactivated.
The "retransmission" does not happen everytime and i could not detect any sort of pattern when they occur. Except most of the time it is when the client needs more than 30ms to send his ACK.
When the "retransmission" happens it is not packet 1 or two whicht is re-send, but packet 1 with an offset of 60 which is the payload of packet 2. The sequence number of packet 1 is incremented by 60 too. Even the data is correct, it's correctly incremented by 60.
When I send 6000 Bytes i get the same behaviour with an incremented seq of 1968 which is correct too.
What is happening here?
Can i detect this with winsock2? Can i set the RTO with winsock? Why is the sequence number incremented and not packet 1, as it is, retransmitted?
Source Code of the send function:
function TZWinTCPSock.SendData (out ErrMsg : TAPILogStruct; SendOffset :
Cardinal = 0) : Boolean;
var
WSABuff : WSABUF;
res : Integer;
IPFlags : Cardinal;
t : Cardinal;
WSAErr : Cardinal;
begin
Result := FALSE;
WSAErr := WSAGetLastError;
try
if not CheckSockValid(ErrMsg) then // checks if fd_write is set
begin
exit(false);
end;
try
WSABuff.len := FMem.SendLength; // 4092 at this time Cardinal
WSABuff.buf := #FMem.SendData[SendOffset]; // 8192 Bytes reserved TArray<Byte>
IPFlags := 0;
res := WSASend(FSocket,#WSABuff,1,FMem.sentBytes,IPFlags,nil,nil);
if Res <> SOCKET_ERROR then
begin
if FMem.SendLength <> FMem.SentBytes then
begin
exit(false);
end
else
begin
Result := TRUE;
if WSAGetLastError <> WSAErr then // unexpected WSA error
begin
exit(FALSE);
end;
end;
end
else
begin
FLastWSAErr := WSAGetLastError;
if FLastWSAErr = WSAECONNRESET then
begin
Disconnect(ErrMsg);
exit(false);
end;
end;
except
on E : Exception do
begin
// Some error handling
end;
end;
finally
end;
end;
Edit1
The packets have the don't fragment Bit set.
I tried to detect this "retransmission" with the windows admin center, but I don't see anything popping up.
Got an answer on Microsoft Q&A.
Looks like it was a tail loss probe problem where the destination host is at fault, because the reply took too long and srtt timed out.
It's already a while we are working with FireMonkey at office. After a while we noticed it wasn't exactly so lightning fast due to GPU acceleration as Embarcadero tells us.
So we built a basic application just for testing FireMonkey performance. Basically it's a form with a panel on the bottom (alBottom) that works as status bar and an all client (alClient) Panel. The panel on the bottom has a progressbar and an animation.
We added a method to the form that frees whatever control is present in the all client panel and fulfil it with cells of a custom type and a "mouse over" style and update the animation, the progress bar and the form's caption with info about the fulfilling progress. The most important info is the required time.
Finally we added such method to the OnResize of the form, run the application and maximized the form (1280x1024).
The result with XE2 was really slow. It took around 11 seconds. In addition since the panel is fulfilled till the application is ready to receive user input there is an additional delay of about 10 seconds (like freezing). For an overall of 21 seconds.
With XE3 the situation got worst. For the same operation it took an overall of 25 seconds (14 + 11 freezing).
And rumours tell XE4 is going to be a lot worst of XE3.
This is quite scaring considering exactly the same application, using VCL instead of FireMonkey and using SpeedButtons in order to have the same "mouse over effect" takes just 1.5 seconds!!! So the problem clearly reside in some internal FireMonkey engine problem(s).
I opened a QC (#113795) and a (paid) ticket to embarcadero support but nothing they won't solve it.
I seriously don't understand how they can ignore such heavy issue. For our enterprise is being a show-stopper and a deal breaker. We cannot offer commercial software to our customer with such poor performance. Earlier or later we will be forced to move to another platform (BTW: the same code Delphi Prism with WPF takes 1.5 seconds as the VCL one).
If anybody has any idea about how to solve the issue or try to improve this test performance and want to help I would be really glad of it.
Thank you in advance.
Bruno Fratini
The application is the following one:
unit Performance01Main;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Rtti, System.Classes,
System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects;
const
cstCellWidth = 45;
cstCellHeight = 21;
type
TCell = class(TStyledControl)
private
function GetText: String;
procedure SetText(const Value: String);
function GetIsFocusCell: Boolean;
protected
FSelected: Boolean;
FMouseOver: Boolean;
FText: TText;
FValue: String;
procedure ApplyStyle; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
procedure DoMouseEnter; override;
procedure DoMouseLeave; override;
procedure ApplyTrigger(TriggerName: string);
published
property IsSelected: Boolean read FSelected;
property IsFocusCell: Boolean read GetIsFocusCell;
property IsMouseOver: Boolean read FMouseOver;
property Text: String read GetText write SetText;
end;
TFormFireMonkey = class(TForm)
StyleBook: TStyleBook;
BottomPanel: TPanel;
AniIndicator: TAniIndicator;
ProgressBar: TProgressBar;
CellPanel: TPanel;
procedure FormResize(Sender: TObject);
procedure FormActivate(Sender: TObject);
protected
FFocused: TCell;
FEntered: Boolean;
public
procedure CreateCells;
end;
var
FormFireMonkey: TFormFireMonkey;
implementation
uses
System.Diagnostics;
{$R *.fmx}
{ TCell }
procedure TCell.ApplyStyle;
begin
inherited;
ApplyTrigger('IsMouseOver');
ApplyTrigger('IsFocusCell');
ApplyTrigger('IsSelected');
FText:= (FindStyleResource('Text') as TText);
if (FText <> Nil) then
FText.Text := FValue;
end;
procedure TCell.ApplyTrigger(TriggerName: string);
begin
StartTriggerAnimation(Self, TriggerName);
ApplyTriggerEffect(Self, TriggerName);
end;
procedure TCell.DoMouseEnter;
begin
inherited;
FMouseOver:= True;
ApplyTrigger('IsMouseOver');
end;
procedure TCell.DoMouseLeave;
begin
inherited;
FMouseOver:= False;
ApplyTrigger('IsMouseOver');
end;
function TCell.GetIsFocusCell: Boolean;
begin
Result:= (Self = FormFireMonkey.FFocused);
end;
function TCell.GetText: String;
begin
Result:= FValue;
end;
procedure TCell.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
OldFocused: TCell;
begin
inherited;
FSelected:= not(FSelected);
OldFocused:= FormFireMonkey.FFocused;
FormFireMonkey.FFocused:= Self;
ApplyTrigger('IsFocusCell');
ApplyTrigger('IsSelected');
if (OldFocused <> Nil) then
OldFocused.ApplyTrigger('IsFocusCell');
end;
procedure TCell.SetText(const Value: String);
begin
FValue := Value;
if Assigned(FText) then
FText.Text:= Value;
end;
{ TForm1 }
procedure TFormFireMonkey.CreateCells;
var
X, Y: Double;
Row, Col: Integer;
Cell: TCell;
T: TTime;
// Workaround suggested by Himself 1
// Force update only after a certain amount of iterations
// LP: Single;
// Workaround suggested by Himself 2
// Force update only after a certain amount of milliseconds
// Used cross-platform TStopwatch as suggested by LU RD
// Anyway the same logic was tested with TTime and GetTickCount
// SW: TStopWatch;
begin
T:= Time;
Caption:= 'Creating cells...';
{$REGION 'Issue 2 workaround: Update form size and background'}
// Bruno Fratini:
// Without (all) this code the form background and area is not updated till the
// cells calculation is finished
BeginUpdate;
Invalidate;
EndUpdate;
// Workaround suggested by Philnext
// replacing ProcessMessages with HandleMessage
// Application.HandleMessage;
Application.ProcessMessages;
{$ENDREGION}
// Bruno Fratini:
// Update starting point step 1
// Improving performance
CellPanel.BeginUpdate;
// Bruno Fratini:
// Freeing the previous cells (if any)
while (CellPanel.ControlsCount > 0) do
CellPanel.Controls[0].Free;
// Bruno Fratini:
// Calculating how many rows and columns can contain the CellPanel
Col:= Trunc(CellPanel.Width / cstCellWidth);
if (Frac(CellPanel.Width / cstCellWidth) > 0) then
Col:= Col + 1;
Row:= Trunc(CellPanel.Height / cstCellHeight);
if (Frac(CellPanel.Height / cstCellHeight) > 0) then
Row:= Row + 1;
// Bruno Fratini:
// Loop variables initialization
ProgressBar.Value:= 0;
ProgressBar.Max:= Row * Col;
AniIndicator.Enabled:= True;
X:= 0;
Col:= 0;
// Workaround suggested by Himself 2
// Force update only after a certain amount of milliseconds
// Used cross-platform TStopwatch as suggested by LU RD
// Anyway the same logic was tested with TTime and GetTickCount
// SW:= TStopwatch.StartNew;
// Workaround suggested by Himself 1
// Force update only after a certain amount of iterations
// LP:= 0;
// Bruno Fratini:
// Loop for fulfill the Width
while (X < CellPanel.Width) do
begin
Y:= 0;
Row:= 0;
// Bruno Fratini:
// Loop for fulfill the Height
while (Y < CellPanel.Height) do
begin
// Bruno Fratini:
// Cell creation and bounding into the CellPanel
Cell:= TCell.Create(CellPanel);
Cell.Position.X:= X;
Cell.Position.Y:= Y;
Cell.Width:= cstCellWidth;
Cell.Height:= cstCellHeight;
Cell.Parent:= CellPanel;
// Bruno Fratini:
// Assigning the style that gives something like Windows 7 effect
// on mouse move into the cell
Cell.StyleLookup:= 'CellStyle';
// Bruno Fratini:
// Updating loop variables and visual controls for feedback
Y:= Y + cstCellHeight;
Row:= Row + 1;
ProgressBar.Value:= ProgressBar.Value + 1;
// Workaround suggested by Himself 1
// Force update only after a certain amount of iterations
// if ((ProgressBar.Value - LP) >= 100) then
// Workaround suggested by Himself 2
// Force update only after a certain amount of milliseconds
// Used cross-platform TStopwatch as suggested by LU RD
// Anyway the same logic was tested with TTime and GetTickCount
// if (SW.ElapsedMilliseconds >= 30) then
// Workaround suggested by Philnext with Bruno Fratini's enhanchment
// Skip forcing refresh when the form is not focused for the first time
// This avoid the strange side effect of overlong delay on form open
// if FEntered then
begin
Caption:= 'Elapsed time: ' + FormatDateTime('nn:ss:zzz', Time - T) +
' (min:sec:msec) Cells: ' + IntToStr(Trunc(ProgressBar.Value));
{$REGION 'Issue 4 workaround: Forcing progress and animation visual update'}
// Bruno Fratini:
// Without the ProcessMessages call both the ProgressBar and the
// Animation controls are not updated so no feedback to the user is given
// that is not acceptable. By the other side this introduces a further
// huge delay on filling the grid to a not acceptable extent
// (around 20 minutes on our machines between form maximization starts and
// it arrives to a ready state)
// Workaround suggested by Philnext
// replacing ProcessMessages with HandleMessage
// Application.HandleMessage;
Application.ProcessMessages;
{$ENDREGION}
// Workaround suggested by Himself 1
// Force update only after a certain amount of iterations
// LP:= ProgressBar.Value;
// Workaround suggested by Himself 2
// Force update only after a certain amount of milliseconds
// Used cross-platform TStopwatch as suggested by LU RD
// Anyway the same logic was tested with TTime and GetTickCount
// SW.Reset;
// SW.Start;
end;
end;
X:= X + cstCellWidth;
Col:= Col + 1;
end;
// Bruno Fratini:
// Update starting point step 2
// Improving performance
CellPanel.EndUpdate;
AniIndicator.Enabled:= False;
ProgressBar.Value:= ProgressBar.Max;
Caption:= 'Elapsed time: ' + FormatDateTime('nn:ss:zzz', Time - T) +
' (min:sec:msec) Cells: ' + IntToStr(Trunc(ProgressBar.Value));
// Bruno Fratini:
// The following lines are required
// otherwise the cells won't be properly paint after maximizing
BeginUpdate;
Invalidate;
EndUpdate;
// Workaround suggested by Philnext
// replacing ProcessMessages with HandleMessage
// Application.HandleMessage;
Application.ProcessMessages;
end;
procedure TFormFireMonkey.FormActivate(Sender: TObject);
begin
// Workaround suggested by Philnext with Bruno Fratini's enhanchment
// Skip forcing refresh when the form is not focused for the first time
// This avoid the strange side effect of overlong delay on form open
FEntered:= True;
end;
procedure TFormFireMonkey.FormResize(Sender: TObject);
begin
CreateCells;
end;
end.
I tried your code, it takes 00:10:439 on my PC on XE3 to fill screen with cells. By disabling these lines:
//ProgressBar.Value:= ProgressBar.Value + 1;
//Caption:= 'Elapsed time: ' + FormatDateTime('nn:ss:zzz', Time - T) +
// ' (min:sec:msec) Cells: ' + IntToStr(Trunc(ProgressBar.Value));
...
//Application.ProcessMessages;
This goes down to 00:00:106 (!).
Updating visual controls (such as ProgressBar or Form.Caption) is very expensive. If you really think you need that, do that only every 100-th iteration, or better, only every 250 processor ticks.
If that does not help with performance, please run your code with these lines disabled and update the question.
Further, I've added code to test the repainting time:
T:= Time;
// Bruno Fratini:
// The following lines are required
// otherwise the cells won't be properly paint after maximizing
//BeginUpdate;
Invalidate;
//EndUpdate;
Application.ProcessMessages;
Caption := Caption + ', Repaint time: '+FormatDateTime('nn:ss:zzz', Time - T);
When run for a first time, creating all the controls takes 00:00:072, repainting takes 00:03:089. So it's not the object management but the first time repainting which is slow.
Second time repainting is considerably faster.
Since there's a discussion in comments, here's how you do progress updates:
var LastUpdateTime: cardinal;
begin
LastUpdateTime := GetTickCount - 250;
for i := 0 to WorkCount-1 do begin
//...
//Do a part of work here
if GetTickCount-LastUpdateTime > 250 then begin
ProgressBar.Position := i;
Caption := IntToStr(i) + ' items done.';
LastUpdateTime := GetTickCount;
Application.ProcessMessages; //not always needed
end;
end;
end;
I only have XE2 and the code is not exactlly the same but, as said by some other guys the pb seems to be on the
Application.ProcessMessages;
line.
So I sugess to 'refresh' your components with realign ex :
ProgressBar.Value:= ProgressBar.Value + 1;
Caption:= 'Elapsed time: ' + FormatDateTime('nn:ss:zzz', Time - T) +
' (min:sec:msec) Cells: ' + IntToStr(Trunc(ProgressBar.Value));
// in comment : Application.ProcessMessages;
// New lines : realign for all the components needed to be refreshes
AniIndicator.Realign;
ProgressBar.Realign;
On my PC, a 210 Cells screen is generated in 0.150 s instead of 3.7 s with the original code, to be tested in your environnement...
Why are you testing
"Repaint", "InvalidateRect", "Scene.EndUpdate"
I can see from your code that most expensive operation is recreating controls.
And why are you doing it in OnResize event (maybe put some button for recreating controls)
this loop alone can eat like 30% of execution time
while (CellPanel.ControlsCount > 0) do
CellPanel.Controls[0].Free;
it should be like: (avoid list memory copy after each free)
for i := CellPanel.ControlsCount - 1 downto 0 do
CellPanel.Controls[i].Free;
and don't run ProcessMessages in loop (or at least run only in every 10th iteration or so)
use AQTime to profile your code (it will show what is tacking that long)
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 was trying to speed up a certain routine in an application, and my profiler, AQTime, identified one method in particular as a bottleneck. The method has been with us for years, and is part of a "misc"-unit:
function cwLeftPad(aString:string; aCharCount:integer; aChar:char): string;
var
i,vLength:integer;
begin
Result := aString;
vLength := Length(aString);
for I := (vLength + 1) to aCharCount do
Result := aChar + Result;
end;
In the part of the program that I'm optimizing at the moment the method was called ~35k times, and it took a stunning 56% of the execution time!
It's easy to see that it's a horrible way to left-pad a string, so I replaced it with
function cwLeftPad(const aString:string; aCharCount:integer; aChar:char): string;
begin
Result := StringOfChar(aChar, aCharCount-length(aString))+aString;
end;
which gave a significant boost. Total running time went from 10,2 sec to 5,4 sec. Awesome! But, cwLeftPad still accounts for about 13% of the total running time. Is there an easy way to optimize this method further?
Your new function involves three strings, the input, the result from StringOfChar, and the function result. One of them gets destroyed when your function returns. You could do it in two, with nothing getting destroyed or re-allocated.
Allocate a string of the total required length.
Fill the first portion of it with your padding character.
Fill the rest of it with the input string.
Here's an example:
function cwLeftPad(const aString: AnsiString; aCharCount: Integer; aChar: AnsiChar): AnsiString;
var
PadCount: Integer;
begin
PadCount := ACharCount - Length(AString);
if PadCount > 0 then begin
SetLength(Result, ACharCount);
FillChar(Result[1], PadCount, AChar);
Move(AString[1], Result[PadCount + 1], Length(AString));
end else
Result := AString;
end;
I don't know whether Delphi 2009 and later provide a double-byte Char-based equivalent of FillChar, and if they do, I don't know what it's called, so I have changed the signature of the function to explicitly use AnsiString. If you need WideString or UnicodeString, you'll have to find the FillChar replacement that handles two-byte characters. (FillChar has a confusing name as of Delphi 2009 since it doesn't handle full-sized Char values.)
Another thing to consider is whether you really need to call that function so often in the first place. The fastest code is the code that never runs.
Another thought - if this is Delphi 2009 or 2010, disable "String format checking" in Project, Options, Delphi Compiler, Compiling, Code Generation.
StringOfChar is very fast and I doubt you can improve this code a lot. Still, try this one, maybe it's faster:
function cwLeftPad(aString:string; aCharCount:integer; aChar:char): string;
var
i,vLength:integer;
origSize: integer;
begin
Result := aString;
origSize := Length(Result);
if aCharCount <= origSize then
Exit;
SetLength(Result, aCharCount);
Move(Result[1], Result[aCharCount-origSize+1], origSize * SizeOf(char));
for i := 1 to aCharCount - origSize do
Result[i] := aChar;
end;
EDIT: I did some testing and my function is slower than your improved cwLeftPad. But I found something else - there's no way your CPU needs 5 seconds to execute 35k cwLeftPad functions except if you're running on PC XT or formatting gigabyte strings.
I tested with this simple code
for i := 1 to 35000 do begin
a := 'abcd1234';
b := cwLeftPad(a, 73, '.');
end;
and I got 255 milliseconds for your original cwLeftPad, 8 milliseconds for your improved cwLeftPad and 16 milliseconds for my version.
You call StringOfChar every time now. Of course this method checks if it has something to do and jumps out if length is small enough, but maybe the call to StringOfChar is time consuming, because internally it does another call before jumping out.
So my first idea would be to jump out by myself if there is nothing to do:
function cwLeftPad(const aString: string; aCharCount: Integer; aChar: Char;): string;
var
l_restLength: Integer;
begin
Result := aString;
l_restLength := aCharCount - Length(aString);
if (l_restLength < 1) then
exit;
Result := StringOfChar(aChar, l_restLength) + aString;
end;
You can speed up this routine even more by using lookup array.
Of course it depends on your requirements. If you don't mind wasting some memory...
I guess that the function is called 35 k times but it has not 35000 different padding lengths and many different chars.
So if you know (or you are able to estimate in some quick way) the range of paddings and the padding chars you could build an two-dimensional array which include those parameters.
For the sake of simplicity I assume that you have 10 different padding lengths and you are padding with one character - '.', so in example it will be one-dimensional array.
You implement it like this:
type
TPaddingArray = array of String;
var
PaddingArray: TPaddingArray;
TestString: String;
function cwLeftPad4(const aString:string; const aCharCount:integer; const aChar:char; var anArray: TPaddingArray ): string;
begin
Result := anArray[aCharCount-length(aString)] + aString;
end;
begin
//fill up the array
SetLength(StrArray, 10);
PaddingArray[0] := '';
PaddingArray[1] := '.';
PaddingArray[2] := '..';
PaddingArray[3] := '...';
PaddingArray[4] := '....';
PaddingArray[5] := '.....';
PaddingArray[6] := '......';
PaddingArray[7] := '.......';
PaddingArray[8] := '........';
PaddingArray[9] := '.........';
//and you call it..
TestString := cwLeftPad4('Some string', 20, '.', PaddingArray);
end;
Here are benchmark results:
Time1 - oryginal cwLeftPad : 27,0043604142394 ms.
Time2 - your modyfication cwLeftPad : 9,25971967336897 ms.
Time3 - Rob Kennedy's version : 7,64538131122457 ms.
Time4 - cwLeftPad4 : 6,6417059620664 ms.
Updated benchmarks:
Time1 - oryginal cwLeftPad : 26,8360194218451 ms.
Time2 - your modyfication cwLeftPad : 9,69653117046119 ms.
Time3 - Rob Kennedy's version : 7,71149259179622 ms.
Time4 - cwLeftPad4 : 6,58248533610693 ms.
Time5 - JosephStyons's version : 8,76641780969192 ms.
The question is: is it worth the hassle?;-)
It's possible that it may be quicker to use StringOfChar to allocate an entirely new string the length of string and padding and then use move to copy the existing text over the back of it.
My thinking is that you create two new strings above (one with FillChar and one with the plus). This requires two memory allocates and constructions of the string pseudo-object. This will be slow. It may be quicker to waste a few CPU cycles doing some redundant filling to avoid the extra memory operations.
It may be even quicker if you allocated the memory space then did a FillChar and a Move, but the extra fn call may slow that down.
These things are often trial-and-error!
You can get dramatically better performance if you pre-allocate the string.
function cwLeftPadMine
{$IFDEF VER210} //delphi 2010
(aString: ansistring; aCharCount: integer; aChar: ansichar): ansistring;
{$ELSE}
(aString: string; aCharCount: integer; aChar: char): string;
{$ENDIF}
var
i,n,padCount: integer;
begin
padCount := aCharCount - Length(aString);
if padCount > 0 then begin
//go ahead and set Result to what it's final length will be
SetLength(Result,aCharCount);
//pre-fill with our pad character
FillChar(Result[1],aCharCount,aChar);
//begin after the padding should stop, and restore the original to the end
n := 1;
for i := padCount+1 to aCharCount do begin
Result[i] := aString[n];
end;
end
else begin
Result := aString;
end;
end;
And here is a template that is useful for doing comparisons:
procedure TForm1.btnPadTestClick(Sender: TObject);
const
c_EvalCount = 5000; //how many times will we run the test?
c_PadHowMany = 1000; //how many characters will we pad
c_PadChar = 'x'; //what is our pad character?
var
startTime, endTime, freq: Int64;
i: integer;
secondsTaken: double;
padIt: string;
begin
//store the input locally
padIt := edtPadInput.Text;
//display the results on the screen for reference
//(but we aren't testing performance, yet)
edtPadOutput.Text := cwLeftPad(padIt,c_PadHowMany,c_PadChar);
//get the frequency interval of the OS timer
QueryPerformanceFrequency(freq);
//get the time before our test begins
QueryPerformanceCounter(startTime);
//repeat the test as many times as we like
for i := 0 to c_EvalCount - 1 do begin
cwLeftPad(padIt,c_PadHowMany,c_PadChar);
end;
//get the time after the tests are done
QueryPerformanceCounter(endTime);
//translate internal time to # of seconds and display evals / second
secondsTaken := (endTime - startTime) / freq;
if secondsTaken > 0 then begin
ShowMessage('Eval/sec = ' + FormatFloat('#,###,###,###,##0',
(c_EvalCount/secondsTaken)));
end
else begin
ShowMessage('No time has passed');
end;
end;
Using that benchmark template, I get the following results:
The original: 5,000 / second
Your first revision: 2.4 million / second
My version: 3.9 million / second
Rob Kennedy's version: 3.9 million / second
This is my solution. I use StringOfChar instead of FillChar because it can handle unicode strings/characters:
function PadLeft(const Str: string; Ch: Char; Count: Integer): string;
begin
if Length(Str) < Count then
begin
Result := StringOfChar(Ch, Count);
Move(Str[1], Result[Count - Length(Str) + 1], Length(Str) * SizeOf(Char));
end
else Result := Str;
end;
function PadRight(const Str: string; Ch: Char; Count: Integer): string;
begin
if Length(Str) < Count then
begin
Result := StringOfChar(Ch, Count);
Move(Str[1], Result[1], Length(Str) * SizeOf(Char));
end
else Result := Str;
end;
It's a bit faster if you store the length of the original string in a variable:
function PadLeft(const Str: string; Ch: Char; Count: Integer): string;
var
Len: Integer;
begin
Len := Length(Str);
if Len < Count then
begin
Result := StringOfChar(Ch, Count);
Move(Str[1], Result[Count - Len + 1], Len * SizeOf(Char));
end
else Result := Str;
end;
function PadRight(const Str: string; Ch: Char; Count: Integer): string;
var
Len: Integer;
begin
Len := Length(Str);
if Len < Count then
begin
Result := StringOfChar(Ch, Count);
Move(Str[1], Result[1], Len * SizeOf(Char));
end
else Result := Str;
end;
I want to develop a setup package for conditionally upgrading an existing package. I want to check the existing software version against to-be-installed version. In order to do that, I have to compare the version strings.
How can I convert the string value to a numerical value in a Inno setup script?
RegQueryStringValue(HKEY_LOCAL_MACHINE, 'Software\Blah blah', 'Version', version)
version = 'V1.R2.12';
numVersion := ??string_to_numerical_value??(version);
This is a little more tricky, as you would want to handle versions like 'V1.R2.12' and 'V0.R15.42' correctly - with the simple conversion in the other answer you would get 1212 and 1542, which would not compare the way you would expect.
You need to decide how big each part of the version number can be, and multiply the parts by that value to get a correct end number. Something like this:
[Code]
function string_to_numerical_value(AString: string; AMaxVersion: LongWord): LongWord;
var
InsidePart: boolean;
NewPart: LongWord;
CharIndex: integer;
c: char;
begin
Result := 0;
InsidePart := FALSE;
// this assumes decimal version numbers !!!
for CharIndex := 1 to Length(AString) do begin
c := AString[CharIndex];
if (c >= '0') and (c <= '9') then begin
// new digit found
if not InsidePart then begin
Result := Result * AMaxVersion + NewPart;
NewPart := 0;
InsidePart := TRUE;
end;
NewPart := NewPart * 10 + Ord(c) - Ord('0');
end else
InsidePart := FALSE;
end;
// if last char was a digit the last part hasn't been added yet
if InsidePart then
Result := Result * AMaxVersion + NewPart;
end;
You can test this with the following code:
function InitializeSetup(): Boolean;
begin
if string_to_numerical_value('V1.R2.12', 1) < string_to_numerical_value('V0.R15.42', 1) then
MsgBox('Version ''V1.R2.12'' is not as recent as version ''V0.R15.42'' (false)', mbConfirmation, MB_OK);
if string_to_numerical_value('V1.R2.12', 100) > string_to_numerical_value('V0.R15.42', 100) then
MsgBox('Version ''V1.R2.12'' is more recent than version ''V0.R15.42'' (true)', mbConfirmation, MB_OK);
Result := FALSE;
end;
Whether you pass 10, 100 or 1000 for AMaxVersion depends on the number and range of your version number parts. Note that you must not overflow the LongWord result variable, which has a maximum value of 2^32 - 1.
I haven't tried that (and my Pascal knowledge is a bit rusty), but something like the following should work:
function NumericVersion(s: String): Integer;
var
i: Integer;
s1: String;
begin
s1 := '';
for i := 0 to Length(s)-1 do
if (s[i] >= '0') and (s[i] <= '9') then
s1 := s1 + s[i];
Result := StrToIntDef(s1, 0);
end;
Please not that you'll have to play with the start and end value for i as I'm not sure whether it is zero-based or not (s[0] may contain the length of the string if it is a "Pascal String").
I've implemented two version strings (actually one string and one dword value) in the registry to overcome complexity.
displayversion="v1.r1.0"
version="10100" (=1*10^4 + 1*10^2 + 0*10^0)
That's simple. Though not an answer to this question, however one might think the other way around when faced with complexity, which could be avoided in a simpler way.