Conversione progetto vecchio delphi in delphi 10

Ciao a tutti,

probabilmente la richiesta sarà davvero troppo generica ma magari qualcuno sa darmi almeno una dritta su cosa magari poter controllare.

Ho un vecchio progetto del 2012 circa, fatto con non so che versione di delphi purtroppo.

Su una vecchia virtual machine ho delphi xe2 e speravo fosse fatto con quello ma non credo perchè aprendo il progetto cosi comè non me lo compila, per esempio ho questo componente     Client: TDdeClientConv (che onestamente non so cosa sia); e questa funzione

function TDdeForm.SendDdeCommand(cmd: string): boolean;
var
 MacroCommand: string;
 PMacroCommand: array [0..50] of char;
begin
 MacroCommand:=cmd;
 StrPCopy(PMacroCommand, MacroCommand);
 Result:=true;
 if not Client.ExecuteMacro(PMacroCommand, False) then
 begin
   ConnectToExcel;
   if not Client.ExecuteMacro(PMacroCommand, False) then
   begin
     ConnectToExcel;
     if not Client.ExecuteMacro(PMacroCommand, False) then
     begin
       Result:=false;
     end;
   end;
 end;
end;

e mi restituisce questo errore [dcc32 Error] DdeVisco.pas(125): E2010 Incompatible types: 'PAnsiChar' and 'array[0..50] of Char'

percui immagino che con l andare delle versioni di delphi sia cambiato qualcosa,

comunque ho modificato questi problemi e alla fine lo compila.

la funzione per far compilare il progetto è

function TDdeForm.SendDdeCommand(cmd: string): boolean;
var
 MacroCommand: string;
 PMacroCommand: array [0..50] of char;
begin
 MacroCommand:=cmd;
 StrPCopy(PMacroCommand, MacroCommand);
 Result:=true;
 if not Client.ExecuteMacro(PAnsiChar(MacroCommand), False) then
 begin
   ConnectToExcel;
   if not Client.ExecuteMacro(PAnsiChar(MacroCommand), False) then
   begin
     ConnectToExcel;
     if not Client.ExecuteMacro(PAnsiChar(MacroCommand), False) then
     begin
       Result:=false;
     end;
   end;
 end;
end;

pero'  il problema non è questo, ma che questo progetto ha una parte di comunicazione con l rs232, che pero'  non ho toccato,

ora il nuovo eseguibile  sembra non comunicare piu con la rs232.

Il progetto include anche dei packages, scritti probabilmente in delphi 3 perchè all interno ci sono dei file che tra le note viene scritto appunto per delphi 3.

uno di questi per esempio si chiama comms.pas e sembra poter essere questa la parte incriminata percui non funzioni la comunicazione, provo ad incollare il codice di questa unità, magari la conoscete e sapete se esiste una versione per delphi 10…

// ------- this is a freeware --------
// TComPort component, version 1.01
//   for Delphi 2.0, 3.0, 4.0
// written by Dejan Crnila
//   email: emilija.crnila-guest.arnes.si
// ------- this is a freeware --------

unit Comms;

interface

uses
  Windows, Classes, SysUtils;

