unit CommReader;

interface

uses
  Classes, Windows, SysUtils, StrUtils;

type
  TString = class
    sz: string;
    constructor Create(sz: string);
  end;

const
  ecuSendChar = $010000;
  ecuReadChar = $020000;

  ecuBounceStart = $0100;
  ecuBounceStop = $0200;
  ecuBounceParity = $0300;
  ecuBounceData = $0400;

  ContinuousTests: array [0..2] of String =
    ('Misfire monitoring', 'Fuel system monitoring',
     'Comprehensive component monitoring');
  NonContinuousTests: array [0..7] of String =
    ('Catalyst monitoring',
     'Heated catalyst monitoring',
     'Evaporative system monitoring',
     'Secondary air system monitoring',
     'A/C system refrigerant monitoring',
     'Oxygen sensor monitoring',
     'Oxygen sensor heater monitoring',
     'EGR system monitoring');
  PIDs: array [0..(66 - 36) * 3 - 1] of string =
    ('02', 'DTC that caused required freeze frame data storage', '2',
     '03', 'Fuel system 1/2 status', '2',
     '04', 'Calculated load value', '1',
     '05', 'Engine coolant temperature', '1',
     '06', 'Short Term Fuel Trim Bank 1, 3', '2',
     '07', 'Long Term Fuel Trim Bank 1, 3', '2',
     '08', 'Short Term Fuel Trim Bank 2, 4', '2',
     '09', 'Long Term Fuel Trim Bank 2, 4', '2',
     '0A', 'Fuel Rail Pressure (gauge)', '1',
     '0B', 'Intake Manifold Absolute Pressure', '1',
     '0C', 'Engine RPM', '2',
     '0D', 'Vehicle speed sensor', '1',
     '0E', 'Ignition Timing Advance for #1 Cylinder', '1',
     '0F', 'Intake Air Temperature', '1',
     '10', 'Air Flow Rate from Mass Air Flow Sensor', '2',
     '11', 'Absolute Throttle Position', '1',
     '12', 'Commanded Secondary Air Status', '1',
     '13', 'Location of Oxygen Sensors', '1',
     '14', 'Bank 1 – Sensor 1', '2',
     '15', 'Bank 1 – Sensor 2', '2',
     '16', 'Bank 1(2) – Sensor 3(1)', '2',
     '17', 'Bank 1(2) – Sensor 4(2)', '2',
     '18', 'Bank 1(3) – Sensor 1', '2',
     '19', 'Bank 1(3) – Sensor 2', '2',
     '1A', 'Bank 1(4) – Sensor 3(1)', '2',
     '1B', 'Bank 1(4) – Sensor 4(2)', '2',
     '1C', 'OBD requirements to which vehicle is designed', '1',
     '1D', 'Location of oxygen sensors', '1',
     '1E', 'Auxiliary Input Status',  '1',
     '1F', 'Time Since Engine Start', '2'
     );


type
  TEMUFeedback = (emuStart, emuStop, emuTesterPresent, emuChar, emuRow,
    emuBounce);

  TConnectionType = (conNullmodem, conJeff);
  TInterfaceType = (intELM323, intJeff, intAE);
  TProtocolType = (protoKW1281, protoKW2000);

  TByteArray = array of Byte;

  TReaderThread = class(TThread)
  private
  protected
    bEcho: Boolean;
    bLF: Boolean;
    szLog: string;
    procedure log;
    procedure Execute; override;
    procedure AnswerCommand(cmd: Byte);
    procedure RespondCommand(sz: string);

    procedure RespondAECommand(sz: string);

    function LF: string;

    function GetMonitorStatus: string;
  public
    oldTick: Cardinal;
    cc: _COMMCONFIG;
    ccsize: Cardinal;
    ct: _COMMTIMEOUTS;
    hcomm: THandle;
    szComm: string;
    bRunning: Boolean;
    overlapped: TOverlapped;
    eventcomm: THandle;
    iBlock: Integer;
    Connection: TConnectionType;
    IntFace: TInterfaceType;
    Proto: TProtocolType;
    procedure SendChar(c: Char); overload;
    procedure SendChar(c: Byte); overload;
    procedure SendString(sz: string);
    function ReadChar(TimeOut: Cardinal = INFINITE): Char;
    procedure SendBlock(sz: string; bLog: Boolean = False);
    procedure SendAck;
    function ReadPC: TByteArray;

    procedure SendKW2000(a: TByteArray);
    function ReadServiceRequest: TByteArray;
    function AnswerServiceRequest(data: TByteArray): Boolean;
    function RespondOBDII(sz: string): TStringList;
  end;

implementation

uses Main;

constructor TString.Create(sz: string);
begin
  Self.sz := sz;
end;

procedure TReaderThread.log;
begin
  frmMain.Log(szLog);
end;

procedure TReaderThread.SendChar(c: Char);
var
  bw: Cardinal;
  Result: Integer;
begin
  PostMessage(frmMain.Handle, $2000, WParam(emuChar), Integer(c) or ecuSendChar);
  WriteFile(hcomm, c, 1, bw, @overlapped);
  WaitForSingleObject(eventcomm, INFINITE);
  if Connection = conJeff then
  begin
    if not ReadFile(hcomm, c, 1, bw, @overlapped) then
    begin
      Result := GetLastError;
      if (Result = ERROR_IO_PENDING) then
      begin
        if (WaitForSingleObject(eventcomm, 200) = WAIT_TIMEOUT) then
        begin
          CancelIo(hcomm);
          szLog := 'SendChar(Char) Error';
          Synchronize(log);
          Abort;
        end;
      end else
      begin
        szLog := 'SendChar(Char).ReadFile: ' + SysErrorMessage(Result);
        Synchronize(log);
      end;
    end;
  end;
end;

procedure TReaderThread.SendChar(c: Byte);
var
  bw: Cardinal;
  Result: Integer;
