* * *

Recent Posts

Pages: [1] 2 3 ... 10
1
Beginners / Re: Detailed Information on testing the compiler
« Last post by Bart on Today at 07:18:46 pm »
What do you mean with "testing the compiler"?

It runs, it compiles.
It does that on many different platforms and operating systems.

Bart
2
Beginners / Detailed Information on testing the compiler
« Last post by SaintMichael57 on Today at 07:09:36 pm »
Dear FreePascal Community:
     Could someone please tell me where I can find detailed information for testing the FreePascal compiler?  I am running the
Windows 10 operating system, using the v. 3.0.4 compiler.  My "chip"
is an AMD Athlon II X2 chip.  Thank you.
3
General / Re: Fix my code
« Last post by Bart on Today at 07:09:04 pm »
Here's a Semi-Enterprise version.
(For real Enterprise it needs Classes, Singletons, a RDBMS, a RectangleFactory and Enterprise style logging, I leave that up to you.)

Common types and constants:
Code: Pascal  [Select]
  1. unit rshared;
  2. {$modeswitch advancedrecords}
  3.  
  4. interface
  5.  
  6. type
  7.  
  8.   { TRectangle }
  9.  
  10.   TRectangle = record
  11.     Length, Width: DWORD; //unsigned 32-bit
  12.     function Area: UInt64;
  13.   end;
  14.   TRectangleArr = array of TRectangle;
  15.  
  16. const
  17.     RectangleFilename = 'rectangle.dat';
  18.  
  19. implementation
  20.  
  21. { TRectangle }
  22.  
  23. function TRectangle.Area: UInt64;
  24. begin
  25.   Result := UInt64(Self.Length) * UInt64(Self.Width);
  26. end;
  27.  
  28. end.

Creating the rectangles:

Code: Pascal  [Select]
  1. program rwrite;
  2.  
  3. {$mode objfpc}
  4. {$h+}
  5.  
  6. uses
  7.   crt, sysutils, classes, rshared;
  8.  
  9. const
  10.   prLength = 'Enter length for rectangle %d';
  11.   prWidth = 'Enter width for rectangle %d';
  12.   prRectangles = 'Enter length and width for your rectangles. Enter zero to quit.';
  13.   FileWriteErrorMsg = 'Error writing data to %s.';
  14.  
  15. function PromptForInteger(const APrompt: String; X: Integer = -1; Y: Integer = -1): Integer;
  16. var
  17.   Ans, Err: String;
  18.   OK: Boolean;
  19. begin
  20.   if (X < 0) then X := WhereX;
  21.   if (Y < 0) then Y := WhereY;
  22.   Err := '';
  23.   repeat
  24.     GotoXY(X,Y);
  25.     ClrEol;
  26.     write(Err,APrompt,': ');
  27.     readln(Ans);
  28.     OK := TryStrToInt(Ans, Result);
  29.     if not OK then Err := Format('"%s" is not a valid value, try again. ',[Ans]);
  30.   until OK;
  31. end;
  32.  
  33. function PromptForRectangles(const APrompt: String; X: Integer = -1; Y: Integer = -1): TRectangleArr;
  34. var
  35.   L, W: Integer;
  36. begin
  37.   SetLength(Result,0);
  38.   if (X < 0) then X := WhereX;
  39.   if (Y < 0) then Y := WhereY;
  40.   GotoXY(X,Y);
  41.   ClrEol;
  42.   writeln(APrompt);
  43.   Inc(Y);
  44.   repeat
  45.     L := PromptForInteger(Format(prLength,[Length(Result)+1]), 1, Y);
  46.     if (L > 0) then
  47.     begin
  48.       W := PromptForInteger(Format(prWidth,[Length(Result)+1]), 1, Y);
  49.       if (W > 0) then
  50.       begin
  51.         SetLength(Result, Length(Result)+1);
  52.         Result[High(Result)].Length := L;
  53.         Result[High(Result)].Width := W;
  54.       end;
  55.     end;
  56.   until (L <=0) or (W <= 0);
  57. end;
  58.  
  59. procedure WriteRectangles(TheRectangles: TRectangleArr; const Filename: String);
  60. var
  61.   SL: TStringList;
  62.   i: Integer;
  63. begin
  64.   SL := TStringList.Create;
  65.   try
  66.     for i := 0 to Length(TheRectangles) - 1 do
  67.     begin
  68.       SL.Add(Format('%d %d',[TheRectangles[i].Length, TheRectangles[i].Width]));
  69.     end;
  70.     SL.SaveToFile(Filename);
  71.   finally
  72.     SL.Free;
  73.   end;
  74. end;
  75.  
  76. var
  77.   Rectangles: TRectangleArr;
  78.  
  79. begin
  80.   ClrScr;
  81.   Rectangles := PromptForRectangles(prRectangles, 1, 1);
  82.   try
  83.     WriteRectangles(Rectangles, RectangleFilename);
  84.   except
  85.     GotoXY(1, WhereY+1);
  86.     writeln(Format(FileWriteErrorMsg,[RectangleFilename]));
  87.     ExitCode := 1;
  88.   end;
  89. end.