type
  TBaudRate = (br110, br300, br600, br1200, br2400, br4800, br9600,
               br14400, br19200, br38400, br56000, br57600, br115200);
  TPortType = (COM1, COM2, COM3, COM4, COM5, COM6, COM7, COM8, COM9, COM10,
               COM11, COM12, COM13, COM14, COM15, COM16, COM17, COM18, COM19, COM20,
               COM21, COM22, COM23, COM24, COM25, COM26, COM27, COM28, COM29, COM30);
  TStopBits = (sbOneStopBit, sbOne5StopBits, sbTwoStopBits);
  TParity = (prNone, prOdd, prEven, prMark, prSpace);
  TFlowControl = (fcNone, fcRtsCts, fcXonXoff);
  TEvent = (evRxChar, evTxEmpty, evRxFlag, evRing, evBreak, evCTS,
            evDSR, evError, evRLSD);
  TEvents = set of TEvent;

  TRxCharEvent = procedure(Sender: TObject; InQue: Integer) of object;

  TComPort = class;

  TComThread = class(TThread)
  private
    Owner: TComPort;
    Mask: DWORD;
    StopEvent: THandle;
  protected
    procedure Execute; override;
    procedure DoEvents;
    procedure Stop;
  public
    constructor Create(AOwner: TComPort);
    destructor Destroy; override;
  end;

  TComPort = class(TComponent)
  private
    ComHandle: THandle;
    EventThread: TComThread;
    FConnected: Boolean;
    FBaudRate: TBaudRate;
    FPortType: TPortType;
    FParity: TParity;
    FStopBits: TStopBits;
    FFlowControl: TFlowControl;
    FDataBits: Byte;
    FEvents: TEvents;
    FEnableDTR: Boolean;
    FWriteBufSize: Integer;
    FReadBufSize: Integer;
    FOnRxChar: TRxCharEvent;
    FOnTxEmpty: TNotifyEvent;
    FOnBreak: TNotifyEvent;
    FOnRing: TNotifyEvent;
    FOnCTS: TNotifyEvent;
    FOnDSR: TNotifyEvent;
    FOnRLSD: TNotifyEvent;
    FOnError: TNotifyEvent;
    FOnRxFlag: TNotifyEvent;
    FOnOpen: TNotifyEvent;
    FOnClose: TNotifyEvent;
    MultiMicro: boolean;
    procedure SetDataBits(Value: Byte);
    procedure DoOnRxChar;
    procedure DoOnTxEmpty;
    procedure DoOnBreak;
    procedure DoOnRing;
    procedure DoOnRxFlag;
    procedure DoOnCTS;
    procedure DoOnDSR;
    procedure DoOnError;
    procedure DoOnRLSD;
    function WriteStringMicro(Str: String): dword;
    procedure BaudRateFromInteger(msg: integer);
    procedure StopBitsFromInteger(msg: integer);
    procedure ParityFromChar(msg: char);
    procedure DataBitsFromInteger(msg: integer);
    procedure FlowFromBoolean(soft, hard: boolean);
    function GetLastErrorText: string;
  protected
    procedure CreateHandle;
    procedure DestroyHandle;
    procedure SetupState;
    function ValidHandle: Boolean;
  public
    property Connected: Boolean read FConnected;
    procedure Open;
    procedure Connect(comport: String; baud, bits: integer; parity: char; stop: integer; softflow, hardflow: boolean);

    procedure Close;
    function InQue: Integer;
    function OutQue: Integer;
    function ActiveCTS: Boolean;
    function ActiveDSR: Boolean;
    function ActiveRLSD: Boolean;
    function Write(var Buffer; Count: Integer): Integer;
    function WriteString(Str: String): Integer;
    function WriteByte(buffer: byte): Integer;
    function Read(var Buffer; Count: Integer): Integer;
    function ReadString(var Str: String; Count: Integer): Integer;
    procedure PurgeIn;
    procedure PurgeOut;
    function GetComHandle: THandle;

    function ComString: String;
    procedure ComFromString(msg: string);
    procedure BaudRateFromString(msg: string);
    function BaudRateInteger: integer;
    procedure ParityFromString(msg: string);
    function ParityString: string;
    procedure DataBitsFromString(msg: string);
    function DataBitsInteger: integer;
    procedure StopBitsFromString(msg: string);
    function StopBitsString: String;
    procedure FlowFromString(msg: string);
    function FlowString: string;
    function IsConnected: boolean;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property BaudRate: TBaudRate read FBaudRate write FBaudRate;
    property Port: TPortType read FPortType write FPortType;
    property Parity: TParity read FParity write FParity;
    property StopBits: TStopBits read FStopBits write FStopBits;
    property FlowControl: TFlowControl read FFlowControl write FFlowControl;
    property DataBits: Byte read FDataBits write SetDataBits;
    property Events: TEvents read FEvents write FEvents;
    property EnableDTR: Boolean read FEnableDTR write FEnableDTR;
    property WriteBufSize: Integer read FWriteBufSize write FWriteBufSize;
    property ReadBufSize: Integer read FReadBufSize write FReadBufSize;
    property OnRxChar: TRxCharEvent read FOnRxChar write FOnRxChar;
    property OnTxEmpty: TNotifyEvent read FOnTxEmpty write FOnTxEmpty;
    property OnBreak: TNotifyEvent read FOnBreak write FOnBreak;
    property OnRing: TNotifyEvent read FOnRing write FOnRing;
    property OnCTS: TNotifyEvent read FOnCTS write FOnCTS;
    property OnDSR: TNotifyEvent read FOnDSR write FOnDSR;
    property OnRLSD: TNotifyEvent read FOnRLSD write FOnRLSD;
    property OnRxFlag: TNotifyEvent read FOnRxFlag write FOnRxFlag;
    property OnError: TNotifyEvent read FOnError write FOnError;
    property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
  end;

  EComHandle = class(Exception);
  EComState  = class(Exception);
  EComWrite  = class(Exception);
  EComRead   = class(Exception);
  EComStatus = class(Exception);
  EComPurge = class(Exception);

const
  dcb_Binary           = $00000001;
  dcb_Parity           = $00000002;
  dcb_OutxCtsFlow      = $00000004;
  dcb_OutxDsrFlow      = $00000008;
  dcb_DtrControl       = $00000030;
  dcb_DsrSensivity     = $00000040;
  dcb_TXContinueOnXOff = $00000080;
  dcb_OutX             = $00000100;
  dcb_InX              = $00000200;
  dcb_ErrorChar        = $00000400;
  dcb_Null             = $00000800;
  dcb_RtsControl       = $00003000;
  dcb_AbortOnError     = $00004000;

function ShowPropForm(ComPort: TComPort): Boolean;
procedure Register;

implementation

uses CommForm, Controls;

{
type
  TComPortEditor = class(TComponentEditor)
  private
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;
 }
