Código Delphi [-]
procedure TForm1.ComPortRxChar(Sender: TObject; Count: Integer);

Código Delphi [-]
procedure TForm1.ComPortRxChar(Sender: TObject; count:integer);
begin
   {AQUI EL COMPONENTE LEE LO QUE RECIBE POR EL PUERTO COM}
  ComPort.ReadStr(Str, Count);
 
   if Str = 'DELPHI' then
      ShowMessage('Bienvenido')
   else if Str = 01 then
      ShowMessage('OK')
   else if Str = 2 then
      UnProcedimiento
   else if Str = 3 then
      OtroProcedimiento
   else
      LoQueSea;
end;

Código Delphi [-]
//Suponemos que necesitamos recibir una cadena que al final cierra con CR
 
//declaramos una constante
const Terminador = #13  //ASCII 13 o CR
 
//En la creacion del formulario declaramos
procedure TForm1.Create(Sender: TObject);
begin
   ComDataPacket.StopString := Terminador;
end;
 
//Este procedimiento se ejecutaria cada vez que aparezca CR
procedure TForm1.ComPortDataPacket(str: string; count: integer);
begin
   ShowMessage('Cadena Recibida: ' + Str);
end;

Código Delphi [-]
Type Modo = (Leer, Escribir, Borrar);
 
//Redeclarando el evento OnRxChar
procedure TForm1.ComPortRxChar(Sender: TObject; count:integer);
begin
   {AQUI EL COMPONENTE LEE LO QUE RECIBE POR EL PUERTO COM}
  ComPort.ReadStr(Str, Count);
 
   if Str = 'DELPHI' then
      ShowMessage('Bienvenido')
   else if Str = 01 then
      if Modo = Leer then
         ShowMessage('OK')
      else if Modo = Escribir then
          ProcedimientoEscribir
      else
          ProcedimientoBorrar
   else if Str = 2 then
      UnProcedimiento
   else if Str = 3 then
      OtroProcedimiento
   else
      LoQueSea;
end;

