Zugriffsverletzung bei Schreiben auf serielle Schnittstelle COM2

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Printers, Db, DBTables;

type
  TForm1 = class(TForm)
    //...
    Button_Pruefung: TButton;
    Timer1: TTimer;
    Timer_Sleep: TTimer;
    //...
    procedure Button_PruefungClick(Sender: TObject);
    function OpenCOM(Port: byte): boolean; stdcall;
    procedure InitOverlapped(var Overlapped : TOverlapped);
    procedure CloseCOM(portHandleClose: Integer); stdcall;
    function ComAvailable(ComNr: byte): boolean; stdcall;
    function SetBaudRate(baud: cardinal; portHandleBaud: Integer; portDCBbaud: TDCB): boolean; stdcall;
    function ReadString(var Buf: PChar; portHandleRead:Integer; readOL:TOverlapped): Cardinal; stdcall;
    function LiesAusCOM(var Buf: PChar; portHandleRead:Integer; readOL:TOverlapped): string;
    function SendString(Str: String; portHandleSend:Integer; writeOL:TOverlapped): boolean; stdcall;
    procedure warteAufTaste(zeit : longInt);
    procedure Timer_SleepTimer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  globalBaudrateTransponder:Integer =9600;
  globalPruefungLaeuft:boolean = false;
  globalSleeping:boolean = false;

  { Variablen für COM-Schnittstelle }
  PortTimeout : _COMMTIMEOUTS;
  PortHandle1, PortHandle2 : Integer;
  PortDCB1, PortDCB2 : TDCB;
  WriteOverlapped1,ReadOverlapped1,StatusOs1: TOverlapped;
  WriteOverlapped2,ReadOverlapped2,StatusOs2: TOverlapped;

  { Übergabe-String für ausgelesene Zeichen }
  StringReceived : String;

implementation

uses Unit2, Unit3;

{$R *.DFM}

procedure TForm1.Button_PruefungClick(Sender: TObject);
var Buf: string[255];
    sReceive: string;
    PBuf: PChar;
    BytesRead: cardinal;
    bKommunikationstestOK,bPruefungbeendet,bCOMmunicationOK:boolean;
    iCOMNummer: Integer;
    PortHandleX : Integer;
    PortDCBX : TDCB;
    WriteOverlappedX,ReadOverlappedX,StatusOsX: TOverlapped;