// Component code

function LastErr: String;
begin
  Result := IntToStr(GetLastError);
end;

constructor TComThread.Create(AOwner: TComPort);
var AMask: Integer;
begin
  inherited Create(True);
  StopEvent := CreateEvent(nil, True, False, nil);
  Owner := AOwner;
  AMask := 0;
  if evRxChar in Owner.FEvents then AMask := AMask or EV_RXCHAR;
  if evRxFlag in Owner.FEvents then AMask := AMask or EV_RXFLAG;
  if evTxEmpty in Owner.FEvents then AMask := AMask or EV_TXEMPTY;
  if evRing in Owner.FEvents then AMask := AMask or EV_RING;
  if evCTS in Owner.FEvents then AMask := AMask or EV_CTS;
  if evDSR in Owner.FEvents then AMask := AMask or EV_DSR;
  if evRLSD in Owner.FEvents then AMask := AMask or EV_RLSD;
  if evError in Owner.FEvents then AMask := AMask or EV_ERR;
  if evBreak in Owner.FEvents then AMask := AMask or EV_BREAK;
  SetCommMask(Owner.ComHandle, AMask);
  Resume;
end;

procedure TComThread.Execute;
var EventHandles: Array[0..1] of THandle;
    Overlapped: TOverlapped;
    dwSignaled, BytesTrans: DWORD;
begin
  FillChar(Overlapped, SizeOf(Overlapped), 0);
  Overlapped.hEvent := CreateEvent(nil, True, True, nil);
  EventHandles[0] := StopEvent;
  EventHandles[1] := Overlapped.hEvent;
  repeat
    WaitCommEvent(Owner.ComHandle, Mask, @Overlapped);
    dwSignaled := WaitForMultipleObjects(2, @EventHandles, False, INFINITE);
    case dwSignaled of
      WAIT_OBJECT_0:Break;
      WAIT_OBJECT_0 + 1: if GetOverlappedResult(Owner.ComHandle, Overlapped,
                              BytesTrans, False) then Synchronize(DoEvents);
      else Break;
    end;
  until False;
  Owner.PurgeIn;
  Owner.PurgeOut;
  CloseHandle(Overlapped.hEvent);
  CloseHandle(StopEvent);
end;

procedure TComThread.Stop;
begin
  SetEvent(StopEvent);
end;

destructor TComThread.Destroy;
begin
  Stop;
  inherited Destroy;
end;

procedure TComThread.DoEvents;
begin
  if (EV_RXCHAR and Mask) > 0 then Owner.DoOnRxChar;
  if (EV_TXEMPTY and Mask) > 0 then Owner.DoOnTxEmpty;
  if (EV_BREAK and Mask) > 0 then Owner.DoOnBreak;
  if (EV_RING and Mask) > 0 then Owner.DoOnRing;
  if (EV_CTS and Mask) > 0 then Owner.DoOnCTS;
  if (EV_DSR and Mask) > 0 then Owner.DoOnDSR;
  if (EV_RXFLAG and Mask) > 0 then Owner.DoOnRxFlag;
  if (EV_RLSD and Mask) > 0 then Owner.DoOnRLSD;
  if (EV_ERR and Mask) > 0 then Owner.DoOnError;
end;

constructor TComPort.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FConnected := false;
  FBaudRate := br9600;
  FParity := prNone;
  FPortType := COM1;
  FStopBits := sbOneStopBit;
  FDataBits := 8;
  FEvents := [evRxChar, evTxEmpty, evRxFlag, evRing, evBreak,
             evCTS, evDSR, evError, evRLSD];
  FEnableDTR := True;
  FWriteBufSize := 2048;
  FReadBufSize := 2048;
  ComHandle := INVALID_HANDLE_VALUE;
  MultiMicro := false;
end;

destructor TComPort.Destroy;
begin
  Close;
  inherited Destroy;
end;

function TComPort.GetLastErrorText(): string;
var
  dwSize: DWORD;
  lpszTemp: PWideChar;
begin
  dwSize := 512;
  lpszTemp := nil;
  try
    GetMem(lpszTemp, dwSize);
    FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY,
      nil,
      GetLastError(),
      LANG_NEUTRAL,
      lpszTemp,
      dwSize,
      nil)
  finally
    Result := lpszTemp;
    FreeMem(lpszTemp)
  end
  
end;


procedure TComPort.CreateHandle;
begin
  ComHandle := CreateFile(
    PChar(ComString),
    GENERIC_READ or GENERIC_WRITE,
    0,
    nil,
    OPEN_EXISTING,
    FILE_FLAG_OVERLAPPED,
    0);
  if not ValidHandle then
  begin
    raise EComHandle.Create('Unable to open com port: ' + GetLastErrorText);
  end;
end;

procedure TComPort.DestroyHandle;
begin
  if ValidHandle then
    CloseHandle(ComHandle);
end;

function TComPort.ValidHandle: Boolean;
begin
  if ComHandle = INVALID_HANDLE_VALUE then
    Result := False
  else
    Result := True;
