Got me stumped: on Windows, Free Pascal
{... writes text lines to PdfTmp, then ...}
close(PdfTmp);
reset(PdfTmp);
while not eof(PdfTmp) do begin
readln(PdfTmp,InpLine);
writeln(ProdFile,InpLine);
end;
close(PdfTmp);
I've verified that the PdfTmp file is written with the text, but the eof() function returns true on the first call, thus the while block is never executed.
I tried all kinds of tricks with surrounding code to determine whatever else might be causing the failure, including updating my FPC compiler, to no avail. Tests confirm it is the improper eof() function result.
The same code works properly on a Mac. (FreePascal supports various platforms.)
Any other poor soul out there had this evil befall and stall out a nice project? If so, how was it fixed, if it was?
Here's how I solved the problem:
{}
{$ifdef WIN}
procedure starttext (var F :file; var Feof :boolean);
begin
reset(F,1); Feof := filesize(F) = 0;
end;
procedure gettext (var F :file; Feoln :array of byte; var Feof :boolean; var S :string);
{ gets the next text line from F into S. Returns false at end of file.
It returns the last string and sets eof if there are no additional strings.}
var endline, endfile :boolean; P, R :longint; C, D :byte;
begin
S := '';
endline := false;
endfile := false;
repeat
P := filepos(F);
blockread(F,C,1,R);
if R = 0 then begin
endline := true;
endfile := true; end
else begin
P := P + 1;
if C = Feoln[0] then begin
if high(Feoln) > 0 then begin
blockread(F,D,1,R);
if (R <> 0) then begin
if D = Feoln[1] then begin
endline := true;
P := P + 1; end
else
seek(F, P);
end else
P := P + 1;
end else
endline := true;
end else
S := S + chr(C);
endfile := P = (filesize(F));
end;
until
(endline = true) or (endfile = true);
Feof := endfile;
end;
{$endif}
{}
...
{}
close(PdfTmp);
{$ifdef OSX}
reset(PdfTmp);
while not eof(PdfTmp) do begin
readln(PdfTmp,InpLine);
putpdfln(InpLine);
end;
close(PdfTmp);
{$endif}
{$ifdef WIN}
assign(PdfWrk,FileID+'.$$$'); {same file as PdfTmp}
starttext(PdfWrk,eofPdfWrk);
while not eofPdfWrk do begin
gettext(PdfWrk, [13,10], eofPdfWrk, InpLine);
putpdfln(InpLine);
end;
close(PdfWrk);
{$endif}
{}
...
I abandoned the idea that Windows was a viable product when I realized Microsoft had failed to follow IBM's instructions for how to handle interrupts which they published with the first IBM-PC. This failure still plagues the monstrous ill-conceived class structure of Windows; and leads to that enigmatic occasional glitch we've all experienced in Windows applications.
Personally, I don't believe an operating system should be built with classes, which impose an unnecessary overhead for process code that will be needed only once in the system (which if properly done will be true for all the code in the OS). A good API would suffice.
Related
I found that the gettickdiff64 function sometimes results in 18446744073709551600 (or 18446744073709551601) and causes the
program to run incorrectly.
Normally does not have a result greater than 300000
what might this be about?
Should I always do extra checks against this problem?
it is 32 bit VCL application.
I use Delphi 10.4.1( its indy version 10.6.2.0 )
Running on: 64 bit Windows Server 2012 R2 Foundation / intel xeon cpu E3-1225 v5 3.3 Ghz.
The code structure is as follows:
TMyClass = class
private
//.............
lastSetTime: uint64;
critic: TCriticalSection;
public
//.............
procedure setLastSetTime( ltime: uint64 );
function getLastSetTime: uint64;
end;
procedure TMyClass.setLastSetTime( ltime: uint64 );
begin
critic.enter;
try
lastSetTime := ltime;
finally
critic.leave;
end;
end;
function TMyClass.getLastSetTime: uint64;
begin
critic.enter;
try
result := lastSetTime;
finally
critic.leave;
end;
end;
...........
procedure controlAll(); //------>this is called from within thread every 5 minutes
var oki: boolean;
starttime, tdiff, ltime: uint64;
i: integer;
myC, sC: TMyClass;
begin
oki := false;
starttime := ticks64();
while ( oki = false ) and ( gettickdiff64( starttime, ticks64 ) < 40000 ) do
begin
//.........
//.........
sC := nil;
with myClassList.LockList do
try
if count > 0 then //---> has about 50000
begin
i := 0;
while i < count do
begin
myC := TMyClass( items[ i ] );
ltime := myC.getLastSetTime();
tdiff := gettickdiff64( ltime, ticks64() );
if tdiff > 50000 then
begin
logToFile( tdiff.ToString + ' ' + ltime.ToString ); //-----> every 5 minutes 50-60 log lines occur like this: 18446744073709551600 468528329
//..........
//.........
sC := myC;
delete( i );
break;
end;
inc( i );
end;
end;
finally
myClassList.UnlockList;
end;
if sC = nil then oki := true
else
begin
//..........
//..........
end;
end;
end;
The code structure that sets this value is as follows.
classListArray keeps all classes of TMyClass type grouped by server and channel number.
myClassList keeps all classes of type TMyClass attached one after the other without grouping.
classListArray is used to spend less CPU and process faster.
These two lists are not protected against each other when accessing classes.
Protection against each other is done only when adding and deleting classes.
classListArray: array[ 1..250, 1..12 ] of TThreadList;
//.................
procedure ServerExecute(AContext: TIdContext);
var Ath: TMypeer;
severNum, channelNum, clientNum, i, j, num: integer;
pSize: word;
stream: Tmemorystream;
packageNum: byte;
begin
try
Ath := TMypeer( AContext );
serverNum := Ath.getServerNum();
channelNum := Ath.getChannelNum();
Ath.SendQueue();
if AContext.Connection.IOHandler.InputBufferIsEmpty then
if not AContext.Connection.IOHandler.CheckForDataOnSource( 50 ) then Exit;
clientNum := AContext.Connection.IOHandler.ReadInt32( false );
pSize := AContext.Connection.IOHandler.ReadUInt16( false );
stream := TMemorystream.create;
try
AContext.Connection.IOHandler.ReadStream( stream, pSize );
stream.Seek( 0, soFromBeginning );
if clientNum <> 0 then
begin
//...........
end
else
begin
stream.ReadBuffer( packageNum, sizeof( packageNum ) );
if packageNum = 10 then
begin
stream.ReadBuffer( num, sizeof( num ) );
for i := 1 to num do
begin
stream.ReadBuffer( clientNum, sizeof( clientNum ) );
with classListArray[ serverNum, channelNum ].LockList do
try
if count > 0 then
for j := 0 to count - 1 do
begin
if TMyClass( items[ j ] ).getClientNum = clientNum then
begin
TMyClass( items[ j ] ).setLastSetTime( ticks64 ); //**********
break;
end;
end;
finally
classListArray[ serverNum, channelNum ].unLockList;
end;
end;
end
else
//.........
end;
finally
stream.free;
end;
except on e:exception do
begin
if E is Eidexception then raise
else
begin
logToFile( e.message );
//..........
end;
end;
end;
end;
According to your log, ltime was 468528329 and GetTickDiff64(ltime, Ticks64()) returned 18446744073709551600. Given the simple implementation of GetTickDiff64() (where TIdTicks is UInt64):
function GetTickDiff64(const AOldTickCount, ANewTickCount: TIdTicks): TIdTicks;
{$IFDEF USE_INLINE}inline;{$ENDIF}
begin
{This is just in case the TickCount rolled back to zero}
if ANewTickCount >= AOldTickCount then begin
Result := TIdTicks(ANewTickCount - AOldTickCount);
end else begin
Result := TIdTicks(((High(TIdTicks) - AOldTickCount) + ANewTickCount) + 1);
end;
end;
The only way this code can return 18446744073709551600 given AOldTickCount=468528329 is if ANewTickCount is either 18446744074178079929 or 468528313.
Since VCL runs on Windows only, and on Windows Ticks64() is just a thin wrapper around the Win32 GetTickCount64() function on Vista and later, it is very unlikely that Windows would ever produce such an astronomically large number like 18446744074178079929 for the current tick counter (that would be 213503982340 days from bootup). So it must have returned 468528313 instead, which is more reasonable (that is just 5.4 days from bootup). That is 16ms less than ltime=468528329, so GetTickDiff64() would assume that Windows' tick counter had exceeded High(UInt64) and wrapped back around to 0 (which is unlikely for a 64-bit tick counter to ever do in our lifetime).
So, you need to debug your code and figure out how Ticks64()/Windows could possibly return 468528329 and then later return 468528313. I suspect it is really not doing that, and that there is more likely a bug in your code that we can't see which is storing the wrong value into TMyClass.lastSetTime to begin with.
That being said, you might consider getting rid of the overhead of TCriticalSection and use TInterlocked instead to read/write your UInt64 member atomically.
Or, try using Delphi's own TStopWatch instead of tracking ticks manually.
Im having problems with this code, I have two file of char, one is filed with information about books, and the other is empty, i have to write in SAL some information from S and then show the total of how many books match the first 2 digits of the code and how many are R and how many are T. The code, does write the information form S to Sal, but when its supposed to show the totals it appears ERORR 100 on screen. I read about it and it says that it is a problem with 'Disk read error' and that *This error typically occurs, if you "seed" a non-existent record of a typed file and try to read/write it. *, i really dont undertand.
I've benn trying to figure it out, but I haven't been able to. I notice that if I dont put 'WHILE NOT EOF(S) DO' the error does not appear, but of course i need the while, if someone is able to point out my mistakes i would really apreciate it.
This is the code:
uses crt;
var
i : byte;
s,sal: file of char;
v,l1,l2: char;
cs,cn,cl: integer;
pn,ps,tot: integer;
BEGIN
cs:=0; cn:=0; i:=0; cl:=0;
Assign (s, 'C:\Users\te\Documents\s.txt');
{$I-}
Reset (s);
{$I+}
if IOResult <> 0 then
begin
writeln('Error');
halt(2);
end;
Assign (sal, 'C:\Users\te\Documents\sal.txt');
{$I-}
Rewrite (sal);
IOResult;
{$I+}
if IOResult <> 0 then
halt(2);
writeln('Please write the code of the book, only 2 digits');
read(L1);read(L2);
read(s,v);
while (not eof(s)) do
begin
for i:=1 to 2 do
read(s,v);
if (v = '0') then
begin
read(s,v);
if (v = '1') or (v = '2') then
begin
for i:=1 to 5 do
read(s,v);
if (v = 'R') then
begin
read(s,v);
cs:= cs + 1;
end
else
begin
if (v = 'T') then
begin
cn:= cn + 1;
read(s,v);
end;
end;
while (v <> '-') do
read(s,v);
while (v = '-') do
read(s,v);
if (v = L1) then
begin
write(sal, v);
read(s,v);
if (v = L2) then
begin
write(sal,v);
read(s,v);
cl:= cl + 1;
end;
end;
while ( v <> '/') do
begin
write(sal,v);
read(s,v);
end;
write(sal, '-');
end
else
begin
for i:= 1 to 5 do
read(s,v);
if (v = 'R') then
cs:= cs + 1
else
cn:= cn + 1;
if (v = L1) then
read(s,v);
if (v = L2) then
begin
cl:= cl + 1;
read(s,v);
end;
end;
end
else
begin
for i:= 1 to 5 do
read(s,v);
if (v = 'R') then
cs:= cs + 1
else
cn:= cn + 1;
if (v = L1) then
read(s,v);
if (v = L2) then
begin
cl:= cl + 1;
read(s,v);
end;
end;
end;
tot:= cs + cn;
ps:= (cs * 100) div tot;
pn:= (cn * 100) div tot;
writeln('TOTAL ',cl);
writeln();
writeln(ps,'% and',pn,'%');
The file S content:
02022013Rto kill a mockingbird-1301/02012014Tpeter pan-1001/02032013Thowto-2301/02012012Tmaze runner-1001/02012012Tmaze runner-1001/02012012Tmaze runner-1001/$
I really just need someone else's point of view on this code, I think maybe the algorithm is flawed.
Thanks
(After your edit, i see that your code now compiles w/o error in FPC, so I'm glad you've managed to fix the error yourself)
As this is obviously coursework, I'm not going to fix your code for you and in any case the wayEven so, I'm afraid you are going about this is completely wrong.
Basically, the main thing wrong with your code is that you are trying to control what happens as your read the source file character by character. Quite frankly, that's a hopeless way of trying to do it, because it makes the execution flow unnecessarily complicated and littered with ifs, buts and loops. It also requires you to keep mental track of what you are trying to do at any given step, and the resulting code is inherently not self-documenting - imagine if you came back to your code in six months, could you tell at a glance how it works and what it does? I certsinly couldn't personally.
You need to break the task down in a different way. Instead of analysing the problem from the bottom up ("If I read this character next, then what I need to do next is ...') do it from the top down: Although your input file is a file of char, it contains a series of strings, separated by a / character and finally terminated by a $ (but this terminator does not really matter). So what you need to do is to read these strings one-by-one; once you've got one, check whether it's the one you're looking for: if it is. process it however you need to, otherwise read the next one until you reach the end of the file.
Once you have successfully read one of the book strings, you can then split it up into the various fields it's composed of. The most useful function for doing this splitting is probably Copy, which lets you extract substrings from a string - look it up in the FPC help. I've included functions ExtractTitle and ExtractPreamble which show you what you need to do to write similar functions to extract the T/R code and the numeric code which follows the hyphen. Btw, if you need to ask a similar q in the future, it would be very helpful if you include a description of the layout and meaning of the various fields in the file.
So, what I'm going to show you is how to read the series of strings in your S.Txt by building them character-by-character. In the code below, I do this using a function GetNextBook which I hope is reasonable self-explanatory. The code uses this function in a while loop to fill the BookRecord string variable. Then, it simply writes the BookRecord to the console. What your code should do, of course, is to process the BookRecord contents to see if it is the one you are looking for and then do whether the remainder of your task is.
I hope you will agree that the code below is a lot clearer, a lot shorter and will be a lot easier to extend in future than the code in your q. They key to structuring a program this way is to break the program's task into a series of functions and procedures which each perform a single sub-task. Writing the program that way makes it easier to "re-wire" the program to change what it does, without having to rewrite the innards of the functions/procedures.
program fileofcharproject;
uses crt;
const
sContents = '02022013Rto kill a mockingbird-1301/02012014Tpeter pan-1001/02032013Thowto-2301/02012012Tmaze runner-1001/02012012Tmaze runner-1001/02012012Tmaze runner-1001/$';
InputFileName = 'C:\Users\MA\Documents\S.Txt';
OutputFileName = 'C:\Users\MA\Documents\Sal.Txt';
type
CharFile = File of Char; // this is to permit a file of char to be used
// as a parameter to a function/procedure
function GetNextBook(var S : CharFile) : String;
var
InputChar : Char;
begin
Result := '';
InputChar := Chr(0);
while not Eof(S) do begin
Read(S, InputChar);
// next, check that the char we've read is not a '/'
// if it is a '/' then exit this while loop
if (InputChar <> '/') then
Result := Result + InputChar
else
Break;
end;
end;
function ExtractBookTitle(BookRecord : String) : String;
var
p : Integer;
begin
Result := Copy(BookRecord, 10, Length(BookRecord));
p := Pos('-', Result);
if p > 0 then
Result := Copy(Result, 1, p - 1);
end;
procedure AddToOutputFile(var OutputFile : CharFile; BookRecord : String);
var
i : Integer;
begin
for i := 1 to Length(BookRecord) do
write(OutputFile, BookRecord[i]);
write(OutputFile, '/');
end;
function ExtractPreamble(BookRecord : String) : String;
begin
Result := Copy(BookRecord, 1, 8);
end;
function TitleMatches(PartialTitle, BookRecord : String) : Boolean;
begin
Result := Pos(PartialTitle, ExtractBookTitle(BookRecord)) > 0;
end;
var
i : Integer; //byte;
s,sal: file of char;
l1,l2: char;
InputChar : Char;
BookFound : Boolean;
cs,cn,cl: integer;
pn,ps,tot: integer;
Contents : String;
BookRecord : String;
PartialTitle : String;
begin
// First, create S.Txt so we don't have to make any assumptions about
// its contents
Contents := sContents;
Assign(s, InputFileName);
Rewrite(s);
for i := 1 to Length(Contents) do begin
write(s, Contents[i]); // writes the i'th character of Contents to the file
end;
Close(s);
cs:=0; cn:=0; i:=0; cl:=0;
// Open the input file
Assign (s, InputFileName);
{$I-}
Reset (s);
{$I+}
if IOResult <> 0 then
begin
writeln('Error');
halt(2);
end;
// Open the output file
Assign (sal, OutputFileName);
{$I-}
Rewrite (sal);
IOResult;
{$I+}
if IOResult <> 0 then
halt(2);
// the following reads the BookRecords one-by-one and copies
// any of them which match the partial title to sal.txt
writeln('Enter part of a book title, followed by [Enter]');
readln(PartialTitle);
while not Eof(s) do begin
BookRecord := GetNextBook(S);
writeln(BookRecord);
writeln('Preamble : ', ExtractPreamble(BookRecord));
writeln('Title : ', ExtractBookTitle(BookRecord));
if TitleMatches(PartialTitle, BookRecord) then
AddToOutputFile(sal, BookRecord);
end;
// add file '$' to sal.txt
write(sal, '$');
Close(sal);
Close(s);
writeln('Done, press any key');
readln;
end.
I am attempting to write a comment stripper in pascal. I run my code and pass it a C source code file and it strips the comments from the file and prints the result to terminal.
I am fairly new to pascal. I am getting some very strange output and I cannot figure out why. The code checks for comments line by line and prints characters one at a time. The comment stripper is printing what seems to be random characters whenever it reaches the start of a new line. I am using pascals Write(Str[i]) function to print characters and WriteLn() once the end of a line is reached.
I have no idea why im receiving weird output. I am running Linux Mint and can compile and run my code, but I receive this strange output. I also tried running my code on a Mac and received a run-time error:
Program Path: ./Assignment1
File Name: lol.c
Runtime error 2 at $00011532
$00011532
$0002F7F6
$000113FD
$00011328
$00000002
Here is my code
program Assignment1;
uses
Sysutils;
var UserFile : TextFile;
TString : String;
OLine : String;
i : integer;
isComment : boolean;
skip : boolean;
begin
{$I+}
WriteLn('Program Path: ', ParamStr(0));
WriteLn('File Name: ', ParamStr(1));
Assign(UserFile, ParamStr(1) + '.c');
Reset(UserFile);
isComment := false;
skip := true;
Repeat
Readln(UserFile, TString);
for i:= 0 to ((Length(TString) - 1)) do
begin
if(skip) then
begin
skip := false;
continue;
end;
if(isComment = false) Then
begin
if(TString[i] = '/') Then
begin
if(TString[i+1] = '/') Then
begin
break;
end
else if(TString[i+1] = '*') Then
begin
isComment := true;
skip := true;
continue;
end;
end;
Write(TString[i]);
if(i = Length(TString) - 1) Then
begin
Write(TString[i + 1]);
end;
end
else
begin
if(TString[i] = '*') Then
begin
if(TString[i + 1] = '/') Then
begin
isComment := false;
skip := true;
continue;
end;
end;
end;
end;
WriteLn();
Until Eof(UserFile);
end.
I receive random characters which range from standard keyboard symbols to unicode blocks such as the ones found here.
Does anyone have any suggestions?
As 500 - Internal Server Error says, Pascal strings are 1-based. Your references to slot zero are returning garbage. If these are 256-byte strings you're getting the length code, I don't recall the memory layout of the pointer-based strings to know what you're getting in that case. You're also losing the last character of every string because of this.
Beyond that I see a definite bug: Look at what happens with a line ending in /
I also do not understand this:
if(i = Length(TString) - 1) Then
begin
Write(TString[i + 1]);
end;
It seems to me it's writing an extra character but I'm not sure.
I have been making a program in Delphi and what I am trying to do is set up me game with a 'save file'. I have been doing this in Delphi and not when I bring the code home I am just using a pascal compiler and I cannot seem to run my program as I get the following errors
Free Pascal Compiler version 2.6.2-8 [2014/01/22] for x86_64
Copyright (c) 1993-2012 by Florian Klaempfl and others
Target OS: Linux for x86-64
Compiling control.p
control.p(44,12) Error: Identifier not found "CloseFile"
control.p(116,14) Error: Identifier not found "closeFile"
control.p(127,13) Error: Identifier not found "assignFile"
control.p(143,4) Fatal: There were 3 errors compiling module, stopping
Fatal: Compilation aborted
Error: /usr/bin/ppcx64 returned an error exitcode (normal if you did not specify a source file to be compiled)
Sorry if this is a stupid question but I am new to files and I really want this to work. Below is all of my current code just in case you need it, sorry if its confusing its a draft and thanks for helping.
program Task3;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
Type
gameRec = record
name: string[30];
skill: integer;
str: integer;
modif: integer;
sskill: string[3];
sstr: string[3];
smodif: string[3];
sf: integer;
ssf : string[1];
end;
var
gameFile : file of gameRec;
p1, p2 : gameRec;
procedure showStats;
begin
FileMode := fmOpenRead;
Reset(gameFile);
read(gameFile, p1);
read(gameFile, p2);
writeln;
writeln(p1.name, '''s stats');
writeln('Skill: ', p1.skill);
writeln('Strenght: ', p1.str);
writeln('Modifier: ', p1.modif);
writeln;
writeln(p2.name, '''s stats');
writeln('Skill: ', p2.skill);
writeln('Strenght: ', p2.str);
writeln('Modifier: ', p2.modif);
writeln;
CloseFile(gameFile);
end;
procedure resetsf;
var
ran12, ran4, namelen: integer;
namepass: boolean;
name: string;
begin
writeln('No save file detected, generating new stats');
namelen := 0;
namepass := false;
repeat
write('What is player 1''s name: ');
readln(name);
namelen := length(name);
if (namelen > 2) and (namelen < 30) then
begin
p1.name := name;
namepass := true;
end
else
writeln('You name must be between 3 and 30 characters');
until namepass = true;
namepass := false;
repeat
write('What is player 2''s name: ');
readln(name);
namelen := length(name);
if (namelen > 2) and (namelen < 30) then
begin
p2.name := name;
namepass := true;
end
else
writeln('You name must be between 3 and 30 characters');
until namepass = true;
ran12 := random(12) + 1;
ran4 := random(4) + 1;
p1.skill := 10 + (ran12 div ran4);
ran12 := random(12) + 1;
ran4 := random(4) + 1;
p1.str := 10 + (ran12 div ran4);
ran12 := random(12) + 1;
ran4 := random(4) + 1;
p2.skill := 10 + (ran12 div ran4);
ran12 := random(12) + 1;
ran4 := random(4) + 1;
p2.str := 10 + (ran12 div ran4);
reWrite(gameFile);
p1.sskill := inttostr(p1.skill); //debug
p1.sstr := inttostr(p1.str);
p1.smodif := inttostr(p1.modif);
//write(gameFile,p1);
p2.sskill := inttostr(p2.skill);
p2.sstr := inttostr(p2.str);
p2.smodif := inttostr(p2.modif); //debug
write(gameFile,p2);
p1.sf := 1;
p1.ssf := inttostr(p1.sf);
write(gameFile,p1); //debug
closeFile(gameFile);
FileMode := fmOpenRead;
Reset(gameFile);
read(gameFile, p1);
read(gameFile, p2);
end;
begin
assignFile(gameFile, 'N:\gamerec.dat');
randomize;
writeln('Game :)');
writeln('By Sam Collins');
writeln;
FileMode := fmOpenRead;
Reset(gameFile);
read(gameFile, p1);
writeln(p1.sf);
if p1.sf = 0 then
resetsf
else
writeln('Save file detected using old stats');
showStats;
readln;
end.
If you want delphi compatibility, put the compiler in Delphi mode, either by compiling with -Sd or adding {$mode Delphi} to the source (somewhere at the top, e.g. near the $apptype).
Then closefile() and assignfile() will be accepted. The default dialect is turbo pascal. Lazarus puts FPC in objfpc (which is also delphi alike) by default.
Closefile is in an unit (objpas) with system unit enhancements that is only in scope in Delphi or objfpc modi.
Using namespaces (SYSTEM.sysutils instead of sysutils) might be dangerous too. Better simplify to sysutils. Namespaces is an Delphi extension that only got significant use with Delphi XE2.
I tested, and removing the {$R *.res}, the removal of system. before sysutils and -Sd makes the code compile
If I understood the question correctly, you want to port a piece of code from Delphi to Free Pascal and you have problems with file operations.
In Free (and Turbo) Pascal, file handling is much more easier than in Delphi: in Pascal we have Assign instead of AssignFile and Close instead of CloseFile . The syntax for these two procedures can be found in the help system.
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.