begin
  globalPruefungLaeuft:=true;
  iCOMNummer:=2; // COM1 verwenden
  {*** Kommunikation mit COM2 aufbauen ***}
    if not(ComAvailable(iCOMNummer)) then
    begin
      MessageDlg('Fehler: Prüfschnittstelle COM2 ist gerade in Benutzung.',mtError,[mbOK],0);  
    end
    else
    begin
      if not(OpenCOM(iCOMNummer)) then
      begin
        MessageDlg('Fehler beim Öffnen der Prüfschnittstelle COM2.',mtError,[mbOK],0);  
      end
      else
      begin
        // COM2 im Normalbetrieb verwenden
        PortHandleX:=PortHandle2;
        PortDCBX:=PortDCB2;
        WriteOverlappedX:=WriteOverlapped2;
        ReadOverlappedX:=ReadOverlapped2;
        StatusOsX:=StatusOs2;
        if not(SetBaudRate(globalBaudrateTransponder,PortHandleX,PortDCBX)) then
        begin
          MessageDlg('Fehler beim Setzen der Baudrate an der Prüfschnittstelle COM2.',mtError,[mbOK],0);  
        end
        else
        begin
  {*** Identi-Sequenz senden, um zu sehen, ob das Prüfgerät angeschlossen ist ***}
          // Vorbereiten der Hilfsvariablen für den Empfang
          sReceive:='';  
          PBuf:=@Buf;
          BytesRead:=0; // Zurücksetzen
          bKommunikationstestOK:=true;
          bCOMmunicationOK:=SendString(sIdenti,PortHandleX,WriteOverlappedX);
          if not(bCOMmunicationOK) then
          begin
            MessageDlg('Fehler bei Test der Kommunikation mit Prüfgerät: Senden von IDENTI.',mtError,[mbOK],0);  
            bKommunikationstestOK:=false;
          end
          else
          begin
            // Empfang von Antwortstring des Geräts über die Read-Abfrage
            warteAufTaste(1); // Sicherheits-Warten (1Sek), weil String gerade aktiv beschrieben werden könnte
            sReceive:=LiesAusCOM(Pchar(PBuf),PortHandleX,ReadOverlappedX);
            // Auswerten, ob sinnvolle Antwort erfolgte
            // 1.: ist nix empfangen worden?
            if (sReceive='') then  
            begin
              MessageDlg('Fehler bei Test der Kommunikation mit Prüfgerät: Keine Rückantwort.',mtError,[mbOK],0);  
              bKommunikationstestOK:=false;
            end
            else
            begin
            // 2.: ist Antwort mit erwartbarem Antwortstring identisch
              if (copy(sReceive,1,13)='AntwortAntwor') then  
              begin
                bKommunikationstestOK:=true;
              end
              else
              begin
                MessageDlg('Fehler bei Test der Kommunikation mit Prüfgerät: Falsche Rückantwort:'+sReceive,mtError,[mbOK],0);  
                bKommunikationstestOK:=false;
              end;
            end;
            if bKommunikationstestOK then
            begin
  {*** Startsequenz senden ***}
              // MessageDlg('Debug: Ist dieser Dialog aktiv, klappt das Senden.',mtInformation,[mbOK],0); //@@@debug   
              bCOMmunicationOK:=SendString(sStart,PortHandleX,WriteOverlappedX);
              if not(bCOMmunicationOK) then
              begin
                MessageDlg('Fehler bei Senden von Startsequenz.',mtError,[mbOK],0);  
                bKommunikationstestOK:=false;
              end
              else
              begin
                warteAufTaste(40);
                sReceive:=LiesAusCOM(Pchar(PBuf),PortHandleX,ReadOverlappedX);
                MessageDlg('Messergebnisstring: '+sReceive,mtInformation,[mbOK],0);  
                //...
              end; //Startsequenz senden und Prüfung ausführen
            end; // Kommunikationstest bestanden
          end; // Senden des ersten Identi-Strings
        end; // von Test Baudrate setzen
  {*** Schnittstelle COM2 schließen ***}
        CloseCOM(PortHandleX);
      end; // von Test OpenCom
    end; // von Test ComAvailable
end;

{ Schnittstelle öffnen/schließen }
function TForm1.OpenCOM(Port: byte): boolean; stdcall;
begin
 if (Port=1) then
 begin
  PortHandle1 :=
  CreateFile(PChar('\\.\COM'+IntToStr(Port)),GENERIC_READ or GENERIC_WRITE,0,  
             nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED,LongInt(0));
  //Overlapped = Asynchron auf Microsoftianisch
  if PortHandle1 > 0 then
  begin
    Result := true;
    InitOverlapped(WriteOverlapped1);
    InitOverlapped(ReadOverlapped1);
    InitOverlapped(StatusOs1);
  end else Result := false;
 end;
 if (Port=2) then
 begin
  PortHandle2 :=
  CreateFile(PChar('\\.\COM'+IntToStr(Port)),GENERIC_READ or GENERIC_WRITE,0,  
             nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED,LongInt(0));
  //Overlapped = Asynchron auf Microsoftianisch
  if PortHandle2 > 0 then
  begin
    Result := true;
    InitOverlapped(WriteOverlapped2);
    InitOverlapped(ReadOverlapped2);
    InitOverlapped(StatusOs2);
  end else Result := false;
 end;
end;

{ Initialisieren von Overlapped - Nötig für Öffnen des COM-Ports}
procedure TForm1.InitOverlapped(var Overlapped : TOverlapped);
begin
  Overlapped.Offset := 0;
  Overlapped.OffsetHigh := 0;
  Overlapped.Internal := 0;
  Overlapped.InternalHigh := 0;
  Overlapped.hEvent := CreateEvent(nil,True,False,'');  
end;

{ Schnittstelle schließen }
procedure TForm1.CloseCOM(portHandleClose: Integer); stdcall;
begin
  PurgeComm(portHandleClose, PURGE_RXABORT or PURGE_RXCLEAR or PURGE_TXABORT or PURGE_TXCLEAR);
  SetCommMask(portHandleClose,0); //unterbricht WaitCommEvent im Polling thread
  CloseHandle(portHandleClose);
  portHandleClose := 0;
end;

{ Schnittstelle prüfen }
function TForm1.ComAvailable(ComNr: byte): boolean; stdcall;
var
  TestHandle : integer;