end;

procedure TComPort.Open;
begin
  Close;
  CreateHandle;
  SetupState;
  EventThread := TComThread.Create(Self);
  FConnected := True;
  if Assigned(FOnOpen) then FOnOpen(Self);
end;

procedure TComPort.Close;
begin
  if FConnected then begin
    EventThread.Free;
    DestroyHandle;
    FConnected := False;
    if Assigned(FOnClose) then FOnClose(Self);
  end;
end;

procedure TComPort.SetupState;
var DCB: TDCB;
    Timeouts: TCommTimeouts;
begin
  FillChar(DCB, SizeOf(DCB), 0);

  DCB.DCBlength := SizeOf(DCB);
  DCB.XonChar := #17;
  DCB.XoffChar := #19;
  DCB.XonLim := FWriteBufSize div 4;
  DCB.XoffLim := 1;

  DCB.Flags := DCB.Flags or dcb_Binary;
  if FEnableDTR then
    DCB.Flags := DCB.Flags or (dcb_DtrControl and (DTR_CONTROL_ENABLE shl 4));

  case FFlowControl of
    fcRtsCts: begin
      DCB.Flags := DCB.Flags or dcb_OutxCtsFlow or
        (dcb_RtsControl and (RTS_CONTROL_HANDSHAKE shl 12));
    end;
    fcXonXoff: DCB.Flags := DCB.Flags or dcb_OutX or dcb_InX;
  end;

  case FParity of
    prNone:  DCB.Parity := NOPARITY;
    prOdd:   DCB.Parity := ODDPARITY;
    prEven:  DCB.Parity := EVENPARITY;
    prMark:  DCB.Parity := MARKPARITY;
    prSpace: DCB.Parity := SPACEPARITY;
  end;

  case FStopBits of
    sbOneStopBit:   DCB.StopBits := ONESTOPBIT;
    sbOne5StopBits: DCB.StopBits := ONE5STOPBITS;
    sbTwoStopBits:  DCB.StopBits := TWOSTOPBITS;
  end;

  case FBaudRate of
    br110:    DCB.BaudRate := CBR_110;
    br300:    DCB.BaudRate := CBR_300;
    br600:    DCB.BaudRate := CBR_600;
    br1200:   DCB.BaudRate := CBR_1200;
    br2400:   DCB.BaudRate := CBR_2400;
    br4800:   DCB.BaudRate := CBR_4800;
    br9600:   DCB.BaudRate := CBR_9600;
    br14400:  DCB.BaudRate := CBR_14400;
    br19200:  DCB.BaudRate := CBR_19200;
    br38400:  DCB.BaudRate := CBR_38400;
    br56000:  DCB.BaudRate := CBR_56000;
    br57600:  DCB.BaudRate := CBR_57600;
    br115200: DCB.BaudRate := CBR_115200;
  end;

  DCB.ByteSize := FDataBits;

  if not SetCommState(ComHandle, DCB) then
    raise EComState.Create('Unable to set com state: ' + LastErr);

  if not GetCommTimeouts(ComHandle, Timeouts) then
    raise EComState.Create('Unable to set com state: ' + LastErr);

  Timeouts.ReadIntervalTimeout := MAXDWORD;
  Timeouts.ReadTotalTimeoutMultiplier := 0;
  Timeouts.ReadTotalTimeoutConstant := 0;
  Timeouts.WriteTotalTimeoutMultiplier := 1000;
  Timeouts.WriteTotalTimeoutConstant := 1500;

  if not SetCommTimeouts(ComHandle, Timeouts) then
    raise EComState.Create('Unable to set com state: ' + LastErr);

  if not SetupComm(ComHandle, FReadBufSize, FWriteBufSize) then
    raise EComState.Create('Unable to set com state: ' + LastErr);
end;

function TComPort.InQue: Integer;
var Errors: DWORD;
    ComStat: TComStat;
begin
  if not ClearCommError(ComHandle, Errors, @ComStat) then
    raise EComStatus.Create('Unable to read com status: ' + LastErr);
  Result := ComStat.cbInQue;
end;

function TComPort.OutQue: Integer;
var Errors: DWORD;
    ComStat: TComStat;
begin
  if not ClearCommError(ComHandle, Errors, @ComStat) then
    raise EComStatus.Create('Unable to read com status: ' + LastErr);
  Result := ComStat.cbOutQue;
end;

function TComPort.ActiveCTS: Boolean;
var Errors: DWORD;
    ComStat: TComStat;
begin
  if not ClearCommError(ComHandle, Errors, @ComStat) then
    raise EComStatus.Create('Unable to read com status: ' + LastErr);
  Result := not (fCtlHold in ComStat.Flags);
end;

function TComPort.ActiveDSR: Boolean;
var Errors: DWORD;
    ComStat: TComStat;
begin
  if not ClearCommError(ComHandle, Errors, @ComStat) then
    raise EComStatus.Create('Unable to read com status: ' + LastErr);
  Result := not (fDsrHold in ComStat.Flags);
end;

function TComPort.ActiveRLSD: Boolean;
var Errors: DWORD;
    ComStat: TComStat;
begin
  if not ClearCommError(ComHandle, Errors, @ComStat) then
    raise EComStatus.Create('Unable to read com status: ' + LastErr);
  Result := not (fRlsHold in ComStat.Flags);
end;

function TComPort.Write(var Buffer; Count: Integer): Integer;
var Overlapped: TOverlapped;
    BytesWritten: DWORD;
begin
  FillChar(Overlapped, SizeOf(Overlapped), 0);
  Overlapped.hEvent := CreateEvent(nil, True, True, nil);
  WriteFile(ComHandle, Buffer, Count, BytesWritten, @Overlapped);

  WaitForSingleObject(Overlapped.hEvent, INFINITE);
  if not GetOverlappedResult(ComHandle, Overlapped, BytesWritten, False) then
    raise EWriteError.Create('Unable to write to port: ' + LastErr);
  CloseHandle(Overlapped.hEvent);
  Result := BytesWritten;
end;

function TComPort.WriteByte(buffer: byte): Integer;
var Overlapped: TOverlapped;
    BytesWritten: DWORD;
begin
  FillChar(Overlapped, SizeOf(Overlapped), 0);
  Overlapped.hEvent := CreateEvent(nil, True, True, nil);
  WriteFile(ComHandle, Buffer, 1, BytesWritten, @Overlapped);

  WaitForSingleObject(Overlapped.hEvent, INFINITE);
  if not GetOverlappedResult(ComHandle, Overlapped, BytesWritten, False) then
    raise EWriteError.Create('Unable to write to port: ' + LastErr);
  CloseHandle(Overlapped.hEvent);
  Result := BytesWritten;
end;

function TComPort.WriteStringMicro(Str: String): dword;
var Overlapped: TOverlapped;
    BytesWritten: DWORD;
    s1, s2: string;
    DCB: TDCB;
begin
  s1 := Copy(Str,0,1);
  s2:=Str;
  Delete(s2,1,1);
  if not GetCommState(ComHandle, DCB) then
    raise EComState.Create('Unable to get com state: ' + LastErr);
  DCB.Parity:=MARKPARITY;   //Mark
  if not SetCommState(ComHandle, DCB) then
    raise EComState.Create('Unable to set com state before: ' + LastErr);
  FillChar(Overlapped, SizeOf(Overlapped), 0);
  Overlapped.hEvent := CreateEvent(nil, True, True, nil);
  WriteFile(ComHandle, s1[1], Length(s1), BytesWritten, @Overlapped);
  WaitForSingleObject(Overlapped.hEvent, INFINITE);
  if not GetOverlappedResult(ComHandle, Overlapped, BytesWritten, False) then
    raise EWriteError.Create('Unable to write to port: ' + LastErr);
  CloseHandle(Overlapped.hEvent);
  Result := BytesWritten;

  DCB.Parity:=SPACEPARITY;     //Space
  if not SetCommState(ComHandle, DCB) then
    raise EComState.Create('Unable to set com state after: ' + LastErr);
  FillChar(Overlapped, SizeOf(Overlapped), 0);
  Overlapped.hEvent := CreateEvent(nil, True, True, nil);
  WriteFile(ComHandle, s2[1], Length(s2), BytesWritten, @Overlapped);
  WaitForSingleObject(Overlapped.hEvent, INFINITE);
  if not GetOverlappedResult(ComHandle, Overlapped, BytesWritten, False) then
    raise EWriteError.Create('Unable to write to port: ' + LastErr);
  CloseHandle(Overlapped.hEvent);
  Result := Result + BytesWritten;
end;

function TComPort.WriteString(Str: String): Integer;
var Overlapped: TOverlapped;
    BytesWritten: DWORD;
begin
  if MultiMicro then
  begin
    Result:=WriteStringMicro(Str);
  end
  else
  begin
    FillChar(Overlapped, SizeOf(Overlapped), 0);
    Overlapped.hEvent := CreateEvent(nil, True, True, nil);
    WriteFile(ComHandle, Str[1], Length(Str), BytesWritten, @Overlapped);
    WaitForSingleObject(Overlapped.hEvent, INFINITE);
    if not GetOverlappedResult(ComHandle, Overlapped, BytesWritten, False) then
      raise EWriteError.Create('Unable to write to port: ' + LastErr);
    CloseHandle(Overlapped.hEvent);
    Result := BytesWritten;
  end;
end;

function TComPort.Read(var Buffer; Count: Integer): Integer;
var Overlapped: TOverlapped;
    BytesRead: DWORD;
begin
  FillChar(Overlapped, SizeOf(Overlapped), 0);
  Overlapped.hEvent := CreateEvent(nil, True, True, nil);
  ReadFile(ComHandle, Buffer, Count, BytesRead, @Overlapped);
  WaitForSingleObject(Overlapped.hEvent, INFINITE);
  if not GetOverlappedResult(ComHandle, Overlapped, BytesRead, False) then
    raise EWriteError.Create('Unable to write to port: ' + LastErr);
  CloseHandle(Overlapped.hEvent);
  Result := BytesRead;