Displaying rectangles:

Code: Pascal  [Select]
  1. program rread;
  2.  
  3. {$mode objfpc}
  4. {$h+}
  5.  
  6. uses
  7.   crt, sysutils, classes, rshared;
  8.  
  9. type
  10.   EInvalidData = class(Exception);
  11.  
  12. const
  13.   FileReadErrorMsg = 'Error reading data from %s.';
  14.   InvalidDataAtLine = 'Invalid length or width at line %d (data is: "%s")';
  15.   MissingWidthAtLine = 'Missing width at line %d (data is: "%s")';
  16.   NoData = 'There are no data to display.';
  17.   RectangleDims = 'length = %8u, width = %8u, area = %16u.';
  18.   DisplayMsg = 'Displaying rectangles';
  19.  
  20.  
  21. function GetRectangles(const AFilename: String): TRectangleArr;
  22. var
  23.   SL: TStringList;
  24.   i: Integer;
  25.   S, StrL, StrW: String;
  26.   P: SizeInt;
  27. begin
  28.   SetLength(Result, 0);
  29.   SL := TStringList.Create;
  30.   try
  31.     SL.LoadFromFile(AFilename);
  32.     for i := 0 to SL.Count - 1 do
  33.     begin
  34.       S := SL[i];
  35.       if (S <> '') then
  36.       begin
  37.         SetLength(Result, Length(Result)+1);
  38.         P := Pos(#32, S);
  39.         if (P = 0) then
  40.           Raise EInvalidData.CreateFmt(MissingWidthAtLine,[i+1,S]);
  41.         StrL := Copy(S,1,P-1);
  42.         StrW := Copy(S,P,MaxInt);
  43.         if not (TryStrToDWord(StrL, Result[High(Result)].Length)
  44.                 and TryStrToDWord(StrW, Result[High(Result)].Width)) then
  45.           Raise EInvalidData.CreateFmt(InvalidDataAtLine,[i+1,S]);
  46.       end;
  47.     end;
  48.   finally
  49.     SL.Free;
  50.   end;
  51. end;
  52.  
  53. procedure DisplayRectangles(TheRectangles: TRectangleArr; const AMsg: String; X: Integer = -1; Y: Integer = -1);
  54. var
  55.   i: Integer;
  56. begin
  57.   if (X < 0) then X := WhereX;
  58.   if (Y < 0) then Y := WhereY;
  59.   GotoXY(X,Y);
  60.   ClrEol;
  61.   writeln(AMsg);
  62.   if (Length(TheRectangles) > 0) then
  63.   begin
  64.     for i := 0 to Length(TheRectangles) - 1 do
  65.     begin
  66.       write(Format('# %d: ',[i+1]));
  67.       writeln(Format(RectangleDims,[TheRectangles[i].Length, TheRectangles[i].Width, TheRectangles[i].Area]));
  68.     end;
  69.   end
  70.   else
  71.     writeln(NoData);
  72. end;
  73.  
  74. var
  75.   Rectangles: TRectangleArr;
  76. begin
  77.   ClrScr;
  78.   try
  79.     Rectangles := GetRectangles(RectangleFilename);
  80.   except
  81.     on E: EStreamError do
  82.     begin
  83.       writeln(Format(FileReadErrorMsg,[RectangleFilename]));
  84.       ExitCode := 2;
  85.     end;
  86.     on E: EInvalidData do
  87.     begin
  88.       writeln(Format('%s: %s',[RectangleFilename, E.Message]));
  89.       ExitCode := $FF;
  90.     end;
  91.   end;
  92.   DisplayRectangles(Rectangles, DisplayMsg, 1, 1);
  93. end.

I dare you to submit that in class   O:-) O:-)