Código Delphi [-]
procedure TForm1.ComPortRxChar(Sender: TObject; count:integer);
begin      
ComPort.ReadStr(Str, Count);    
if Str = 'DELPHI' then      
ShowMessage('Bienvenido')   
else if Str = 01 then   // <---aqui no esta comparando.   
  comport.WriteStr(#2#2) 
  else if Str = 2 then     
 UnProcedimiento   
else if Str = 3 then     
 OtroProcedimiento   
else    
  LoQueSea;
end;

Código Delphi [-]
procedure TForm1.ComPortRxChar(Sender: TObject; count:integer);
begin      
ComPort.ReadStr(Str, Count);    
if Str = 'DELPHI' then      
ShowMessage('Bienvenido')   
else if Str = 01 then   // <---aqui no esta comparando.   
  comport.WriteStr(#2#2) 
  else if Str = 2 then     
 UnProcedimiento   
else if Str = 3 then     
 OtroProcedimiento   
else    
  LoQueSea;
end;

Código Delphi [-]
else if Str = #1 then   // <---aqui no esta comparando.   
  comport.WriteStr(#2#2) 
  else if Str = #2 then     
 UnProcedimiento   
else if Str = #3 then     
 OtroProcedimiento

Código Delphi [-]
else if Str = '01' then   // <---aqui no esta comparando.   
  comport.WriteStr(#2#2) 
  else if Str = '02' then     
 UnProcedimiento   
else if Str = '03' then     
 OtroProcedimiento

Código Delphi [-]
procedure TForm1.ComPortRxChar(Sender: TObject; Count: Integer);
var
  Str: String;
begin
 ComPort.ReadStr(Str, Count);
AddHexString(Str,Memo.Lines);
if length(Str)>= 8 then
 if Str = 'Hi-LOGIC' then
showmessage('¡OK! ¡ES ORIGINAL!')
 else if Str = '01' then
Comport.WriteStr(#2#2)
 else
showmessage('¡HORROR!, ¡ES PIRATA!');
end;

Código Delphi [-]
Type Modo = (Leer, Escribir, Borrar);
 //Redeclarando el evento OnRxChar
procedure TForm1.ComPortRxChar(Sender: TObject; count:integer);
begin   {AQUI EL COMPONENTE LEE LO QUE RECIBE POR EL PUERTO COM}  
ComPort.ReadStr(Str, Count);   
 if Str = 'DELPHI' then    
  ShowMessage('Bienvenido')   
else if Str = 01 then      
if Modo = Leer then     
    ShowMessage('OK')     
 else if Modo = Escribir then      
   ProcedimientoEscribir     
else          ProcedimientoBorrar
   else if Str = 2 then  
    UnProcedimiento   
else if Str = 3 then     
 OtroProcedimiento  
 else     
 LoQueSea;
end;

Código Delphi [-]
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
if not ComPort.Connected then
ComPort.Open;
comport.WriteStr(#2#0);
end;
procedure TForm1.ComPortRxChar(Sender: TObject; Count: Integer);
var
Str: String;
begin
 ComPort.ReadStr(Str, Count);
 if length(Str)>= 8 then
 ShowMessage('OK')
 else if Str = #1 then
 ComPort.WriteStr(#2#2)
 else
 ShowMessage('No puede comunicar');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 if not ComPort.Connected then
  ComPort.Open;
 comport.WriteStr(#4#1#0#1);
end;
end.

Código Delphi [-]
var
  Form1: TForm1;
  Cuantos : Integer;

.......

procedure TForm1.ComPortRxChar(Sender: TObject; count:integer);
var
  Str: String;
begin
  ComPort.ReadStr(Str, Count);
  AddHexString(Str,Memo.Lines);
  if Str = 'Hi-LOGIC' then
     showmessage('¡OK! ¡ES ORIGINAL!')
  else begin
         if Str = '01' then begin
            case Cuantos of
                1: begin //Modo Leer;
                     Comport.WriteStr(#2#2)
                     //ProcedimientoLeer
                     Cuantos := 2;
                end
                2: begin //Modo Escribir
                     //ProcedimientoEscribir
                     Cuantos := 3;
                end
                3: begin //Modo Borrar
                     //ProcedimientoBorrar
                end;
             end;
         end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if not ComPort.Connected then
      ComPort.Open;
   comport.WriteStr(#4#1#0#1);
   Cuantos := 1;
end;

Código Delphi [-]
var
  Form1: TForm1;
  Cuantos : Integer;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
if not ComPort.Connected then
ComPort.Open;
comport.WriteStr(#2#0);
end;
procedure TForm1.ComPortRxChar(Sender: TObject; Count: Integer);
var
Str: String;
begin
 ComPort.ReadStr(Str, Count);
 if length(Str)>= 8 then
 ShowMessage('OK')
 else if Str = #1 then  begin
   case Cuantos of
   1: begin
ComPort.WriteStr(#2#2);
   Cuantos := 2;
 end;
   2: begin //Modo Escribir
     ComPort.WriteStr(#2#3);
                     //ProcedimientoEscribir
                     Cuantos := 3;
   end;
    3: begin //Modo Borrar
                     //ProcedimientoBorrar
    showmessage('Chip Borrado.. OK!')
 end;
 end;
 end;
 end;
 

procedure TForm1.Button1Click(Sender: TObject);
begin
 if not ComPort.Connected then
  ComPort.Open;
 comport.WriteStr(#4#1#0#1);
   Cuantos := 1;
end;
end.

Código Delphi [-]
var
  Form1: TForm1;
  Cuantos, CuentaB : Integer;  //OJO AQUI SE MODIFICO
 
implementation
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
if not ComPort.Connected then
ComPort.Open;
comport.WriteStr(#2#0);
end;
 
procedure TForm1.ComPortRxChar(Sender: TObject; Count: Integer);
var
Str: String;
begin
 ComPort.ReadStr(Str, Count);
 
 if length(Str)>= 8 then
   ShowMessage('OK')
 
 else if Str = #1 then  begin
   case Cuantos of
   1: begin
        ComPort.WriteStr(#2#2);
        Cuantos := 2;
      end;
   2: begin //Modo Escribir
        ComPort.WriteStr(#2#3);
        //ProcedimientoEscribir
        Cuantos := 3;
      end;
   3: begin //Modo Borrar
         //ProcedimientoBorrar
         showmessage('Chip Borrado.. OK!')
      end;
   end
 
//AQUI la cadena recibida vale 2
 else if Str = #2 then begin
   case Cuantos of
      1: begin
          //
          end;
      2: begin //Envia el primer byte. CuentaB vale 0.
             ComPort.WriteStr(Buffer[CuentaB]);
             Inc(CuentaB);
          end;
      
   end;

//AQUI el chip respondio a el envio del primer byte
 else if Str = #53 then begin
   case Cuantos of
      2: ProcedimientoEscribir;
   end;

 end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 if not ComPort.Connected then
  ComPort.Open;
 comport.WriteStr(#4#1#0#1);
   Cuantos := 1;
end;
 
{Este procedimiento pretende escribir caracter a caracter sobre el
puerto serie. CuentaB es un contador que lleva el registro de las transmisiones efectuadas, siempre se 
compara su valor contra el valor de la longitud del buffer que contiene el archivo a transmitir.}

procedure TForm1.ProcedimientoEscribir;
begin
  if CuentaB <= Length(Buffer) then
    begin
      ComPort.WriteStr(Buffer[CuentaB]);
      Inc(CuentaB);
    end
  else
    ComPort.WriteStr(ByteFinTx);
end;
end.

Código Delphi [-]
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, CPort, StdCtrls, ComCtrls;
type
  TForm1 = class(TForm)
    ComPort: TComPort;
    Button1: TButton;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    ProgressBar1: TProgressBar;
    Button2: TButton;
    Button3: TButton;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    Memo1: TMemo;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure ComPortRxChar(Sender: TObject; Count: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
  Cuantos, CuentaB : Integer;
implementation
{$R *.dfm}
type
 TBuffer = array[$0000..$FFFF] of Byte;
function Insertar(Str: String; var Buffer: TBuffer): String;
var
  i,j,k: Integer;
begin
  Result:= EmptyStr;
  Str:= Trim(Str);
  if Copy(Str,1,1) = ':' then
    if TryStrToInt('$' + Copy(Str,2,2),i) then
      if Length(Str) = ((2*i) + 11) then
        if TryStrToInt('$' + Copy(Str,4,4),j) then
          if TryStrToInt('$' + Copy(Str,8,2),k) then
            if k = 0 then
            begin
              Str:= Copy(Str,10,2*i);
              for k:= j to (j + i - 1) do
              begin
                Buffer[k]:= StrToInt('$' + Copy(Str,1,2));
                Delete(Str,1,2);
              end;
            end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
if not ComPort.Connected then
ComPort.Open;
comport.WriteStr(#2#0);
end;
procedure TForm1.ComPortRxChar(Sender: TObject; Count: Integer);
var
Str: String;
begin
 ComPort.ReadStr(Str, Count);
 if length(Str)>= 8 then
 ShowMessage('OK')
 else if Str = #1 then  begin
   case Cuantos of
   1: begin     //poner el chip en prog..
ComPort.WriteStr(#2#2);
   Cuantos := 2;
 end;
   2: begin //comando para borrar.
     ComPort.WriteStr(#2#3);
       Cuantos := 3;
   end;
    3: begin //Modo Borrar
    showmessage('Chip Borrado.. OK!')
 end;
    4: begin //poner el chip en prog..
         ComPort.WriteStr(#2#2);
          Cuantos := 5;
      end;
    5: begin // Comando para escribir el chip(06 04 00 00 10 00)
         ComPort.WriteStr(#6#4#0#0#16#0);
     end;
     end;
     end;
     end;
 //Aqui comienza el procedimiento para borrar el chip
procedure TForm1.Button1Click(Sender: TObject);
begin
 if not ComPort.Connected then
  ComPort.Open;
 comport.WriteStr(#4#1#0#1);
   Cuantos := 1;
    end;
 //Aqui comienza el procedimiento para escribir el chip
procedure TForm1.Button2Click(Sender: TObject);
begin
 if not ComPort.Connected then
  ComPort.Open;
 comport.WriteStr(#4#1#0#1);
  Cuantos := 4;
end;
procedure TForm1.Button3Click(Sender: TObject);
  var
  i,j: Integer;
  Str: String;
  Buffer: TBuffer;
begin
 if OpenDialog1.Execute then
Label1.caption:=OpenDialog1.FileName;
  Memo1.Clear;
  with TStringList.Create do
  try
    LoadFromFile(Label1.Caption);
    FillChar(Buffer,Sizeof(Buffer),#0);
    for i:= 0 to Count - 1 do
      Insertar(Strings[i],Buffer);
     j:= StrToInt(Label2.caption);
     Str:= EmptyStr;
       for i:= 0 to j -1 do
      begin
   Str:= Str + #32 + IntToHex(Buffer[i],2);
      if ((i+1) mod 16 = 0) then
    begin
        Memo1.Lines.Add(Str);
        Str:= EmptyStr;
      end;
    end;
     if Str <> EmptyStr then
      Memo1.Lines.Add(Str);
  finally
    Free;
  end;
end;
end.

Código Delphi [-]
    5: begin // Comando para escribir el chip(06 04 00 00 10 00)
         ComPort.WriteStr(#6#4#0#0#16#0);
          // aqui tiene que entrar la rutina de mandar el primer byte del buffer
     end;

Código Delphi [-]
procedure TForm1.ProcedimientoEscribir;
var
Buffer: TBuffer;
begin
  if CuentaB <= Length(Buffer) then
    begin
      ComPort.WriteStr(Buffer[CuentaB]);
      Inc(CuentaB);
    end

Código Delphi [-]
 ComPort.WriteStr(Buffer[CuentaB]);

Código Delphi [-]
 ComPort.WriteStr(Buffer[CuentaB]);

Código Delphi [-]
TBuffer = array[1..BufSize] of Byte;

Código Delphi [-]
Buffer : Array[1..200] of Char;
//en lugar de 
Buffer : TBuffer;

Código Delphi [-]
procedure TForm1.ProcedimientoEscribir;
begin
  if CuentaB <= Length(Buffer) then
    begin
      ComPort.WriteStr(Buffer[CuentaB]);
      Inc(CuentaB);
    end
  else
    ComPort.WriteStr(ByteFinTx);
end;
end.

Código Delphi [-]
4: begin //poner el chip en prog..
         ComPort.WriteStr(#2#2);
          Cuantos := 5;
      end;
    5: begin // Comando para escribir el chip(06 04 00 00 10 00)
         ComPort.WriteStr(#6#4#0#0#16#0);

Código Delphi [-]
var
  Str: String;
begin
  ComPort.ReadStr(Str, Count);
  if length(Str)>= 8 then
    ShowMessage('OK')
  else if Str = #1 then  begin
          case Cuantos of
             1: begin
                  ComPort.WriteStr(#2#2);
                  Cuantos := 2;
             end;
             2: begin //Modo Escribir
                  ComPort.WriteStr(#2#3);
                  //ProcedimientoEscribir
                  Cuantos := 3;
             end;
             3: begin //Modo Borrar
                  //ProcedimientoBorrar
                  showmessage('Chip Borrado.. OK!')
                  Cuantos := 4;
             end;
             4: begin //poner el chip en prog..
                  ComPort.WriteStr(#2#2);
                  Cuantos := 5;
             end;
             5: begin // Comando para escribir el chip(06 04 00 00 10 00)
                  ComPort.WriteStr(#6#4#0#0#16#0);
                  Contador := 1;
             end;
          end;
      end
      else if Str = #2 then begin
           end
           else if Str = #53 then begin
                   if contador <= 4096 then begin
                      ComPort.WriteStr(Memo1.Text[Contador]);
                      Inc(Contador);
                   end;
                end;
end;

Código Delphi [-]
 5: begin // Comando para escribir el chip(06 04 00 00 10 00)
                  ComPort.WriteStr(#6#4#0#0#16#0);
                  Contador := 1; // aqui esta mandando el primer byte?
             end;
          end;
      end
      else if Str = #2 then begin
           end
           else if Str = #53 then begin
                   if contador <= 4096 then begin
                      ComPort.WriteStr(Memo1.Text[Contador]);
                      Inc(Contador);
                   end;
                end;
end;

Código Delphi [-]
   ComPort.WriteStr(#6#4#0#0#16#0);
     // aqui debe mandar el primer byte del memo y entonces espera el 53
                  Contador := 1;

Código Delphi [-]
    ComPort.WriteStr(#6#4#0#0#16#0);
    sleep(100); // Edito, esto es para que haga una pequeña pausa, antes de enviar el primer caracter....
    ComPort.WriteStr(Memo1.Text[1]);
    Contador := 2;

Código Delphi [-]
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, CPort, StdCtrls, ComCtrls;
type
  TForm1 = class(TForm)
    ComPort: TComPort;
    Button1: TButton;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    ProgressBar1: TProgressBar;
    Button2: TButton;
    Button3: TButton;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    Memo1: TMemo;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure ComPortRxChar(Sender: TObject; Count: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
  Cuantos, CuentaB : Integer;
  Contador  : Integer;
implementation
{$R *.dfm}
type
 TBuffer = array[$0000..$FFFF] of Byte;
function Insertar(Str: String; var Buffer: TBuffer): String;
var
  i,j,k: Integer;
begin
  Result:= EmptyStr;
  Str:= Trim(Str);
  if Copy(Str,1,1) = ':' then
    if TryStrToInt('$' + Copy(Str,2,2),i) then
      if Length(Str) = ((2*i) + 11) then
        if TryStrToInt('$' + Copy(Str,4,4),j) then
          if TryStrToInt('$' + Copy(Str,8,2),k) then
            if k = 0 then
            begin
              Str:= Copy(Str,10,2*i);
              for k:= j to (j + i - 1) do
              begin
                Buffer[k]:= StrToInt('$' + Copy(Str,1,2));
                Delete(Str,1,2);
              end;
            end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
if not ComPort.Connected then
ComPort.Open;
comport.WriteStr(#2#0);
end;
procedure TForm1.ComPortRxChar(Sender: TObject; Count: Integer);
var
Str: String;
begin
 ComPort.ReadStr(Str, Count);
 if length(Str)>= 8 then
 ShowMessage('OK')
 else if Str = #1 then  begin
   case Cuantos of
   1: begin     //poner el chip en prog..
ComPort.WriteStr(#2#2);
   Cuantos := 2;
 end;
   2: begin //comando para borrar.
     ComPort.WriteStr(#2#3);
       Cuantos := 3;
   end;
    3: begin //Modo Borrar
    showmessage('Chip Borrado.. OK!')
 end;
    4: begin //poner el chip en prog..
         ComPort.WriteStr(#2#2);
          Cuantos := 5;
      end;
    5: begin // Comando para escribir el chip(06 04 00 00 10 00)
         ComPort.WriteStr(#6#4#0#0#16#0);
            sleep(100);
            ComPort.WriteStr(Memo1.Text[1]);
           Contador := 2;
     end;
     end;
     end
         else if Str = #2 then begin
         end
           else if Str = #53 then begin
                   if contador <= 4096 then begin
                       sleep(100);
                      ComPort.WriteStr(Memo1.Text[Contador]);
                      Inc(Contador);
     end;
     end;
     end;
 //Aqui comienza el procedimiento para borrar el chip
procedure TForm1.Button1Click(Sender: TObject);
begin
 if not ComPort.Connected then
  ComPort.Open;
 comport.WriteStr(#4#1#0#1);
   Cuantos := 1;
    end;
 //Aqui comienza el procedimiento para escribir el chip
procedure TForm1.Button2Click(Sender: TObject);
begin
 if not ComPort.Connected then
  ComPort.Open;
 comport.WriteStr(#4#1#0#1);
  Cuantos := 4;
end;
procedure TForm1.Button3Click(Sender: TObject);
  var
  i,j: Integer;
  Str: String;
  Buffer: TBuffer;
begin
 if OpenDialog1.Execute then
Label1.caption:=OpenDialog1.FileName;
  Memo1.Clear;
  with TStringList.Create do
  try
    LoadFromFile(Label1.Caption);
    FillChar(Buffer,Sizeof(Buffer),#0);
    for i:= 0 to Count - 1 do
      Insertar(Strings[i],Buffer);
     j:= StrToInt(Label2.caption);
     Str:= EmptyStr;
       for i:= 0 to j -1 do
      begin
   Str:= Str + #32 + IntToHex(Buffer[i],2);
      if ((i+1) mod 16 = 0) then
    begin
        Memo1.Lines.Add(Str);
        Str:= EmptyStr;
      end;
    end;
     if Str <> EmptyStr then
      Memo1.Lines.Add(Str);
  finally
    Free;
  end;
end;
end.