end;

function TComPort.ReadString(var Str: String; Count: Integer): Integer;
var Overlapped: TOverlapped;
    BytesRead: DWORD;
begin
  SetLength(Str, Count);
  FillChar(Overlapped, SizeOf(Overlapped), 0);
  Overlapped.hEvent := CreateEvent(nil, True, True, nil);
  ReadFile(ComHandle, Str[1], Count, BytesRead, @Overlapped);
  WaitForSingleObject(Overlapped.hEvent, INFINITE);
  if not GetOverlappedResult(ComHandle, Overlapped, BytesRead, False) then
    raise EWriteError.Create('Unable to write to port: ' + LastErr);
  CloseHandle(Overlapped.hEvent);
  SetLength(Str, BytesRead);
  Result := BytesRead;
end;

procedure TComPort.PurgeIn;
begin
  if not PurgeComm(ComHandle, PURGE_RXABORT or PURGE_RXCLEAR) then
    raise EComPurge.Create('Unable to purge com: ' + LastErr);
end;

procedure TComPort.PurgeOut;
begin
  if not PurgeComm(ComHandle, PURGE_TXABORT or PURGE_TXCLEAR) then
    raise EComPurge.Create('Unable to purge com: ' + LastErr);
end;

function TComPort.GetComHandle: THandle;
begin
  Result := ComHandle;
end;

procedure TComPort.SetDataBits(Value: Byte);
begin
  if Value <> FDataBits then
    if Value > 8 then FDataBits := 8 else
      if Value < 5 then FDataBits := 5 else
        FDataBits := Value;
end;

procedure TComPort.DoOnRxChar;
begin
  if Assigned(FOnRxChar) then FOnRxChar(Self, InQue);
end;

procedure TComPort.DoOnBreak;
begin
  if Assigned(FOnBreak) then FOnBreak(Self);
end;

procedure TComPort.DoOnRing;
begin
  if Assigned(FOnRing) then FOnRing(Self);
end;

procedure TComPort.DoOnTxEmpty;
begin
  if Assigned(FOnTxEmpty) then FOnTxEmpty(Self);
end;

procedure TComPort.DoOnCTS;
begin
  if Assigned(FOnCTS) then FOnCTS(Self);
end;

procedure TComPort.DoOnDSR;
begin
  if Assigned(FOnDSR) then FOnDSR(Self);
end;

procedure TComPort.DoOnRLSD;
begin
  if Assigned(FOnRLSD) then FOnRLSD(Self);
end;

procedure TComPort.DoOnError;
begin
  if Assigned(FOnError) then FOnError(Self);
end;

procedure TComPort.DoOnRxFlag;
begin
  if Assigned(FOnRxFlag) then FOnRxFlag(Self);
end;

function TComPort.ComString: String;
begin
  case FPortType of
    COM1: Result := 'COM1';
    COM2: Result := 'COM2';
    COM3: Result := 'COM3';
    COM4: Result := 'COM4';
    COM5: Result := 'COM5';
    COM6: Result := 'COM6';
    COM7: Result := 'COM7';
    COM8: Result := 'COM8';
    COM9: Result := 'COM9';
    COM10: Result := 'COM10';
    COM11: Result := 'COM11';
    COM12: Result := 'COM12';
    COM13: Result := 'COM13';
    COM14: Result := 'COM14';
    COM15: Result := 'COM15';
    COM16: Result := 'COM16';
    COM17: Result := 'COM17';
    COM18: Result := 'COM18';
    COM19: Result := 'COM19';
    COM20: Result := 'COM20';
    COM21: Result := 'COM21';
    COM22: Result := 'COM22';
    COM23: Result := 'COM23';
    COM24: Result := 'COM24';
    COM25: Result := 'COM25';
    COM26: Result := 'COM26';
    COM27: Result := 'COM27';
    COM28: Result := 'COM28';
    COM29: Result := 'COM29';
    COM30: Result := 'COM30';
  end;
end;