Bart
4
General / Generating OpenSSL keys using TProcess
« Last post by torbente on Today at 07:00:47 pm »
I created this function:

Code: Pascal  [Select]
  1. Function CreateKeysPair(KeyBits:Integer):Boolean;
  2. var
  3.   MyProcess, MyProcess2 : TProcess;
  4. Begin
  5. //Generates the private
  6. MyProcess:= TProcess.Create(nil);
  7. MyProcess.Executable := 'c:\OpenSSL-Win32\bin\openssl.exe';
  8. MyProcess.Parameters.Add('genrsa');
  9. MyProcess.Parameters.Add('-out');
  10. MyProcess.Parameters.Add('DATA/private.pem');
  11. MyProcess.Parameters.Add(IntToStr(KeyBits));
  12. MyProcess.Options := MyProcess.Options + [poWaitOnExit, poUsePipes, poNoConsole];
  13. MyProcess.Execute;
  14. // Extract public key
  15. MyProcess2:= TProcess.Create(nil);
  16. MyProcess2.Executable := 'c:\OpenSSL-Win32\bin\openssl.exe';
  17. MyProcess2.Parameters.Add('rsa');
  18. MyProcess2.Parameters.Add('-in DATA/private.pem');
  19. MyProcess2.Parameters.Add('-pubout');
  20. MyProcess2.Parameters.Add('-out DATA/public.pem');
  21. MyProcess2.Options := MyProcess2.Options + [poWaitOnExit, poUsePipes, poNoConsole];
  22. MyProcess2.Execute;
  23. if ((FileExists('DATA/private.pem')) and (FileExists('DATA/public.pem'))) then result := true
  24. else result := false;
  25. End;

The private key is created as expected, but the public is not extracted. I tried with TProcess.Environment values for OpenSSL but i was unable to figure out a solution. I also tried with AppFolder/data/private.pem but nothing.
5
Beginners / Re: Package does not show its members
« Last post by mb on Today at 06:42:00 pm »
Thank you very very much, also for your detailed explanation, that solved my problem.
Adding Unit2(from package) into my Unit1(project) solved my problem.

I thought this is not necessary, because all units are included in unit-clause of that package-unit, but it makes sense that it works this way. Other units of a package are not passed-through this package-unit.

Thanks again for this great help !!

I bought 3 books for FPC and Lazarus, but no where (even on YouTube) I found such an easy explaination or way how to use those units you "combined" in a package.
6
General / How can I install a package?
« Last post by lulZghost on Today at 06:40:45 pm »
I want to install the package "tsmbios" into Lazarus. On the sample Code in GitHub it says
Code: Pascal  [Select]
  1. uSMBIOS in '..\..\Common\uSMBIOS.pas';
. So, the "Common" folder is on GitHub, but where am I supposed to put it? I tried putting it in the project folder and using
Code: Pascal  [Select]
  1. uSMBIOS in '\Common\uSMBIOS.pas';
but thats also not working.
7
Linux / Re: Installing Lazarus 1.8.4 on Ubuntu 18.04
« Last post by Heriberto_Paula on Today at 06:09:17 pm »
There is no need to restart Linux, Everyone has to know that Linux is not Windows to restart.
With a single command I installed the versions informed using the Terminal without needing to install Gdebi nor Synaptic:

Quote
sudo dpkg -i *.deb

The deb files should all be in a folder and the terminal also

Sorry if the translation was not good (Google Translate).

I have been a Linux expert for many years.
8
General / Re: optimization switches not working?
« Last post by Thaddy on Today at 06:09:06 pm »
Your program will link against - at minimum - the rtl.
The rtl is not optimzed beyond -O2 to facilitate debugging while maintaining safe optimizations, optimizations without side effects.
So if you want full optimization, you also need to optimize the rtl and all other packages that you use.

It is not rocket science and was already well explained to you....
9
General / Re: Some problems in Lazarus 1.8.4 that I had
« Last post by Seingalt on Today at 06:07:46 pm »
10
Win32/64 / Re: Caret stops blinking after a few seconds
« Last post by Dr.Theopolis on Today at 05:50:14 pm »
The issue might not have anything to do with TKMemo component. I am looking into it and will probably start a new topic if I have questions.
Pages: [1] 2 3 ... 10

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus