{*******************************************************}
{                                                       }
{       nrCommLib Communication Library for Delphi      }
{       Bar Code Scanner device connection (VCL)        }
{       Copyright (c) 1997-2011 Roman Novgorodov        }
{       v9.27                                           }
{       last update: 17 Dec 2010                        }
{                                                       }
{       e-mail:noro@deepsoftware.com                    }
{       DeepSoftware                                    }
{       http://www.deepsoftware.com/                    }
{                                                       }
{*******************************************************}
{$I nrcommlib.inc}
unit nrbarcode;
interface
uses  nrwin32, windows,
      nrcomm, nrclasses, classes;


Const
  CER_ONBARCODE_EXCEPTION = 1;

Type

  TBarcodeOptions=set of(boAutoDetect,boInitConnection,boUseEndChar,boUseBeginChar,
                  boAnyChars);
  TOnBarCodeEvent=procedure(Sender:TObject; BarCode:String) of object;

  TnrBarCodeScan=class(TnrCustomSerialComm)
  private
    Timer:TnrTimer;
    fCharBegin: char;
    fCharEnd: char;
    fOptions: TBarcodeOptions;
    sBarCode:string;
    fOnBarcode: TOnBarCodeEvent;
    fLastBarCode: string;
    fTimeOut: cardinal;
    fIgnoreChars: string;
    procedure DoReceive(Com:TObject;Buffer:Pointer;Received:Cardinal);
    procedure DoBarcode;
    procedure DoTimer(Sender:TObject);
    function GetCharBegin: char;
    function GetCharEnd: char;
    function GetOnBarcode: TOnBarCodeEvent;
    function GetOptions: TBarcodeOptions;
    function GetTimeOut: cardinal;
    procedure SetCharBegin(const Value: char);
    procedure SetCharEnd(const Value: char);
    procedure SetOnBarCode(const Value: TOnBarCodeEvent);
    procedure SetOptions(const Value: TBarcodeOptions);
    procedure SetTimeOut(const Value: cardinal);
  protected
    procedure InitAfterOpen; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy;override;
    property BarCode:string read fLastBarCode;
  published
    property CharBegin:char read GetCharBegin write SetCharBegin default #0;
    property CharEnd:char read GetCharEnd write SetCharEnd default #0;
    property Timeout:cardinal read GetTimeOut write SetTimeOut;
    property Active;
    property Options:TBarcodeOptions read GetOptions write SetOptions;
    property BaudRate;
    property Parity;
    property StopBits;
    property ByteSize;
    property ComPortNo;
    property ComPort;
    property StreamProtocol;
    property OnBarCode:TOnBarCodeEvent read GetOnBarcode write SetOnBarCode;
    property IgnoreChars:string read fIgnoreChars write fIgnoreChars;
    property OnClose;
    property UseMainThread;
    property EnumPorts;
  end;

implementation
uses sysutils;

{ TnrBarCodeScan }

constructor TnrBarCodeScan.Create(AOwner: TComponent);
begin
  inherited;
  TraceStates := [tsRxChar];
  OnAfterReceive := DoReceive;
//  fIgnoreChars:=#10;
  BaudRate := 9600;
  ByteSize := 8;
  Parity := pNone;
  StopBits := sbOne;
  StreamProtocol := spHardware;
  fCharBegin := #0;
  fCharEnd := #13;
  fOptions :=[boAutoDetect];
  Timer := TnrTimer.Create;//(Self);
  Timer.Enabled := False;
  Timer.OnTimer := DoTimer;
  fTimeOut := 50;
  Timer.Interval := fTimeOut;
end;

{$IFDEF TRIAL}
var ecx : integer;
{$ENDIF}

destructor TnrBarCodeScan.Destroy;
begin
  Timer.Free;
  inherited;
end;

procedure TnrBarCodeScan.DoTimer(Sender: TObject);
begin
  Timer.Enabled := False;
  DoBarCode;
end;

{$IFDEF TRIAL}
Const
  //You are using nrComm Lib trial version!
  //Please register! xor c
  esi:string=
#$3A#$0C#$16#$43#$02#$11#$06#$43#$16#$10#$0A#$0D#$04#$43#$17#$11+
#$0A#$02#$0F#$43#$0D#$11#$20#$0C#$0E#$0E#$2F#$0A#$01#$43#$15#$06+
#$11#$10#$0A#$0C#$0D#$42#$6E#$69#$33#$0F#$06#$02#$10#$06#$43#$11+
#$06#$04#$0A#$10#$17#$06#$11#$42;
{$ENDIF}

function TnrBarCodeScan.GetCharBegin: char;
begin
  Result := fCharBegin;
end;

function TnrBarCodeScan.GetCharEnd: char;
begin
  Result := fCharEnd;
end;

procedure TnrBarCodeScan.DoReceive(Com:TObject;Buffer:Pointer;Received:Cardinal);
var i:integer;
    ch:AnsiChar;
    s:string;
begin
  s := '';
  Timer.Enabled := False;
  for i := 0 to Received - 1 do begin
    ch := PAnsiChar(Buffer)[i];

    if Log <> nil then s := s + IntToHex(byte(ch), 2) + 'h ';


    if(boUseBeginChar in fOptions) and (ch = AnsiChar(fCharBegin))then begin
      sBarCode := '';
      continue;
    end;
    if(boUseEndChar in fOptions)and(ch = AnsiChar(fCharEnd))then begin
      {$IFDEF TRIAL}
      Inc(ecx);
      {$ENDIF}
      DoBarCode;
      {$IFDEF TRIAL}
      OutputDebugString('You are using trial version !!!');
      {$ENDIF}
      continue;
    end;
    if((ch < #$30) or (ch > #$39)) and (not (boAnyChars in fOptions))then begin
      if (boAutoDetect in fOptions) then begin
        {$IFDEF TRIAL}
        Inc(ecx);
        {$ENDIF}
        DoBarCode;
      end;
      continue;
    end;
    if Pos(Char(ch), IgnoreChars) <= 0 then sBarCode := sBarCode + Char(ch);
  end;

  if(boAutoDetect in fOptions) and (sBarCode <> '') then begin
    Timer.Interval := fTimeOut;
    Timer.Enabled := True;
  end;

  if Log <> nil then begin
    Logging(dlDetail, 'Data: ' + s );
  end;

end;

function TnrBarCodeScan.GetOnBarcode: TOnBarCodeEvent;
begin
  Result := fOnBarCode;
end;

function TnrBarCodeScan.GetOptions: TBarcodeOptions;
begin
  Result := fOptions;
end;

function TnrBarCodeScan.GetTimeOut: cardinal;
begin
  Result := fTimeOut;
end;

procedure TnrBarCodeScan.InitAfterOpen;
begin
  inherited;
  if boInitConnection in fOptions then InitDeviceConnect;
end;

{$IFDEF TRIAL}
function eax:string;
var i:integer;
begin
  Result := '';
  for i := 1 to 55 do Result := Result + Char(Byte(esi[i]) xor Byte('c'));
end;
{$ENDIF}

procedure TnrBarCodeScan.SetCharBegin(const Value: char);
begin
  fCharBegin:=Value;
end;

procedure TnrBarCodeScan.SetCharEnd(const Value: char);
begin
  fCharEnd:=Value;
end;

procedure TnrBarCodeScan.SetOnBarCode(const Value: TOnBarCodeEvent);
begin
  fOnBarcode:=Value;
end;

procedure TnrBarCodeScan.SetOptions(const Value: TBarcodeOptions);
begin
  fOptions:=Value;
end;

procedure TnrBarCodeScan.DoBarcode;
begin
  if sBarCode = '' then exit;
  fLastBarCode := sBarCode;
  LoggingFmt(dlDetail,'DoBarcode: %s', [sBarCode]);
  sBarCode := '';
  if Assigned(fOnBarCode) then begin
    {$IFDEF TRIAL}         ///!!!!!!!!!!!!!!
    if (ecx mod 3) = 0 then begin
      fOnBarCode(Self, fLastBarCode);
      MessageBox(GetMainWindowHandle,PChar(eax), '', 0);
    end else
    {$ENDIF}
    fOnBarCode(Self, fLastBarCode);
  end;
end;

procedure TnrBarCodeScan.SetTimeOut(const Value: cardinal);
begin
  fTimeOut:=Value;
end;

end.