procedure TComPort.ComFromString (msg: string);
begin
  if Pos(msg,'COM1') > 0 then
  begin
    FPortType:=COM1;
    exit;
  end;
  if Pos(msg,'COM2') > 0 then
  begin
    FPortType:=COM2;
    exit;
  end;
  if Pos(msg,'COM3') > 0 then
  begin
    FPortType:=COM3;
    exit;
  end;
  if Pos(msg,'COM4') > 0 then
    FPortType:=COM4;
  if Pos(msg,'COM5') > 0 then
    FPortType:=COM5;
  if Pos(msg,'COM6') > 0 then
    FPortType:=COM6;
  if Pos(msg,'COM7') > 0 then
    FPortType:=COM7;
  if Pos(msg,'COM8') > 0 then
    FPortType:=COM8;
  if Pos(msg,'COM9') > 0 then
    FPortType:=COM9;
  if Pos(msg,'COM10') > 0 then
    FPortType:=COM10;
  if Pos(msg,'COM11') > 0 then
    FPortType:=COM11;
  if Pos(msg,'COM12') > 0 then
    FPortType:=COM12;
  if Pos(msg,'COM13') > 0 then
    FPortType:=COM13;
  if Pos(msg,'COM14') > 0 then
    FPortType:=COM14;
  if Pos(msg,'COM15') > 0 then
    FPortType:=COM15;
  if Pos(msg,'COM16') > 0 then
    FPortType:=COM16;
  if Pos(msg,'COM17') > 0 then
    FPortType:=COM17;
  if Pos(msg,'COM18') > 0 then
    FPortType:=COM18;
  if Pos(msg,'COM19') > 0 then
    FPortType:=COM19;
  if Pos(msg,'COM20') > 0 then
    FPortType:=COM20;
  if Pos(msg,'COM21') > 0 then
    FPortType:=COM21;
  if Pos(msg,'COM22') > 0 then
    FPortType:=COM22;
  if Pos(msg,'COM23') > 0 then
    FPortType:=COM23;
  if Pos(msg,'COM24') > 0 then
    FPortType:=COM24;
  if Pos(msg,'COM25') > 0 then
    FPortType:=COM25;
  if Pos(msg,'COM26') > 0 then
    FPortType:=COM26;
  if Pos(msg,'COM27') > 0 then
    FPortType:=COM27;
  if Pos(msg,'COM28') > 0 then
    FPortType:=COM28;
  if Pos(msg,'COM29') > 0 then
    FPortType:=COM29;
  if Pos(msg,'COM30') > 0 then
    FPortType:=COM30;
end;

procedure TComPort.BaudRateFromString(msg: string);
begin
  if Pos(msg,'br110') > 0 then
    FBaudRate:=br110;
  if Pos(msg,'br300') > 0 then
    FBaudRate:=br300;
  if Pos(msg,'br600') > 0 then
    FBaudRate:=br600;
  if Pos(msg,'br1200') > 0 then
    FBaudRate:=br1200;
  if Pos(msg,'br2400') > 0 then
    FBaudRate:=br2400;
  if Pos(msg,'br4800') > 0 then
    FBaudRate:=br4800;
  if Pos(msg,'br9600') > 0 then
    FBaudRate:=br9600;
  if Pos(msg,'br14400') > 0 then
    FBaudRate:=br14400;
  if Pos(msg,'br19200') > 0 then
    FBaudRate:=br19200;
  if Pos(msg,'br38400') > 0 then
    FBaudRate:=br38400;
  if Pos(msg,'br56000') > 0 then
    FBaudRate:=br56000;
  if Pos(msg,'br57600') > 0 then
    FBaudRate:=br57600;
  if Pos(msg,'br115200') > 0 then
    FBaudRate:=br115200;
end;

procedure TComPort.BaudRateFromInteger(msg: integer);
begin
  case msg of
    110: FBaudRate:=br110;
    300: FBaudRate:=br300;
    600: FBaudRate:=br600;
    1200: FBaudRate:=br1200;
    2400: FBaudRate:=br2400;
    4800: FBaudRate:=br4800;
    9600: FBaudRate:=br9600;
    14400: FBaudRate:=br14400;
    19200: FBaudRate:=br19200;
    38400: FBaudRate:=br38400;
    56000: FBaudRate:=br56000;
    57600: FBaudRate:=br57600;
    115200: FBaudRate:=br115200;
  end;
end;

function TComPort.BaudRateInteger: integer;
begin
  case FBaudRate of
    br110: result := 110;
    br300: result := 300;
    br600: result := 600;
    br1200: result := 1200;
    br2400: result := 2400;
    br4800: result := 4800;
    br9600: result := 9600;
    br14400: result := 14400;
    br19200: result := 19200;
    br38400: result := 38400;
    br56000: result := 56000;
    br57600: result := 57600;
    br115200: result := 115200;
  else
    result := 0;
  end;
end;

procedure TComPort.ParityFromString(msg: string);
begin
  MultiMicro:=false;
  if Pos(msg,'prNone') > 0 then
    FParity:=prNone;
  if Pos(msg,'prOdd') > 0 then
    FParity:=prOdd;
  if Pos(msg,'prEven') > 0 then
    FParity:=prEven;
  if Pos(msg,'prMark') > 0 then
    FParity:=prMark;
  if Pos(msg,'prSpace') > 0 then
    FParity:=prSpace;
  if Pos(msg,'prMicro') > 0 then
  begin
    FParity:=prSpace;
    MultiMicro:=true;
  end;
end;

function TComPort.ParityString: string;
begin
  case FParity of
    prNone: result := 'None';
    prOdd: result := 'Odd';
    prEven: result := 'Even';
    prMark: result := 'Mark';
    prSpace: result := 'Space';
  else
    result := 'N.A.';
  end;
