Einzelnen Beitrag anzeigen

hlware

Registriert seit: 2. Jul 2010
Ort: Würzburg
5 Beiträge
 
Turbo Delphi für Win32
 
#12

AW: Problem mit Kommunikation mit Comport über WinApi

  Alt 5. Okt 2011, 12:15
Hallo,

Meine endgültige Lösung sah damals so aus: (Heute würde ich das Grundlegend anders aufbauen, aber es funktionierte)

Delphi-Quellcode:
unit cComDigital;

interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
  cCom = class
     public
        
        availablePorts : TStringList;
        
        procedure cComInitialize;

        function GethCom(): Thandle;
        procedure SethCom(hCom2 : THandle);

        procedure ReadAvailableComPorts();

        function ConnectToComPort(Connect : Boolean; Port: String):Boolean;
        function DisconnectComPort(Port: String) : Boolean;

        function WriteDataToCOMPort(cByte: Integer):Boolean;
       

     private
        hCom: THandle;
        DCB: TDCB;
        TimeOut: TCommTimeouts;
        ChosenPort : String;
        
        function SetDCBproperties() : Boolean;
        function SetcComTimeOut() : Boolean;

  end;

implementation

// Klassenimplementierung cCom
procedure cCom.cComInitialize;
begin
    SethCom(0);
end;

procedure cCom.ReadAvailableComPorts;
var
  TestHandle : THandle;
  i : integer;
begin
  availablePorts := TStringList.Create;
  for i := 1 to 10 do
  begin
    TestHandle := CreateFile(PChar({'\\.\COM'}'COM'+IntToStr(i)),GENERIC_READ or GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED,LongInt(0));
    if (TestHandle > 0) then
    begin
      availablePorts.Add('COM'+ IntToStr(i));
      CloseHandle(TestHandle);
    end;
  end;
end;

function cCom.SetDCBproperties;
begin
    if hCom > 0 then
    begin
      GetCommState(GethCom(),DCB);
      DCB.DCBlength := SizeOf(DCB);
      DCB.ByteSize := 8;
      DCB.Parity := NoParity;
      DCB.StopBits := TWOSTOPBITS;
      DCB.BaudRate := 2400;
      DCB.Flags := 5123; { Wenn 2 Pins belegt sind } //4113
      DCB.EofChar := #0;
      DCB.ErrorChar := #0;
      DCB.EvtChar := #0;
      DCB.XoffChar := #0;
      DCB.XoffLim := 0;
      DCB.XonChar := #0;
      DCB.XonLim := 0;
      SetCommState(GethCom(),DCB);
    end;
end;

function cCom.SetcComTimeOut;
begin
    if hCom > 0 then
    begin
      GetCommTimeOuts(GethCom(), TimeOut);

      TimeOut.ReadIntervalTimeOut := 100;
      TimeOut.ReadTotalTimeoutMultiplier := 0;
      TimeOut.ReadTotalTimeoutConstant := 250;

      TimeOut.WriteTotalTimeoutMultiplier := 0;
      TimeOut.WriteTotalTimeoutConstant := 200;
      SetCommTimeouts(hCom, TimeOut);
    end;
end;

function cCom.GethCom;
begin
  GethCom := hCom;
end;

function cCom.ConnectToComPort(Connect: Boolean; Port : String) : Boolean;
Var i : Integer;
begin
   // Mit ComPort (hCom) verbinden

    if Connect = True then
    begin
      i := 0;
      while (GethCom <= 0) and (i < 10) do begin
          SethCom((CreateFile(pChar(Port), GENERIC_READ or GENERIC_WRITE,
                              0, nil, OPEN_EXISTING, 0, 0)));
          inc(i);
      end;
      if GethCom() = INVALID_HANDLE_VALUE then begin
          ShowMessage('Fehler '+IntToStr(GetLastError())+': Schnittstelle konnte nicht geöffnet werden!' + #13#10 + 'Bite die richtige Schnittstelle einstellen!');
          ConnectToComPort := false;
      end
      else begin
      // Set DCB, Timeouts etc.
          if SetDCBproperties() then
              begin
                  if SetcComTimeOut() then
                    ConnectToComPort := true
                  else begin
                      ShowMessage('Fehler '+IntToStr(GetLastError())+': Timeouts konnten nicht gesetzt werden!');
                      ConnectToComPort := false;
                  end;
              end
          else begin
              ShowMessage('Fehler '+IntToStr(GetLastError())+': Schnittstellen-Eigenschaften konnten nicht gesetzt werden!');
              ConnectToComPort := false;
          end;
      end;
    end
    else
    begin
          FileClose(GethCom());
          SethCom(0);
    end;

end;

function cCom.DisconnectComPort(Port: String):Boolean;
begin
    ConnectToComPort(false,Port);
end;

function cCom.WriteDataToCOMPort(cByte: Integer) : Boolean;
var i : integer;
    j : char;
begin
// Byte an Com Port schicken
    if GethCom > 0 then
    begin
      j := chr(cByte);
      i := FileWrite(GethCom(), j, 1);
      if i > 0 then WriteDataToCOMPort := True
      else WriteDataToCOMPort := False;
    end;
end;

procedure cCom.SethCom(hCom2: THandle);
begin
  hCom := hCom2;
end;

end.
Verwendet habe ich die Klasse dann so:

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin
cCom1 := cDigital.Create();
  cCom1.cComInitialize;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if cCom1.GethCom > 0 then begin
    FileClose(cCom1.GethCom);
    cCom1.SethCom(0);
  end;
end;
  Mit Zitat antworten Zitat