begin
  PostMessage(frmMain.Handle, $2000, WParam(emuChar), Integer(c) or ecuSendChar);
  WriteFile(hcomm, c, 1, bw, @overlapped);
  WaitForSingleObject(eventcomm, INFINITE);
  if Connection = conJeff then
  begin
    if not ReadFile(hcomm, c, 1, bw, @overlapped) then
    begin
      Result := GetLastError;
      if (Result = ERROR_IO_PENDING) then
      begin
        if (WaitForSingleObject(eventcomm, 200) = WAIT_TIMEOUT) then
        begin
          CancelIo(hcomm);
          szLog := 'SendChar(Byte) Error';
          Synchronize(log);
          Abort;
        end;
      end else
      begin
        szLog := 'SendChar(Byte).ReadFile: ' + SysErrorMessage(Result);
        Synchronize(log);
      end;
    end;
  end;
end;

function TReaderThread.ReadChar(TimeOut: Cardinal = INFINITE): Char;
var
  br: Cardinal;
  Res: Integer;
begin
  if not ReadFile(hcomm, Result, 1, br, @overlapped) then
  begin
    Res := GetLastError;
    if (Res = ERROR_IO_PENDING) then
    begin
      Res := WaitForSingleObject(eventcomm, TimeOut);
      if (Res = WAIT_TIMEOUT) then
      begin
        CancelIo(hcomm);
        Result := #$00;
        szLog := 'ReadChar Error';
        Synchronize(log);
        Abort;
      end;
    end else
    begin
      szLog := 'ReadChar.ReadFile: ' + SysErrorMessage(GetLastError);
      Synchronize(log);
    end;
  end;
  if not GetOverlappedResult(hcomm, overlapped, br, FALSE) then
  begin
    szLog := 'ReadChar.GetOverlappedResult: ' + SysErrorMessage(GetLastError);
    Synchronize(log);
  end;
  PostMessage(frmMain.Handle, $2000, WParam(emuChar), Integer(Result) or ecuReadChar);
  if (Connection in [conNullmodem]) and (IntFace in [intJeff]) then
  begin
    WriteFile(hcomm, Result, 1, br, @overlapped);
    WaitForSingleObject(eventcomm, INFINITE);
  end;
  //szLog := Format('%.2x', [Ord(Result)]);
  //Synchronize(log);
end;

procedure TReaderThread.SendAck;
var
  c: Char;
  sz: string;
begin
  PostMessage(frmMain.Handle, $2000, WParam(emuRow), 0);
  sz := '->';

  c := Char(3);
  SendChar(c);
  sz := sz + Format('%.2x ', [Byte(c)]);
  ReadChar;

  c := Char(iBlock);
  SendChar(c);
  sz := sz + Format('%.2x ', [Byte(c)]);
  ReadChar;

  c := Char(9);
  SendChar(c);
  sz := sz + Format('%.2x ', [Byte(c)]);
  ReadChar;

  c := Char(3);
  SendChar(c);
  sz := sz + Format('%.2x ', [Byte(c)]);

  szLog := sz;
  //Synchronize(log);
  iBlock := iBlock + 1;
end;

function TReaderThread.ReadPC: TByteArray;
var
  c: Char;
  sz: string;
  bLog: Boolean;
  iMax: Integer;
  i: Integer;
begin
  PostMessage(frmMain.Handle, $2000, WParam(emuRow), 0);
  SetLength(Result, 0);

  bLog := False;
  sz := '<-';
  c := ReadChar;
  //SendChar(c);
  SetLength(Result, Length(Result) + 1); Result[Length(Result) - 1] := Byte(c);
  sz := sz + Format('%.2x ', [Byte(c)]);
  SendChar(Char(not Byte(c)));

  i := 1;
  iMax := Byte(c);
  while i < iMax do
  begin
    c := ReadChar;
    SendChar(Char(not Byte(c)));
    SetLength(Result, Length(Result) + 1); Result[Length(Result) - 1] := Byte(c);
    sz := sz + Format('%.2x ', [Byte(c)]);
    i := i + 1;
  end;
  c := ReadChar;
  sz := sz + Format('%.2x ', [Byte(c)]);

  if Result[2] <> 9 then
  begin
    szLog := sz;
    Synchronize(log);
  end;

  iBlock := iBlock + 1;
end;

procedure TReaderThread.SendBlock(sz: string; bLog: Boolean = False);
var
  c: Char;
  br: Cardinal;
  i: Integer;
  block: TByteArray;
begin
  PostMessage(frmMain.Handle, $2000, WParam(emuRow), 0);
  szLog := '->';
  c := Char(Length(sz) + 2);
  SendChar(c);
  szLog := szLog + Format('%.2x ', [Byte(c)]);
  //SendChar(ReadChar);
  ReadChar;
  Sleep(10);

  c := Char(iBlock);
  SendChar(c);
  szLog := szLog + Format('%.2x ', [Byte(c)]);
  //SendChar(ReadChar);
  ReadChar;
  Sleep(10);

  for i := 1 to Length(sz) do
  begin
    c := sz[i];
    SendChar(c);
    szLog := szLog + Format('%.2x ', [Byte(c)]);
    //SendChar(ReadChar);
    ReadChar;
    Sleep(10);
  end;
  c := #$03;
  SendChar(c);
  szLog := szLog + Format('%.2x ', [Byte(c)]);
  iBlock := iBlock + 1;

  block := ReadPC;
  Finalize(block);
  if bLog then
    Synchronize(log);
end;

procedure AddByte(var a: TByteArray; b: Byte);
begin
  SetLength(a, Length(a) + 1); a[Length(a) - 1] := b;
end;

function TReaderThread.ReadServiceRequest: TByteArray;
var
  c: Char;
  b: Byte;
  l: Byte;
  tgt: Byte;
  src: Byte;
  i: Integer;
  sz: string;
begin
  PostMessage(frmMain.Handle, $2000, WParam(emuRow), 0);

  sz := '<-';
  SetLength(Result, 0);
  c := ReadChar(3000);
  sz := sz + Format('%.2x ', [Byte(c)]);
  AddByte(Result, Byte(c));
  l := Byte(c) and (not (128 + 64));

  c := ReadChar(1000);
  sz := sz + Format('%.2x ', [Byte(c)]);
  tgt := Byte(c);
  AddByte(Result, Byte(c));

  c := ReadChar(1000);
  sz := sz + Format('%.2x ', [Byte(c)]);
  src := Byte(c);
  AddByte(Result, Byte(c));

  for i := 0 to l do
  begin
    c := ReadChar(1000);
    sz := sz + Format('%.2x ', [Byte(c)]);
    AddByte(Result, Byte(c));
  end;
  szLog := sz;
  //Synchronize(log);