end;

procedure TComPort.ParityFromChar(msg: char);
begin
  MultiMicro:=false;
  case msg of
    'n': FParity:=prNone;
    'o': FParity:=prOdd;
    'e': FParity:=prEven;
    'm': FParity:=prMark;
    's': FParity:=prSpace;
  end;
end;

procedure TComPort.DataBitsFromString(msg: string);
begin
  if Pos (msg, '5') > 0 then
    FDataBits := 5;
  if Pos (msg, '6') > 0 then
    FDataBits := 6;
  if Pos (msg, '7') > 0 then
    FDataBits := 7;
  if Pos (msg, '8') > 0 then
    FDataBits := 8;
end;

procedure TComPort.DataBitsFromInteger(msg: integer);
begin
  case msg of
    5: FDataBits := 5;
    6: FDataBits := 6;
    7: FDataBits := 7;
    8: FDataBits := 8;
  end;
end;

function TComPort.DataBitsInteger: integer;
begin
  result := FDataBits;
end;

procedure TComPort.StopBitsFromString(msg: string);
begin
  if Pos(msg,'sbOneStopBit') > 0 then
    FStopBits:=sbOneStopBit;
  if Pos(msg,'sbOne5StopBits') > 0 then
    FStopBits:=sbOne5StopBits;
  if Pos(msg,'sbTwoStopBits') > 0 then
    FStopBits:=sbTwoStopBits;
end;

procedure TComPort.StopBitsFromInteger(msg: integer);
begin
  case msg of
    0: FStopBits:=sbOneStopBit;
    1: FStopBits:=sbOne5StopBits;
    2: FStopBits:=sbTwoStopBits;
  end;
end;

function TComPort.StopBitsString: String;
begin
  case FStopBits of
    sbOneStopBit: result := 'OneStopBit';
    sbOne5StopBits: result := 'One5StopBits';
    sbTwoStopBits: result := 'TwoStopBits';
    else
      result := 'N.A.';
  end;
end;

procedure TComPort.FlowFromString(msg: string);
begin
  if Pos(msg,'fcNone') > 0 then
    FFlowControl:=fcNone;
  if Pos(msg,'fcRtsCts') > 0 then
    FFlowControl:=fcRtsCts;
  if Pos(msg,'fcXonXoff') > 0 then
    FFlowControl:=fcXonXoff;
end;

procedure TComPort.FlowFromBoolean(soft, hard: boolean);
begin
  FFlowControl:=fcNone;
  if soft then
    FFlowControl:=fcXonXoff;
  if hard then
    FFlowControl:=fcRtsCts;
end;

function TComPort.FlowString: string;
begin
  case FFlowControl of
    fcNone: result := 'None';
    fcRtsCts: result := 'Hardware';
    fcXonXoff: result := 'Software (Xon-XOff)';
  else
    result := 'N.A.';
  end;
end;

function TComPort.IsConnected: boolean;
begin
  IsConnected:=FConnected;
end;


function ShowPropForm(ComPort: TComPort): Boolean;
begin
  with TCommFrm.Create(nil) do begin
    ComboBox1.ItemIndex := Integer(ComPort.Port);
    ComboBox2.ItemIndex := Integer(ComPort.BaudRate);
    ComboBox3.ItemIndex := Integer(ComPort.StopBits);
    ComboBox4.ItemIndex := ComPort.DataBits - 5;
    ComboBox5.ItemIndex := Integer(ComPort.Parity);
    ComboBox6.ItemIndex := Integer(ComPort.FlowControl);
    if ShowModal = mrOK then begin
      ComPort.Port := TPortType(ComboBox1.ItemIndex);
      ComPort.BaudRate := TBaudRate(ComboBox2.ItemIndex);
      ComPort.StopBits := TStopBits(ComboBox3.ItemIndex);
      ComPort.DataBits := ComboBox4.ItemIndex + 5;
      ComPort.Parity := TParity(ComboBox5.ItemIndex);
      ComPort.FlowControl := TFlowControl(ComboBox6.ItemIndex);
      Result := True;
    end
    else
      Result := False;
    Free;
  end;
end;
{
procedure TComPortEditor.ExecuteVerb(Index: Integer);
begin
  if Index = 0 then
    if ShowPropForm(TComPort(Component)) then
      Designer.Modified;
end;

function TComPortEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := 'Edit Properties';
  end;
end;

function TComPortEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;
}
procedure Register;
begin
  RegisterComponents('NCE', [TComPort]);
  //RegisterComponentEditor(TComPort, TComPortEditor);
end;

procedure TComPort.Connect(comport: String; baud, bits: integer;
  parity: char; stop: integer; softflow, hardflow: boolean);
begin
  ComFromString(comport);
  baudRateFromInteger(baud);
  dataBitsFromInteger(bits);
  parityFromChar(parity);
  stopBitsFromInteger(bits);
  flowFromBoolean(softflow, hardflow);
  self.Open;
end;


end.

grazie a tutti.