utf8 failure while receive RS232
lazarus / 1-Linux

----------------------------------------------------------------------
coradi · 2025-08-14 20:00

I try to read UART /RS232, it receive Data but i see only many
messages of

project1:3710): Gtk-CRITICAL **: 21:59:31.829:
gtk_text_buffer_emit_insert: assertion 'g_utf8_validate (text, len,
NULL)' failed

(project1:3710): Gtk-CRITICAL **: 21:59:31.837:
gtk_text_buffer_emit_insert: assertion 'g_utf8_validate (text, len,
NULL)' failed

(project1:3710): Gtk-CRITICAL **: 21:59:31.845:
gtk_text_buffer_emit_insert: assertion 'g_utf8_validate (text, len,
NULL)' failed

(project1:3710): Gtk-CRITICAL **: 21:59:31.855:
gtk_text_buffer_emit_insert: assertion 'g_utf8_validate (text, len,
NULL)' failed

(project1:3710): Gtk-CRITICAL **: 21:59:31.861:
gtk_text_buffer_emit_insert: assertion 'g_utf8_validate (text, len,
NULL)' failed


Code: [Select]unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    ButtonStart: TButton;
    Memo1: TMemo;
    Timer1: TTimer;
    procedure ButtonStartClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { private declarations }
    FSerialFile: Text;
    FPortOpen: Boolean;
    FDevice: string;
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure TForm1.ButtonStartClick(Sender: TObject);
begin
  FDevice := '/dev/ttyUSB0';

  // Seriellen Port öffnen
  AssignFile(FSerialFile, FDevice);
  {$I-}
  Reset(FSerialFile);
  {$I+}
  if IOResult <> 0 then
  begin
    ShowMessage('Fehler: Konnte ' + FDevice + ' nicht öffnen.');
    Exit;
  end;

  FPortOpen := True;
  Timer1.Interval := 100;  // 100 ms Intervall
  Timer1.Enabled := True;

  Memo1.Lines.Add('Port ' + FDevice + ' geöffnet, lese
kontinuierlich...');
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Line: string;
begin
  if FPortOpen then
  begin
    {$I-}
    while not Eof(FSerialFile) do
    begin
      ReadLn(FSerialFile, Line);
      Memo1.Lines.Add(Line);
      Memo1.SelStart := Memo1.GetTextLen;  // automatisch nach unten
scrollen
    end;
    {$I+}
    if IOResult <> 0 then
    begin
      Memo1.Lines.Add('Fehler beim Lesen.');
      Timer1.Enabled := False;
      FPortOpen := False;
      CloseFile(FSerialFile);
    end;
  end;
end;

end.

----------------------------------------------------------------------
coradi · 2025-08-14 20:09

ok, Chatgpt helped me, now I have this
"Memo1.Lines.Add(MakePrintable(Line)); "

Functio MakePrintable
Code: [Select]function MakePrintable(const S: string): string;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to Length(S) do
    if S[i] in [#32..#126, #10, #13] then
      Result := Result + S[i]
    else
      Result := Result + '.'; // nicht druckbare Zeichen durch Punkt
ersetzen
end;

Code: [Select]unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    ButtonStart: TButton;
    Memo1: TMemo;
    Timer1: TTimer;
    procedure ButtonStartClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { private declarations }
    FSerialFile: Text;
    FPortOpen: Boolean;
    FDevice: string;
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

function MakePrintable(const S: string): string;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to Length(S) do
    if S[i] in [#32..#126, #10, #13] then
      Result := Result + S[i]
    else
      Result := Result + '.'; // nicht druckbare Zeichen durch Punkt
ersetzen
end;

procedure TForm1.ButtonStartClick(Sender: TObject);
begin
  FDevice := '/dev/ttyUSB0';

  // Seriellen Port öffnen
  AssignFile(FSerialFile, FDevice);
  {$I-}
  Reset(FSerialFile);
  {$I+}
  if IOResult <> 0 then
  begin
    ShowMessage('Fehler: Konnte ' + FDevice + ' nicht öffnen.');
    Exit;
  end;

  FPortOpen := True;
  Timer1.Interval := 100;  // 100 ms Intervall
  Timer1.Enabled := True;

  Memo1.Lines.Add('Port ' + FDevice + ' geöffnet, lese
kontinuierlich...');
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Line: string;
begin
  if FPortOpen then
  begin
    {$I-}
    while not Eof(FSerialFile) do
    begin
      ReadLn(FSerialFile, Line);
      Memo1.Lines.Add(MakePrintable(Line));
      //Memo1.Lines.Add(Line);
      Memo1.SelStart := Memo1.GetTextLen;  // automatisch nach unten
scrollen
    end;
    {$I+}
    if IOResult <> 0 then
    begin
      Memo1.Lines.Add('Fehler beim Lesen.');
      Timer1.Enabled := False;
      FPortOpen := False;
      CloseFile(FSerialFile);
    end;
  end;
end;

end.

the RS232 is reading and blinking, but I didn't see anything on the
screen?!
Console Outut is empty too

----------------------------------------------------------------------
coradi · 2025-08-14 20:15

ah ok, it is the missin/0 from RS232 ..now I have to see how this
works..
In C it worked on first try, but I am a bigger Idiot in C then ic
PAscal....

----------------------------------------------------------------------
coradi · 2025-08-14 20:26

I see nothing:-(
RX LED is blinking but I got nothing in console outoput
Code: [Select]unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls,
  DateUtils, BaseUnix;

type
  TForm1 = class(TForm)
    ButtonStart: TButton;
    Memo1: TMemo;
    Timer1: TTimer;
    procedure ButtonStartClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    FSerialHandle: LongInt;
    FPortOpen: Boolean;
    FDevice: string;
    DataBuffer: string;
    LastReceiveTime: TDateTime;
    procedure OpenSerialPort;
    procedure CloseSerialPort;
    function HexASCII(const S: string): string;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ Wandelt alle Bytes in ASCII-Punkte + Hex-Darstellung um }
function TForm1.HexASCII(const S: string): string;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to Length(S) do
  begin
    if S[i] in [#32..#126] then
      Result := Result + S[i]
    else
      Result := Result + '.';
    Result := Result + ' (' + IntToHex(Ord(S[i]),2) + ') ';
  end;
end;

{ Button: Port starten oder stoppen }
procedure TForm1.ButtonStartClick(Sender: TObject);
begin
  if not FPortOpen then
    OpenSerialPort
  else
    CloseSerialPort;
end;

{ Öffnet den seriellen Port }
procedure TForm1.OpenSerialPort;
begin
  FDevice := '/dev/ttyUSB0';

  FSerialHandle := fpOpen(FDevice, O_RDONLY or O_NONBLOCK);
  if FSerialHandle < 0 then
  begin
    ShowMessage('Fehler: Konnte ' + FDevice + ' nicht öffnen.');
    Exit;
  end;

  FPortOpen := True;
  Timer1.Enabled := True;
  DataBuffer := '';
  LastReceiveTime := Now;
  ButtonStart.Caption := 'Stoppen';
  Memo1.Lines.Add('Port ' + FDevice + ' geöffnet.');
end;

{ Schließt den seriellen Port }
procedure TForm1.CloseSerialPort;
begin
  if FPortOpen then
  begin
    Timer1.Enabled := False;
    fpClose(FSerialHandle);
    FPortOpen := False;
    ButtonStart.Caption := 'Starten';
    Memo1.Lines.Add('Port geschlossen.');
  end;
end;

{ Timer: kontinuierliches Lesen mit Timeout }
procedure TForm1.Timer1Timer(Sender: TObject);
var
  Buf: array[0..255] of Char;
  NumRead: LongInt;
  BufString: string;
  TimeoutMS: Integer = 100; // Pause = Ende der Nachricht
begin
  if not FPortOpen then Exit;

  NumRead := fpRead(FSerialHandle, Buf, SizeOf(Buf));
  if NumRead > 0 then
  begin
    SetString(BufString, Buf, NumRead);
    DataBuffer := DataBuffer + BufString;
    LastReceiveTime := Now;
  end;

  // Prüfen, ob seit letztem Byte > TimeoutMS vergangen ist
  if (DataBuffer <> '') and (MilliSecondsBetween(Now, LastReceiveTime)
> TimeoutMS) then
  begin
    Memo1.Lines.Add(HexASCII(DataBuffer));
    Memo1.SelStart := Memo1.GetTextLen; // automatisch scrollen
    DataBuffer := ''; // Puffer leeren
  end;
end;

end.

----------------------------------------------------------------------
coradi · 2025-08-14 20:29

If it try this
Code: [Select] if (DataBuffer <> '') and (MilliSecondsBetween(Now,
LastReceiveTime) > TimeoutMS) then
  begin
    databuffer := '123';
    Memo1.Lines.Add(HexASCII(DataBuffer));
    Memo1.SelStart := Memo1.GetTextLen; // automatisch scrollen
    DataBuffer := ''; // Puffer leeren   
[code]}
Nothing happend in Memo Windwos odr console output

----------------------------------------------------------------------
tetrastes · 2025-08-14 20:58

Why reinvent the wheel? There are serial in RTL, synaser in Synapse,
LazSerial, ...

----------------------------------------------------------------------
coradi · 2025-08-14 21:02

This C Code work without problems:-(
Code: [Select]#include <stdio.h>
#include <stdlib.h>
#include <fcntl.h>
#include <unistd.h>
#include <termios.h>

int main() {
    const char *device = "/dev/ttyUSB0";
    int fd = open(device, O_RDWR | O_NOCTTY);
    if (fd < 0) {
        perror("Konnte Port nicht öffnen");
        return 1;
    }

    // Seriellen Port konfigurieren
    struct termios options;
    tcgetattr(fd, &options);

    cfsetispeed(&options, B9600);
    cfsetospeed(&options, B9600);

    options.c_cflag &= ~PARENB; // keine Parität
    options.c_cflag &= ~CSTOPB; // 1 Stopbit
    options.c_cflag &= ~CSIZE;
    options.c_cflag |= CS8;     // 8 Datenbits
    options.c_cflag |= CREAD | CLOCAL;

    cfmakeraw(&options);        // Rohmodus
    tcsetattr(fd, TCSANOW, &options);

    printf("Warte auf Daten auf %s mit 9600 Baud...\n", device);

    char buf[256];
    while (1) {
        int n = read(fd, buf, sizeof(buf)-1);
        if (n > 0) {
            buf[n] = '\0';
            printf("Empfangen: %s", buf);
            fflush(stdout);
        } else {
            usleep(100000); // 100ms warten
        }
    }

    close(fd);
    return 0;
}[

----------------------------------------------------------------------
tetrastes · 2025-08-14 21:15

I see that you still want to reinvent the wheel...
Well, where is this
Code: C  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i     //
Seriellen Port konfigurieren    struct termios options;   
tcgetattr(fd, &options);     cfsetispeed(&options, B9600);   
cfsetospeed(&options, B9600);     options.c_cflag &= ~PARENB; // keine
Parität    options.c_cflag &= ~CSTOPB; // 1 Stopbit    options.c_cflag
&= ~CSIZE;    options.c_cflag |= CS8;     // 8 Datenbits   
options.c_cflag |= CREAD | CLOCAL;     cfmakeraw(&options);        //
Rohmodus    tcsetattr(fd, TCSANOW, &options);in your pascal code?

----------------------------------------------------------------------
coradi · 2025-08-14 22:36

thanks, no that's not the problem. RX is working i configured it in
bash at this moment)
No I know the timer is the problem I think
Code: [Select]nit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    ButtonStart: TButton;
    Label1: TLabel;
    Memo1: TMemo;
    Timer1: TTimer;
    procedure ButtonStartClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { private declarations }
    FSerialFile: Text;
    FPortOpen: Boolean;
    FDevice: string;
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

function MakePrintable(const S: string): string;
var i: Integer;
begin
  Result := '';
  for i := 1 to Length(S) do
    if S[i] in [#32..#126, #10, #13] then
      Result := Result + S[i]
    else
      Result := Result + '.'; // ersetzt ungültige Bytes
end;

function ToHex(const S: string): string;
var i: Integer;
begin
  Result := '';
  for i := 1 to Length(S) do
    Result := Result + IntToHex(Ord(S[i]), 2) + ' ';
end;

procedure TForm1.ButtonStartClick(Sender: TObject);
begin
   Memo1.Lines.Add('Hallo Welt');
   label1.Caption:='test';
   ButtonStart.caption:='test';

   sleep(500);
  FDevice := '/dev/ttyUSB0';

  // Seriellen Port öffnen
  AssignFile(FSerialFile, FDevice);
  {$I-}
  Reset(FSerialFile);
  {$I+}
  if IOResult <> 0 then
  begin
    ShowMessage('Fehler: Konnte ' + FDevice + ' nicht öffnen.');
    Exit;
  end;

  FPortOpen := True;
  Timer1.Interval := 100;  // 100 ms Intervall
  Timer1.Enabled := True;

  Memo1.Lines.Add('Port ' + FDevice + ' geöffnet, lese
kontinuierlich...');
end;



procedure TForm1.Timer1Timer(Sender: TObject);
var
  Line: string;
begin
    ButtonStart.caption:='123';
  if FPortOpen then
  begin
    {$I-}
        ButtonStart.caption:='123';
    while not Eof(FSerialFile) do
    begin

     Readln(FSerialFile, Line);
    line:='123';
     Memo1.Lines.Add(tohex(Line)); // oder ToHex(Line)
      Memo1.Lines.Add(Line);
      Memo1.SelStart := Memo1.GetTextLen;  // automatisch nach unten
scrollen
    end;
    {$I+}
    if IOResult <> 0 then
    begin
      Memo1.Lines.Add('Fehler beim Lesen.');
      Timer1.Enabled := False;
      FPortOpen := False;
      CloseFile(FSerialFile);
    end;
  end;
end;

end.
                 

The breakpoint in timer never incrase

----------------------------------------------------------------------
tetrastes · 2025-08-15 07:48

Quote from: coradi on August 15, 2025, 12:36:45 amNo I know the timer
is the problem I think
The breakpoint in timer never incrase

It's easy to test:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, StdCtrls, ExtCtrls; type   { TForm1 }  
TForm1 = class(TForm)    ButtonStart: TButton;    Label1: TLabel;   
Memo1: TMemo;    Timer1: TTimer;    procedure ButtonStartClick(Sender:
TObject);    procedure Timer1Timer(Sender: TObject);  private    {
private declarations }    FSerialFile: Text;    FPortOpen: Boolean;  
FDevice: string;  public    { public declarations }  end; var  Form1:
TForm1; implementation {$R *.lfm} function MakePrintable(const S:
string): string;var i: Integer;begin  Result := '';  for i := 1 to
Length(S) do    if S[i] in [#32..#126, #10, #13] then      Result :=
Result + S[i]    else      Result := Result + '.'; // ersetzt
ungültige Bytesend; function ToHex(const S: string): string;var i:
Integer;begin  Result := '';  for i := 1 to Length(S) do    Result :=
Result + IntToHex(Ord(S[i]), 2) + ' ';end; procedure
TForm1.ButtonStartClick(Sender: TObject);begin 
 Memo1.Lines.Add('Hallo Welt');   label1.Caption:='test'; 
 ButtonStart.caption:='test';    sleep(500);  FDevice :=
'/dev/ttyUSB0';   // Seriellen Port öffnen  //AssignFile(FSerialFile,
FDevice);  {$I-}  //Reset(FSerialFile);  {$I+}  if IOResult <> 0 then 
begin    ShowMessage('Fehler: Konnte ' + FDevice + ' nicht öffnen.'); 
  Exit;  end;   FPortOpen := True;  Timer1.Interval := 100;  // 100 ms
Intervall  Timer1.Enabled := True;   Memo1.Lines.Add('Port ' + FDevice
+ ' geöffnet, lese kontinuierlich...');end;   procedure
TForm1.Timer1Timer(Sender: TObject);var  Line: string;begin   
ButtonStart.caption:='123';  if FPortOpen then  begin    {$I-}       
ButtonStart.caption:='123';    //while true {not Eof(FSerialFile)} do 
  //begin      //Readln(FSerialFile, Line);    line:='123';   
 Memo1.Lines.Add(tohex(Line)); // oder ToHex(Line)     
Memo1.Lines.Add(Line);      Memo1.SelStart := Memo1.GetTextLen;  //
automatisch nach unten scrollen    //end;    {$I+}    if IOResult <> 0
then    begin      Memo1.Lines.Add('Fehler beim Lesen.');     
Timer1.Enabled := False;      FPortOpen := False;     
CloseFile(FSerialFile);    end;  end;end; end.
Timer works as expected (though you cannot stop it   ).
EDIT: removed while loop from Timer1Timer, with it the test was
incorrect of course.

Why do you think that /dev/ttyUSB0 is Text (and has Eof, Readln, ...)
?