end;

function GetCheckSum(a: TByteArray): Byte;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to Length(a) - 1 do
  begin
    Result := Result + a[i];
  end;
end;

procedure TReaderThread.SendKW2000(a: TByteArray);
var
  i: Integer;
begin
  for i := 0 to Length(a) - 1 do
  begin
    SendChar(a[i]);
  end;
end;

function ArrToBytes(a: TByteArray): string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to Length(a) - 1 do
  begin
    Result := Result + Format('%.2x ', [a[i]]);
  end;
end;

procedure AddToArr(var a: TByteArray; sz: string);
var
  i: Integer;
  iStart: Integer;
  szN: string;
begin
  iStart := Length(a);
  SetLength(a, Length(a) + Length(sz) div 3);
  for i := 1 to Length(sz) div 3 do
  begin
    szN := Copy(sz, i * 3 - 2, 2);
    a[iStart + i - 1] := Hex2Dec(szN);
  end;
  a[0] := a[0] + Length(sz) div 3;
end;

procedure AddCheckSum(var a: TByteArray);
begin
  SetLength(a, Length(a) + 1);
  a[Length(a) - 1] := 0;
  a[Length(a) - 1] := GetCheckSum(a);
end;

function TReaderThread.AnswerServiceRequest(data: TByteArray): Boolean;
var
  ans: TByteArray;
  sz: string;
  i: Integer;
  bLog: Boolean;
begin
  PostMessage(frmMain.Handle, $2000, WParam(emuRow), 0);
  Result := True;

  bLog := True;

  SetLength(ans, 3);
  if data[0] and $C0 = $C0 then
  begin
    ans[0] := $C0;
    ans[1] := data[2];
    ans[2] := $10;
  end else
  begin
    ans[0] := $80;
    ans[1] := data[2];
    ans[2] := data[1];
  end;

  if data[3] = $10 then
  begin
    SetLength(ans, 6);
    ans[0] := ans[0] + 2;
    ans[2] := data[1];
    ans[3] := $50;
    ans[4] := data[4];
    ans[5] := 0;
    ans[5] := GetCheckSum(ans);
  end else
  if data[3] = $3E then // testerPresent
  begin
    SetLength(ans, 5);
    ans[0] := ans[0] + 1;
    ans[2] := data[1];
    ans[3] := $7E;
    ans[4] := 0;
    ans[4] := GetCheckSum(ans);
    PostMessage(frmMain.Handle, $2000, WParam(emuTesterPresent), 0);
    bLog := False;
  end else
  if data[3] = $1A then
  begin
    sz := '123123';
    SetLength(ans, 6 + Length(sz));
    ans[0] := $80 + Length(ans) - 4;
    ans[1] := data[2];
    ans[2] := data[1];
    ans[3] := $5A;
    ans[4] := data[4];
    for i := 1 to Length(sz) do
    begin
      ans[4 + i] := Byte(sz[i]);
    end;
    ans[Length(ans) - 1] := 0;
    ans[Length(ans) - 1] := GetCheckSum(ans);
  end else
  if data[3] = $18 then
  begin
    sz := #$00#$01#$00#$00#$02#$00;
    SetLength(ans, 6 + Length(sz));
    ans[0] := $80 + Length(ans) - 4;
    ans[1] := data[2];
    ans[2] := data[1];
    ans[3] := $58;
    ans[4] := 2;
    for i := 1 to Length(sz) do
    begin
      ans[4 + i] := Byte(sz[i]);
    end;
    ans[Length(ans) - 1] := 0;
    ans[Length(ans) - 1] := GetCheckSum(ans);
  end else
  if data[3] = $14 then
  begin
    SetLength(ans, 5);
    ans[0] := ans[0] + 1;
    ans[2] := data[1];
    ans[3] := $54;
    ans[4] := data[4];
    ans[4] := GetCheckSum(ans);
  end else
  if data[3] = $82 then
  begin
    SetLength(ans, 5);
    ans[0] := ans[0] + 1;
    ans[2] := data[1];
    ans[3] := $C2;
    ans[4] := 0;
    ans[4] := GetCheckSum(ans);
    Result := False;
  end else
  if data[3] = $31 then
  begin
    SetLength(ans, 8);
    ans[0] := ans[0] + 4;
    ans[1] := data[2];
    ans[2] := data[1];
    ans[3] := $71;
    ans[4] := data[4];
    ans[5] := 1;
    ans[6] := 1;
    ans[7] := 0;
    ans[7] := GetCheckSum(ans);
  end else
  if (data[3] = $01) and (data[4] = $00) then // Get supported PIDs
  begin
    AddToArr(ans, '41 00 FF FF FF FF ');
    AddCheckSum(ans);
  end else
  if (data[3] = $01) and (data[4] = $01) then // PID - 1
  begin
    AddToArr(ans, '41 01 85 12 31 21 00 ');
    AddCheckSum(ans);
  end else
  if (data[3] = $03) then // Get DTCs
  begin
    AddtoArr(ans, '43 01 33 00 00 00 00 ');
    AddCheckSum(ans);
  end else
  if (data[3] = $04) then // Clear DTCs
  begin
    AddToArr(ans, '44 ');
    AddCheckSum(ans);
  end else
  if data[3] = $01 then
  begin
    sz := '41 ' + Format('%.2x', [data[4]]) + ' 00 01 ';
    if data[4] = $0C then
    begin
      sz := '41 ' + Format('%.2x', [data[4]]) + ' 35 00 ';
    end;
    if data[4] = $0D then
    begin
      sz := '41 ' + Format('%.2x', [data[4]]) + ' ' + Format('%.2x', [100]) + ' ';
    end;
    if data[4] = $05 then
    begin
      sz := '41 ' + Format('%.2x', [data[4]]) + ' 81 ';
    end;
    AddToArr(ans, sz);
    AddCheckSum(ans);
  end else
  begin
    SetLength(ans, 6);
    ans[0] := ans[0] + 2;
    ans[2] := data[1];
    ans[3] := $7F;
    ans[4] := data[3];
    ans[5] := 0;
    ans[5] := GetCheckSum(ans);
  end;
  if bLog then
  begin
    szLog := '<-' + ArrToBytes(data);
    Synchronize(log);
    szLog := '->' + ArrToBytes(ans);
    Synchronize(log);
  end;
  SendKW2000(ans);
  Finalize(ans);
