{*******************************************************}
{                                                       }
{       nrCommLib Communication Library for Delphi      }
{       TnrUSBPipePair class declaration (VCL)          }
{       Copyright (c) 1997-2011 Roman Novgorodov        }
{       v9.27                                           }
{       last update: 12 Nov 2011                        }
{                                                       }
{       e-mail:noro@deepsoftware.com                    }
{       DeepSoftware                                    }
{       http://www.deepsoftware.com/                    }
{                                                       }
{*******************************************************}
{$I nrcommlib.inc}
unit nrusbpipe;
interface
uses nrclasses,nrwin32,windows,nrusbw32,messages,nrddbasew32, classes,
     nrusb, nrusbman;

Type

  TnrUSBPipePair = class(TnrBaseIO)
  private
    fUsbDevice : TnrUSB;
    fPipeIn:integer;
    fPipeOut:integer;
    fIdPipeIn:byte;
    fIdPipeOut:byte;
    fInputBuffer:PAnsiChar;
//    fPolicy: TnrUsbPipePolicies;
    fTimeoutWrite: dword;
    fTimeoutRead: dword;
    szRead : dword;
    fReadBufferSize:dword;
    //fOnReceived: TOnReceived;
    function GetUsbDevice: TnrUSB;
    procedure SetUsbDevice(const Value: TnrUSB);
    function GetPipeIn: integer;
    function GetPipeOut: integer;
    procedure SetPipeIn(const Value: integer);
    procedure SetPipeOut(const Value: integer);
    procedure UpdatePipeId;
//    procedure ApplyPolicy(pipeid:byte);
    procedure ApplySettings;
    function GetBufferSizeRead: dword;
    procedure SetReadBufferSize(const Value: dword);
  protected
//    fUsbHandle:dword;
    hEventThread : THandle;
    function RequestDeviceHandle: THandle; override;
    procedure RequestDeviceHandleClose(aHandle: THandle); override;
    procedure Open;  override;
    procedure Close; override;
    procedure ThreadExecute(aThread:TThread); override;
    procedure DoInputDataInMainThread;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy;override;
    procedure Reset;
    procedure Abort;
    procedure Flush;
    procedure SendChar(const Ch:Char);    override;
    procedure SendString(const S:AnsiString);    override;
    procedure SendData(const Buff:PAnsiChar;const N:cardinal);override;
    property IdPipeIn:byte read fIdPipeIn;
    property IdPipeOut:byte read fIdPipeOut;
  published
    property Active;
    property DataProcessor;
    property Terminal;
    property TerminalUsage;
    property Log;
    property OnFatalError;
    property UsbDevice:TnrUSB read GetUsbDevice write SetUsbDevice;
    property PipeIn:integer read GetPipeIn write SetPipeIn;
    property PipeOut:integer read GetPipeOut write SetPipeOut;
//    property Policy:TnrUsbPipePolicies read fPolicy write fPolicy;
    property TimeoutRead:dword read fTimeoutRead write fTimeoutRead;
    property TimeoutWrite:dword read fTimeoutWrite write fTimeoutWrite;
    property ReadBufferSize:dword read GetBufferSizeRead write SetReadBufferSize;
    property UseMainThread;
    property Priority;
    property OnAfterReceive;//:TOnReceived read fOnReceived write fOnReceived;
  end;

implementation
uses sysutils, shellapi, nrusb_winusb_api;

{ TnrUSBPipePair }

constructor TnrUSBPipePair.Create(AOwner: TComponent);
begin
  inherited;
  isThreaded := True;
  if (AOwner <> nil) and (AOwner is TnrUSB)
    then fUsbDevice := TnrUSB(AOwner);
  fPipeIn := -1;
  fPipeOut := -1;
  fReadBufferSize := 512;
//  fPolicy := [];
  hEventThread := CreateEvent(nil, false, false, nil);
end;

destructor TnrUSBPipePair.Destroy;
begin
  if Active then Close;
  CloseHandle(hEventThread);
  inherited;
end;

procedure TnrUSBPipePair.UpdatePipeId;
begin
  fIdPipeIn := 0;
  fIdPipeOut := 0;
  if Assigned(fUsbDevice) and Assigned(fUsbDevice.UsbDevice) then begin
     if (fPipeIn >= 0) and  (fPipeIn < fUsbDevice.UsbDevice.PipeCount)
       then fIdPipeIn := fUsbDevice.UsbDevice.Pipes[fPipeIn].ID;
     if (fPipeOut >= 0) and  (fPipeOut < fUsbDevice.UsbDevice.PipeCount)
       then fIdPipeOut := fUsbDevice.UsbDevice.Pipes[fPipeOut].ID;
  end;
end;

function TnrUSBPipePair.GetPipeIn: integer;
begin
  Result := fPipeIn;
end;

function TnrUSBPipePair.GetPipeOut: integer;
begin
  Result := fPipeOut;
end;

function TnrUSBPipePair.GetUsbDevice: TnrUSB;
begin
  Result := fUsbDevice;
end;

procedure TnrUSBPipePair.SetPipeIn(const Value: integer);
begin
  fPipeIn := Value;
  UpdatePipeId;
end;

procedure TnrUSBPipePair.SetPipeOut(const Value: integer);
begin
  fPipeOut := Value;
  UpdatePipeId;
end;

procedure TnrUSBPipePair.SetUsbDevice(const Value: TnrUSB);
begin
  fUsbDevice := Value;
  UpdatePipeId;
end;

procedure TnrUSBPipePair.ThreadExecute(aThread: TThread);
var ov : TOverlapped;
    sz : dword;
    res : boolean;
begin
  UpdatePipeId;

//  OutputDebugString('Pipe thread start ... ');

  if fIdPipeIn = 0 then exit;

  sz := fReadBufferSize;
  if sz <= 0 then sz := 1;
  fInputBuffer := PAnsiChar(LocalAlloc(LPTR, sz));
//  ZeroMemory(@ov, SizeOf(ov) - 4);
//  ov.hEvent := CreateEvent(nil, false, false, nil); // hEventThread;
  ov.hEvent := hEventThread;
  try

    while not IsThreadIOTerminated do begin
      //szRead := 0;
      ZeroMemory(@ov, SizeOf(ov) - SizeOf(THandle));
      fUsbDevice.Api.PreparePipe(fIdPipeIn, 0, fUsbDevice.UsbDevice.Pipes[fPipeIn].TransferType);
      szRead := fUsbDevice.Api.Read(fIdPipeIn, fInputBuffer, sz, @ov);
      if IsThreadIOTerminated then break;
      if szRead <= 0 then begin
        if GetLastError() = ERROR_IO_PENDING then begin
          res := fUsbDevice.Api.GetOverlappedResult(@ov, szRead, INFINITE);
          if IsThreadIOTerminated or ((not res) and (GetLastError <> ERROR_IO_PENDING)) then break;
        end;
      end;

      if szRead > 0 then DoInputData(fInputBuffer, szRead);

    end;

  finally
    LocalFree(THandle(fInputBuffer));
    //CloseHandle(ov.hEvent);
  end;
//  OutputDebugString('... exit pipe thread.');
  IsThreadIOTerminated := True;
end;

procedure TnrUSBPipePair.DoInputDataInMainThread;
begin
  DoInputData(fInputBuffer, szRead);
end;

procedure TnrUSBPipePair.Open;
begin
  isThreaded := IsReadNeeded;
  inherited Open;
end;

procedure TnrUSBPipePair.Close;
begin
  IsThreadIOTerminated := True;
  SetEvent(hEventThread);
//  CloseHandle(hEventThread);
  inherited Close;
  SetEvent(hEventThread);
end;

function TnrUSBPipePair.RequestDeviceHandle: THandle;
begin
  UpdatePipeId;
  if (fIdPipeIn = 0) and (fIdPipeOut = 0) then
    raise Exception.Create('Pipe IDs are wrong.');

//  fUsbHandle := fUsbDevice.UsbHandle;
  Result := fUsbDevice.Handle;
  ApplySettings;
end;

procedure TnrUSBPipePair.RequestDeviceHandleClose(aHandle: THandle);
begin
  // do nothing ...
end;

procedure TnrUSBPipePair.Abort;
begin
  if IsHandleValid then begin
    if fIdPipeOut <> 0  then fUsbDevice.Api.AbortPipe(fIdPipeOut); //WinUsb_AbortPipe(fUsbHandle, fIdPipeOut);
    if fIdPipeIn <> 0 then fUsbDevice.Api.AbortPipe(fIdPipeIn); //WinUsb_AbortPipe(fUsbHandle, fIdPipeIn);
  end;
end;

procedure TnrUSBPipePair.Reset;
begin
  if IsHandleValid then begin
    if fIdPipeOut <> 0  then fUsbDevice.Api.ResetPipe(fIdPipeOut);
    if fIdPipeIn <> 0 then fUsbDevice.Api.ResetPipe(fIdPipeIn);
  end;
end;

procedure TnrUSBPipePair.Flush;
begin
  if IsHandleValid then begin
    if fIdPipeOut <> 0  then fUsbDevice.Api.FlushPipe(fIdPipeOut);
    if fIdPipeIn <> 0 then fUsbDevice.Api.FlushPipe(fIdPipeIn);
  end;
end;

procedure TnrUSBPipePair.SendChar(const Ch: Char);
begin
  if Active and (fIdPipeOut <> 0) then begin
    if fUsbDevice.Api.Write(fIdPipeOut, @Ch, 1, nil) = 0
      then OutputDebugString(PChar('ERROR:' + SysErrorMessage(GetLastError)));
  end;
end;

procedure TnrUSBPipePair.SendString(const S: AnsiString);
begin
  if Active and (fIdPipeOut <> 0)  then begin
    fUsbDevice.Api.Write(fIdPipeOut, PAnsiChar(S), Length(s), nil);
  end;
end;

procedure TnrUSBPipePair.SendData(const Buff: PAnsiChar;
  const N: cardinal);
begin
  if Active and (fIdPipeOut <> 0)  then begin
    fUsbDevice.Api.Write(fIdPipeOut, Buff, N, @fOvlWrite);
  end;
end;

procedure TnrUSBPipePair.ApplySettings;
begin
  if fPipeOut >= 0 then
    fUsbDevice.Api.PreparePipe(fIdPipeOut, TimeoutWrite, fUsbDevice.UsbDevice.Pipes[fPipeOut].TransferType);
  if fPipeIn >= 0 then
    fUsbDevice.Api.PreparePipe(fIdPipeIn, TimeoutRead, fUsbDevice.UsbDevice.Pipes[fPipeIn].TransferType);
end;

function TnrUSBPipePair.GetBufferSizeRead: dword;
begin
  Result := fReadBufferSize;
end;

procedure TnrUSBPipePair.SetReadBufferSize(const Value: dword);
begin
  fReadBufferSize := Value;
end;

end.