begin
  TestHandle :=
  CreateFile(PChar('\\.\COM'+IntToStr(ComNr)),GENERIC_READ or GENERIC_WRITE,0,  
             nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED,LongInt(0));
  if (TestHandle <= 0) then
    Result := false
  else
  begin
    Result := true;
    CloseHandle(TestHandle);
  end;
end;

{ Baudrate setzen }
function TForm1.SetBaudRate(baud: cardinal; portHandleBaud: Integer; portDCBbaud: TDCB): boolean; stdcall;
begin
  GetCommState(portHandleBaud,portDCBbaud);
  portDCBbaud.BaudRate := baud;
  Result := SetCommState(portHandleBaud,portDCBbaud);
end; 

{ Lesen aus COM }
function TForm1.ReadString(var Buf: PChar; portHandleRead:Integer; readOL:TOverlapped): Cardinal; stdcall;
var
  StrBuf: string;
  Error,BytesRead: DWORD;
  Status: TComStat;
  RdSuccess: boolean;
begin
  BytesRead := 0;
  if (portHandleRead <> -1) then
  begin
    ClearCommError(portHandleRead,Error,@Status);
    case Error of
      CE_BREAK,CE_DNS,CE_FRAME,CE_IOE,CE_MODE,CE_OOP,CE_OVERRUN,CE_PTO,CE_RXOVER,
      CE_RXPARITY,CE_TXFULL:
      begin
        BytesRead := 0;
      end
    else
      begin
        SetLength(StrBuf,Status.cbInQue);
        RdSuccess := ReadFile(portHandleRead,StrBuf[1],Status.cbInQue,BytesRead,@readOL);
        if not RdSuccess then BytesRead := 0;
      end;
    end;
  end;
  if (BytesRead > 0) then
  begin
    Result := BytesRead;
    try
      StrPCopy(Buf,StrBuf);
    except
      Result := 0;
    end;
  end else Result := 0;
end;

{ Lesen aus COM und Rückgabe von ausgelesenem Wert }
function TForm1.LiesAusCOM(var Buf: PChar; portHandleRead:Integer; readOL:TOverlapped): string;
var
  StringReceived: string;
  BytesRead2: cardinal;
begin
            StringReceived:='';  
            BytesRead2:=Form1.ReadString(Buf,portHandleRead,readOL);
            // aus irgendeinem Grund wird beim 1. Einlesen per se nix empfangen -> deshalb nochmal einlesen
            BytesRead2:=Form1.ReadString(Buf,portHandleRead,readOL);
            StringReceived:=copy(Buf,1,BytesRead2);
            result:=StringReceived;
end;

{ Schreiben auf COM }
function TForm1.SendString(Str: String; portHandleSend:Integer; writeOL:TOverlapped): boolean; stdcall;
var
  written  : cardinal;
  tmpStr : string;
  i: LongBool;
begin
  if (portHandleSend <> 0) then
  begin
    tmpStr := string(Str);
    Result := not WriteFile(portHandleSend,tmpStr[1],Length(tmpStr),written,@writeOL);
  end;
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if key=char(VK_ESCAPE) then
  begin
    globalPruefungLaeuft:=false;
  end;
end;

procedure TForm1.OnAppMsg(var Msg: TMsg; var Handled: Boolean); //@@@test
begin
  Handled:=false;
  if (Msg.message=WM_KEYDOWN) then // bei Tastendruck
  begin
    if (Msg.wParam=VK_ESCAPE) then // wenn ESC gedrückt wurde
    begin
      globalPruefungLaeuft:=false;
      Handled:=true;
    end;
  end;
end;

{ Pause für *zeit* Sekunden, jedoch mit Reaktion auf Events }
procedure TForm1.warteAufTaste(zeit : Integer);
begin
  globalSleeping:=true;
  Timer_Sleep.Enabled:=false;
  Timer_Sleep.Interval:=zeit*1000;
  Timer_Sleep.Enabled:=true;
  while ((globalSleeping) and (globalPruefungLaeuft)) do
  begin
    Application.ProcessMessages;
  end;
  Timer_Sleep.Enabled:=false;
  globalSleeping:=false;
end;

procedure TForm1.Timer_SleepTimer(Sender: TObject);
begin
  globalSleeping:=false;
  Timer_Sleep.Enabled:=false;
end;


end.