end;

procedure TReaderThread.AnswerCommand(cmd: Byte);
var
  c: Char;
  bw: Cardinal;
  i: Integer;
  block: TByteArray;
begin
  try
    CancelIo(hcomm);
    if cmd = 51 then
    begin
      Sleep(300);
      SendChar(#$55);
      Sleep(10);
      //SendChar(#$08);  // ISO9142-2 OBD-II Compatible
      //SendChar(#$08);
      //SendChar(#$EF);    // ISO14230 OBD-II/EOBD Compatible
      //SendChar(#$8F);
      SendChar(#$E9);
      SendChar(#$8F);

      ReadChar(1000);

      SendChar(Char(255 - 51));

      while True do
      begin
        try
          block := ReadServiceRequest;
        except
          oldTick := 0;
          Exit;
        end;
        try
          if not AnswerServiceRequest(block) then
          begin
            oldTick := 0;
            Exit;
          end;
        finally
          Finalize(block);
        end;
      end;
    end;
    if cmd = 01 then
    begin
      if Proto = protoKW1281 then
      begin
        sleep(10);
        SendChar(#$55);

        sleep(100);

        SendChar(#$01); // 1281 - 018A, 818A, 8980, 010A, 010B, 0105, 0115
        SendChar(#$8A);
        //SendChar(#$C7); // 1281 - 018A, 818A, 8980, 010A, 010B, 0105, 0115
        //SendChar(#$80);
        c := ReadChar;

        SendBlock(#$F6'RSU906258? ');
        SendBlock(#$F6' 2.0 MP9.0 ');
        SendBlock(#$F6'2PZARSU3 ');
        SendBlock(#$F6'0261204???');
        SendBlock(#$F6'2227355???');
        SendAck;
        while True do
        begin
          block := ReadPC;
          try
            case block[2] of
              $09:
              begin
                SendAck;
                PostMessage(frmMain.Handle, $2000, WParam(emuTesterPresent), 0);
              end;
              $07:
              begin
                for i := 0 to 9 do
                begin
                  SendBlock(#$FC#$00 + Char(i + 0) + #$00, True);
                end;
                SendAck;
              end;
              $08:
              begin
                SendBlock(#$FB#$00#$02, True);
                SendAck;
              end;
              $29: // OBD
              begin
                case block[3] of
                  $64: SendBlock(#$E7#$10#$00#$04, True);
                  // Bits:
                  // Exhaust Gas Recirculation
                  // Oxygen Sensor Heating
                  // Oxygen Sensors(s)
                  // Air Conditioning
                  // Secondary Air Injection
                  // Evaporative Emissions
                  // Catalyst Heating
                  // Catalytic Converter(s)
                else
                  SendBlock(#$E7#$01#$74#$00#$27#$50#$00#$22#$3F#$80#$05#$09#$B1);
                  //SendBlock(#$02#$10#$00);
                end;
                SendAck;
              end;
              $06:
                Break;
              else
                SendAck;
            end;
          finally
            Finalize(block);
          end;
        end;
      end else
      if Proto = protoKW2000 then
      begin
        //SendChar(#$EF); // EF8F, E98F, 6B8F, 6D8F
        //SendChar(#$8F);
        Sleep(300);
        SendChar(#$55);
        SendChar(#$E9);
        SendChar(#$8F);

        ReadChar(1000);

        SendChar(#$FE);

        while True do
        begin
          try
            block := ReadServiceRequest;
          except
            oldTick := 0;
            Exit;
          end;
          try
            if not AnswerServiceRequest(block) then
            begin
              oldTick := 0;
              Exit;
            end;
          finally
            Finalize(block);
          end;
        end;
      end;
    end;
  finally
    PurgeComm(hcomm, PURGE_RXCLEAR or PURGE_TXCLEAR);
  end;
end;

function TReaderThread.LF: string;
begin
  if bLF then
    Result := #10
  else
    Result := '';
end;

procedure TReaderThread.SendString(sz: string);
var
  i: Integer;
begin
  for i := 1 to Length(sz) do
  begin
    SendChar(sz[i]);
  end;
end;

function AddAECheckSum(sz: string): string;
var
  i: Integer;
  chksum: Byte;
begin
  Result := sz;
  chksum := 0;
  for i := 6 to 13 do
  begin
    chksum := chksum + Byte(sz[i]);
  end;
  Result := Result + Char(chksum);
end;

function TReaderThread.GetMonitorStatus: string;
var
  A: Byte;
  B: Byte;
  C: Byte;
  D: Byte;
  i: Integer;
  tmp: Byte;
begin
  A := 0;
  if frmMain.chkMIL.Checked then
    A := A or 128;
  try
    i := StrToInt(frmMain.edtDTCs.Text);
    if (i > 127) or (i < 0) then
      Abort;
    A := A or i;
  except
    szLog := 'Value of current powertrain DTCs is invalid - should be a number between 0 and 127';
    Synchronize(log);
  end;

  B := 0;
  tmp := 1;
  for i := 0 to frmMain.lvCTS.Items.Count - 1 do
  begin
    if frmMain.lvCTS.Items[i].Checked then
      B := B or tmp;
    tmp := tmp shl 1;
  end;
  tmp := 16;
  for i := 0 to frmMain.lvCTR.Items.Count - 1 do
  begin
    if not frmMain.lvCTR.Items[i].Checked then
      B := B or tmp;
    tmp := tmp shl 1;
  end;

  C := 0;
  tmp := 1;
  for i := 0 to frmMain.lvNCTS.Items.Count - 1 do
  begin
    if frmMain.lvNCTS.Items[i].Checked then
      C := C or tmp;
    tmp := tmp shl 1;
  end;

  D := 0;
  tmp := 1;
  for i := 0 to frmMain.lvNCTR.Items.Count - 1 do
  begin
    if not frmMain.lvNCTR.Items[i].Checked then
      D := D or tmp;
    tmp := tmp shl 1;
  end;

  Result := Char(A) + Char(B) + Char(C) + Char(D);
end;

function GetSupportedPIDs(cMode: Char; cBase: Char): string;
var
  i: Integer;
  c: Cardinal;
  p: PChar;
  iPID: Integer;
begin
  if cMode = #$01 then
  begin
    c := 0;
    for i := 0 to frmMain.lvCPTPIDs.Items.Count - 1 do
    begin
      iPID := Hex2Dec(frmMain.lvCPTPIDs.Items[i].Caption);
      if (iPID and $E0 = Byte(cBase)) and
        (frmMain.lvCPTPIDs.Items[i].Checked) then
      begin
        c := c or ($80000000 shr ((iPID and $1F) - 1));
      end;
    end;
    p := @c;
    for i := 3 downto 0 do
    begin
      Result := Result + p[i];
    end;
  end;
end;

function GetPIDData(cMode: Char; cPID: Char): string;
var
  i: Integer;
  iPID: Integer;
  sz: string;
begin
  sz := '';
  Result := '';
  if cMode = #$01 then
  begin
    for i := 0 to frmMain.lvCPTPIDs.Items.Count - 1 do
    begin
      iPID := Hex2Dec(frmMain.lvCPTPIDs.Items[i].Caption);
      if (iPID = Byte(cPID)) then
      begin
        sz := TString(TList(frmMain.lvCPTPIDs.Items[i].Data)[1]).sz;
        Break;
      end;
    end;
    for i := 1 to Length(sz) do
    begin
      Result := Result + sz[i];
    end;
  end;
end;

function TReaderThread.RespondOBDII(sz: string): TStringList;
begin
  Result := TStringList.Create;
  if Length(sz) = 0 then
    Exit;
  if sz[1] = #$81 then
  begin
    Result.AddObject(#$C1, TString.Create('StartCommunication'));
  end else
  if sz[1] = #$01 then
  begin
    if sz[2] = #$00 then
    begin
      Result.AddObject(#$41#$00 + GetSupportedPIDs(sz[1], sz[2]), TString.Create('CPT Get supported PIDs'));
    end else
    if sz[2] = #$01 then
    begin
      Result.AddObject(#$41#$01 + GetMonitorStatus, TString.Create('CPT Get monitor status'));
    end else
    begin
      Result.AddObject(#$41 + sz[2] + GetPIDData(sz[1], sz[2]), TString.Create('CPT Get PID ' + Format('%.2x', [Byte(sz[2])])));
    end;
  end else
  if sz[1] = #$02 then
  begin
    if sz[2] = #$00 then
    begin
      Result.AddObject(#$42#$00 + sz[3] + #$FF#$00#$00#$00, TString.Create('FFPT Get supported PIDs'));
    end else
    if sz[2] = #$01 then
    begin
      Result.AddObject(#$42#$01#$00#$01, TString.Create('FFPT Get DTC number'));
    end else
    begin
      Result.AddObject(#$42 + sz[2] + #$00#$01, TString.Create('FFPT Get PID ' + Format('%.2x', [Byte(sz[2])])));
    end;
  end else
  if sz[1] = #$03 then
  begin
    Result.AddObject(#$43#$01#$33#$00#$00#$00#$00, TString.Create('Get DTCs'));
  end else
  if sz[1] = #$04 then
  begin
    Result.AddObject(#$44, TString.Create('Clear DTCs'));
  end else
  if sz[1] = #$06 then
  begin
    if sz[2] = #$00 then
    begin
      Result.Add(#$46#$00#$FF#$00#$00#$00);
    end else
    begin
      Result.Add(#$46 + sz[2] + #$01#$01#$01);
    end;
  end else
  if sz[1] = #$07 then
  begin
    Result.AddObject(#$47#$01#$33#$00#$00#$00#$00, TString.Create('Get C/L DTCs'));
  end else
  if sz[1] = #$08 then
  begin
    if sz[2] = #$00 then
    begin
      Result.AddObject(#$48#$00#$FF#$00#$00#$00, TString.Create('Get supported TIDs'));
    end else
    begin
      Result.AddObject(#$48 + sz[2] + #$00#$00#$00#$00#$00, TString.Create('Request control of OBDevice'));
    end;
  end else
  if sz[1] = #$09 then
  begin
    if sz[2] = #$02 then
    begin
      Result.AddObject(#$49#$02#$01'VF1J', TString.Create('Get VIN - frame 1'));
      Result.AddObject(#$49#$02#$02'M1B0', TString.Create('Get VIN - frame 2'));
      Result.AddObject(#$49#$02#$03'H322', TString.Create('Get VIN - frame 3'));
      Result.AddObject(#$49#$02#$04'8140', TString.Create('Get VIN - frame 4'));
      Result.AddObject(#$49#$02#$05'1', TString.Create('Get VIN - frame 5'));
    end;
  end;
end;

procedure TReaderThread.RespondAECommand(sz: string);
var
  i: Integer;
  j: Integer;
  szOBDII: string;
  szResponse: string;
  lst: TStringList;
begin
  // strip check sum character (currently we do not test it)
  Delete(sz, Length(sz), 1);
  if sz = #$FF#$80#$05#$00#$6A#$F1#$01#$00#$00#$00#$00#$00#$00#$00 then
  begin
    PostMessage(frmMain.Handle, $2000, WParam(emuRow), 0);
    SendString(#$80#$05#$00#$6A#$10#$F2#$84#$00#$00#$00#$00#$00#$00#$00);
  end else
  if sz = #$84#$80#$05#$00#$6A#$F1#$01#$00#$00#$00#$00#$00#$00#$00 then
  begin
    PostMessage(frmMain.Handle, $2000, WParam(emuRow), 0);
    SendString(#$80#$05#$00#$6A#$10#$F2#$84#$00#$00#$00#$00#$00#$00#$00);
  end else
  if True then
  begin
    szOBDII := Copy(sz, 7, Byte(sz[4]) and $0F);
    lst := RespondOBDII(szOBDII);
    try
      for i := 0 to lst.Count - 1 do
      begin
        szOBDII := lst[i];
        szResponse := Copy(sz, 2, 2) + Char(Length(szOBDII) or $80) + #$F1#$10 + szOBDII;
        for j := 1 to 8 - Length(szOBDII) do
        begin
          szResponse := szResponse + #$00;
        end;
        szResponse := AddAECheckSum(szResponse);
        PostMessage(frmMain.Handle, $2000, WParam(emuRow), LParam(lst.Objects[i]));
        SendString(szResponse);
      end;
    finally
      lst.Free;
    end;
  end else
  begin
    sz := '';
  end;
  PostMessage(frmMain.Handle, $2000, WParam(emuRow), 0);
end;

// Converts a string in the form '0101' or '01 01' to a string #$01#$01
function ELMToString(sz: string): string;
var
  i: Integer;
  szHex: string;
begin
  Result := '';
  szHex := '';
  for i := 1 to Length(sz) do
  begin
    if sz[i] = ' ' then
      Continue;
    szHex := szHex + sz[i];
    if Length(szHex) = 2 then
    begin
      Result := Result + Char(Hex2Dec(szHex));
      szHex := '';
    end;
  end;
end;

// Converts a string in the form #$01#$01 to a string '01 01';
function StringToELM(sz: string): string;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to Length(sz) do
  begin
    Result := Result + Format(' %.2x', [Byte(sz[i])]);
  end;
  Delete(Result, 1, 1); // Strip first space character
end;

procedure TReaderThread.RespondCommand(sz: string);
var
  bw: Cardinal;
  szResponse: string;
  iSpeed: Integer;
  szOBDII: string;
  i: Integer;
  lst: TStringList;
begin
  iSpeed := 100;
  sz := UpperCase(sz);
  if sz = 'ATZ' then
  begin
    bEcho := True;
    bLF := False;
    szResponse := 'ELM323 v2.0'#13 + LF + #13 + LF + '>';
  end else
  if sz = 'ATE0' then
  begin
    bEcho := False;
    szResponse := 'OK'#13 + LF + #13 + LF + '>';
  end else
  if sz = 'ATL0' then
  begin
    bLF := False;
    szResponse := 'OK'#13 + LF + #13 + LF + '>';
  end else
  if sz = 'ATL1' then
  begin
    bLF := True;
    szResponse := 'OK'#13 + LF + #13 + LF + '>';
  end else
  if sz = 'ATI' then
  begin
    szResponse := 'ELM323 v2.0'#13 + LF + #13 + LF + '>';
  end else
  if sz = 'ATE1' then
  begin
    bEcho := True;
    szResponse := 'OK'#13 + LF + #13 + LF + '>';
  end else
  begin
    szOBDII := ELMToString(sz);
    if szOBDII = '' then
    begin
      szResponse := '?'#13 + LF + '>';
    end else
    begin
      lst := RespondOBDII(szOBDII);
      try
        szResponse := '';
        for i := 0 to lst.Count - 1 do
        begin
          szResponse := szResponse + StringToELM(lst[i]) + #13 + LF;
          if lst.Objects[i] <> nil then
          begin
            TString(lst.Objects[i]).Free;
          end;
        end;
        if szResponse = '' then
          szResponse := 'NO DATA'#13 + LF;
        szResponse := szResponse + '>';
      finally
        lst.Free;
      end;
    end;
  end;
  WriteFile(hcomm, szResponse[1], Length(szResponse), bw, @overlapped);
  WaitForSingleObject(eventcomm, INFINITE);
  szLog := szResponse;
  Synchronize(log);
end;

procedure TReaderThread.Execute;
var
  br: Cardinal;
  c: Char;
  sz: string;
  szLast: string;
  szBuf: string;
  i: Integer;
  evtMask: Cardinal;
  bw: Cardinal;
  ms: Cardinal;
  bitCount: Integer;
  result: Integer;
  bWaitAgain: Boolean;
  bStartByte: Boolean;
  bByte: Byte;
  iBit: Integer;
  bOldByte: Byte;
  oldByteTick: Cardinal;
  bAdvanceBit: Boolean;
  handleflags: Cardinal;
  commerrors: Cardinal;
  currentTick: Cardinal;
  bBreakEvent: Boolean;
  iChars: Integer;
  szST: string;
begin
  try
    try
      iChars := 0;
      PostMessage(frmMain.Handle, $2000, WParam(emuStart), 0);

      SetupComm(hcomm, 8192, 8192);
      ccsize := SizeOf(cc);
      GetCommConfig(hcomm, cc, ccsize);

      if (Connection = conNullmodem) and
        (IntFace = intELM323) then
      begin
        cc.dcb.BaudRate := 9600;
        cc.dcb.ByteSize := 8;
        cc.dcb.StopBits := 0;
        cc.dcb.Flags := 1; // fBinary
        SetCommConfig(hcomm, cc, ccsize);

        bEcho := True;
        bLF := False;
        eventcomm := CreateEvent(nil, False, False, nil);
        if eventcomm = 0 then
        begin
          szLog := 'CreateEvent: ' + SysErrorMessage(GetLastError);
          Synchronize(log);
          Exit;
        end;

        if not SetCommMask(hcomm, EV_RXCHAR) then
        begin
          szLog := 'SetCommMask: ' + SysErrorMessage(GetLastError);
          Synchronize(log);
          Exit;
        end;

        overlapped.hEvent := eventcomm;

        while True do
        begin
          if not ReadFile(hcomm, c, 1, br, @overlapped) then
          begin
            Result := GetLastError;
            if Result = ERROR_IO_PENDING then
            begin
            end else
            begin
              szLog := 'ReadFile: ' + SysErrorMessage(Result);
              Synchronize(log);
              Exit;
            end;
          end;

          result := WaitForSingleObject(eventcomm, INFINITE);
          if result = WAIT_FAILED then
          begin
            szLog := 'WaitForSingleObject: ' + SysErrorMessage(GetLastError);
            Synchronize(log);
            Exit;
          end;

          if GetHandleInformation(hcomm, handleflags) then
          begin
            if bEcho then
              SendChar(c);
            if (c = #13) then
            begin
              szLog := sz;
              if bLF then
                SendChar(#10);
              Synchronize(log);
              if sz = '' then
                sz := szLast
              else
                szLast := sz;
              Sleep(200);
              RespondCommand(sz);
              sz := '';
            end else
            begin
              sz := sz + c;
            end;
          end else
          begin
            Exit;
          end;

          //szLog := 'char ' + Format('%d %.2x', [Ord(c), Ord(c)]);
          //szLog := IntToStr(GetTickCount) + ': char ' + Format('%d %.2x', [Ord(c), Ord(c)]);
          //Synchronize(log);
        end;
      end else
      if (Connection = conNullmodem) and
        (IntFace = intAE) then
      begin
        cc.dcb.BaudRate := 19200;
        cc.dcb.ByteSize := 8;
        cc.dcb.StopBits := 0;
        cc.dcb.Flags := 1; // fBinary
        SetCommConfig(hcomm, cc, ccsize);

        bEcho := True;
        bLF := False;
        eventcomm := CreateEvent(nil, False, False, nil);
        if eventcomm = 0 then
        begin
          szLog := 'CreateEvent: ' + SysErrorMessage(GetLastError);
          Synchronize(log);
          Exit;
        end;

        if not SetCommMask(hcomm, EV_RXCHAR) then
        begin
          szLog := 'SetCommMask: ' + SysErrorMessage(GetLastError);
          Synchronize(log);
          Exit;
        end;

        overlapped.hEvent := eventcomm;

        iChars := 0;
        while True do
        begin
          c := ReadChar;
          iChars := iChars + 1;

          if GetHandleInformation(hcomm, handleflags) then
          begin
            sz := sz + c;
            if (iChars = 15) then
            begin
              RespondAECommand(sz);
              sz := '';
              iChars := 0;
            end;
          end else
          begin
            szLog := SysErrorMessage(GetLastError);
            Exit;
          end;
        end;
      end;
      begin
        ms := 0;
        cc.dcb.BaudRate := 10400;
        //cc.dcb.BaudRate := 19200;
        cc.dcb.ByteSize := 8;
        cc.dcb.StopBits := 0;
        cc.dcb.Flags := 1; // fBinary
        SetCommConfig(hcomm, cc, ccsize);
        GetCommTimeouts(hcomm, ct);
        ct.ReadIntervalTimeout := 0;
        ct.ReadTotalTimeoutMultiplier := 0;
        ct.ReadTotalTimeoutConstant := 0;
        ct.WriteTotalTimeoutMultiplier := 0;
        ct.WriteTotalTimeoutConstant := 0;
        SetCommTimeouts(hcomm, ct);

        iBlock := 10;
        bStartByte := False;
        oldTick := 0;
        bRunning := True;

        EscapeCommFunction(hcomm, SETDTR);
        EscapeCommFunction(hcomm, CLRRTS);

        eventcomm := CreateEvent(nil, False, False, nil);
        if eventcomm = 0 then
        begin
          szLog := 'CreateEvent: ' + SysErrorMessage(GetLastError);
          Synchronize(log);
          Exit;
        end;

        if not SetCommMask(hcomm, EV_BREAK or {EV_CTS or }EV_RXCHAR) then
        begin
          szLog := 'SetCommMask: ' + SysErrorMessage(GetLastError);
          Synchronize(log);
          Exit;
        end;

        overlapped.hEvent := eventcomm;
        bWaitAgain := True;
        while bRunning do
        begin
          if bWaitAgain then
          begin
            evtMask := 0;
            if not WaitCommEvent(hcomm, evtMask, @overlapped) then
            begin
              Result := GetLastError;
              if Result <> ERROR_IO_PENDING then
              begin
                szLog := 'WaitCommEvent: ' + SysErrorMessage(Result);
                Synchronize(log);
                Exit;
              end;
            end;
          end;
          result := WaitForSingleObject(eventcomm, 200 - (GetTickCount - currentTick));
          currentTick := GetTickCount;
          if result = WAIT_FAILED then
          begin
            szLog := 'WaitForSingleObject: ' + SysErrorMessage(GetLastError);
            Synchronize(log);
            Exit;
          end;
          if result = WAIT_TIMEOUT then
          begin
            bWaitAgain := False;
            if (bStartByte) then
            begin
              bOldByte := bByte;
              oldByteTick := currentTick;

              EscapeCommFunction(hcomm, CLRDTR);
              EscapeCommFunction(hcomm, SETDTR);

              Result := WaitForSingleObject(eventcomm, 10);
              if Result = WAIT_TIMEOUT then
              begin
                ms := MS_CTS_ON;
              end else
              if Result = WAIT_FAILED then
              begin
                szLog := SysErrorMessage(GetLastError);
              end else
              begin
                ms := 0;
                if not GetOverlappedResult(hcomm, overlapped, br, FALSE) then
                begin
                  szLog := 'GetOverlappedResult: ' + SysErrorMessage(GetLastError);
                  Synchronize(log);
                  Exit;
                end;
                if eventcomm and EV_BREAK <> 0 then
                begin
                  bBreakEvent := True;
                end;
                bWaitAgain := True;
              end;

              if iBit < 7 then
              begin
                PostMessage(frmMain.Handle, $2000, WParam(emuBounce), LParam(ms <> MS_CTS_ON) or ecuBounceData);
                if ms and MS_CTS_ON <> 0 then
                begin
                  bByte := (bByte shr 1) or 128;
                end else
                begin
                  bByte := bByte shr 1
                end;
                szLog := 't' + IntToStr(currentTick - oldTick) + ' ' +IntToStr(bitCount) + ' bits bit' + IntToStr(iBit) + ' ' + IntToStr(Integer(ms and MS_CTS_ON <> 0)) + ' ' + IntToStr(bByte);
                Synchronize(log);
              end else
              if iBit = 7 then
              begin
                PostMessage(frmMain.Handle, $2000, WParam(emuBounce), LParam(ms <> MS_CTS_ON) or ecuBounceParity);
                szLog := 't' + IntToStr(currentTick - oldTick) + ' ' + IntToStr(bByte) + ' Parity';
                Synchronize(log);
              end else
              if iBit = 8 then
              begin
                PostMessage(frmMain.Handle, $2000, WParam(emuBounce), LParam(ms <> MS_CTS_ON) or ecuBounceStop);
                bByte := bByte shr 1;
                szLog := IntToStr(bByte) + ' Stop'#13#10;
                Synchronize(log);
                AnswerCommand(bByte);
                bWaitAgain := True;
                bStartByte := False;
                Continue;
              end;
              iBit := iBit + 1;
              oldTick := currentTick;
            end;
            Continue;
          end;
          bWaitAgain := True;
          if not GetOverlappedResult(hcomm, overlapped, br, FALSE) then
          begin
            szLog := 'GetOverlappedResult: ' + SysErrorMessage(GetLastError);
            Synchronize(log);
            Exit;
          end;
          if evtMask and EV_BREAK <> 0 then
          begin
            szLog := IntToStr(currentTick) + ' Break event';
            //Synchronize(log);
            evtMask := (evtMask and (not EV_BREAK)) or EV_CTS;
            ms := 0;
            bBreakEvent := True;
          end;
          if evtMask and EV_RXCHAR = EV_RXCHAR then
          begin
            if bBreakEvent then
            begin
              PurgeComm(hcomm, PURGE_TXCLEAR or PURGE_RXCLEAR);
              bBreakEvent := False;
              Continue;
            end;
            //szLog := IntToStr(currentTick) + ' Char event';
            //Synchronize(log);
            while ReadFile(hcomm, c, 1, br, @overlapped) do
            begin
              iChars := iChars + 1;
              if iChars > 20 then
              begin
                iChars := 1;
                PostMessage(frmMain.Handle, $2000, WParam(emuRow), 0);
              end;
              PostMessage(frmMain.Handle, $2000, WParam(emuChar), Integer(c) or ecuReadChar);

              // Echo
              if Connection in [conNullmodem] then
              begin
                if c = #$A5 then
                begin
                  c := #$E0;
                  SendChar(#$E0);
                end else
                begin
                  WriteFile(hcomm, c, 1, bw, @overlapped);
                  WaitForSingleObject(eventcomm, INFINITE);
                end;
              end;
            end;
            Result := GetLastError;
            if Result = ERROR_IO_PENDING then
            begin
              CancelIo(hcomm);
            end else
            begin
              szLog := 'ReadFile: ' + SysErrorMessage(Result);
              Synchronize(log);
              Exit;
            end;
            //szLog := 'char ' + Format('%d %.2x', [Ord(c), Ord(c)]);
            //szLog := IntToStr(GetTickCount) + ': char ' + Format('%d %.2x', [Ord(c), Ord(c)]);
            //Synchronize(log);
          end;
          if evtMask and EV_CTS <> 0 then
          begin
            {if not GetCommModemStatus(hcomm, ms) then
            begin
              szLog := 'GetCommModemStatus: ' + SysErrorMessage(GetLastError);
              Synchronize(log);
              Exit;
            end;}
            bitCount := Round((currentTick - oldTick) / 200);
            if not bStartByte then
            begin
              szLog := 'Start';
              PostMessage(frmMain.Handle, $2000, WParam(emuBounce), LParam(ms <> MS_CTS_ON) or ecuBounceStart);
              bStartByte := True;
              bByte := 0;
              iBit := 0;
              Synchronize(log);
              bitCount := 1;
            end else
            begin
              if currentTick - oldByteTick < 100 then
              begin
                bByte := bOldByte;
                szLog := 'Rolling back ' + IntToStr(bByte);
                Synchronize(log);
                bAdvanceBit := False;
              end else
              begin
                bAdvanceBit := True;
              end;

              if iBit = 7 then
              begin
                PostMessage(frmMain.Handle, $2000, WParam(emuBounce), LParam(ms <> MS_CTS_ON) or ecuBounceParity);
                szLog := 'c ' + IntToStr(bByte) + ' Parity';
                Synchronize(log);
              end else
              if iBit = 8 then
              begin
                PostMessage(frmMain.Handle, $2000, WParam(emuBounce), LParam(ms <> MS_CTS_ON) or ecuBounceStop);
                bByte := bByte shr 1;
                szLog := IntToStr(bByte) + ' Stop'#13#10;
                Synchronize(log);
                AnswerCommand(bByte);
                bWaitAgain := True;
                bStartByte := False;
                Continue;
              end else
              begin
                PostMessage(frmMain.Handle, $2000, WParam(emuBounce), LParam(ms <> MS_CTS_ON) or ecuBounceData);
                if ms and MS_CTS_ON <> 0 then
                begin
                  bByte := (bByte shr 1) or 128;
                end else
                begin
                  bByte := bByte shr 1;
                end;

                szLog := 'c' + IntToStr(currentTick - oldTick) + ' ' +IntToStr(bitCount) + ' bits bit' + IntToStr(iBit) + ' ' + IntToStr(Integer(ms and MS_CTS_ON <> 0)) + ' ' + IntToStr(bByte);
                Synchronize(log);
              end;
              if bAdvanceBit then
              begin
                iBit := iBit + 1;
              end;
            end;
          end;
          oldTick := currentTick;
        end;
      end;
    except
      on E: Exception do
      begin
        szLog := E.Message;
        Synchronize(log);
      end;
    end;
  finally
    if GetHandleInformation(hcomm, handleflags) then
      CloseHandle(hcomm);
    PostMessage(frmMain.Handle, $2000, WParam(emuStop), 0);
  end;
end;

end.
