unit WakeDevice;

interface

uses

  // Borland Software Corporation
  Windows, Classes, Registry, SysUtils;

const
//---------------------------------------------------------------------------
// Вид пакета: FEND, ADDR, CMD, 7Fh, <127 bytes of data>, CRC
//---------------------------------------------------------------------------
  MAX_DATA_SIZE   = 127;               // Макс. размер передаваемых данных в одном пакете
  MAX_PACKET_SIZE = MAX_DATA_SIZE + 4; // Макс. размер пакета данных

//---------------------------------------------------------------------------
//  Стандартные коды команд протокола WAKE
//---------------------------------------------------------------------------
  CMD_NOP   = $00;                     // Нет операции
  CMD_ERROR = $01;                     // Передача кода ошибки
  CMD_ECHO  = $02;                     // Запрос возврата переданного пакета
  CMD_INFO  = $03;                     // Запрос информации об устройстве

type

//  PWakeData = ^TWakeData;
  TWakeData = array [0..MAX_PACKET_SIZE - 1] of byte;

//---------------------------------------------------------------------------
//  TWakeDevice = class(TObject)
//---------------------------------------------------------------------------

  TWakeDevice = class(TObject)
  private
    FCriticalSection : TRTLCriticalSection; // Секция для безопасного выполнения команд

  protected
    FBaudRateCOM : integer;               // Скорость двоичной передачи COM
    FBaudRateUSB : integer;               // Скорость двоичной передачи USB
    FTimeOut     : integer;               // RX Таймаут, мсек

    FDeviceName         : string;      // Имя устройства
    FDeviceVersion      : string;
    FDeviceSerialNumber : integer;     // Серийный номер устройства (0 - любое устройство)

    FtxData : TWakeData;               // Буфер передачи
    FrxData : TWakeData;               // Буфер приема

    FOpened      : boolean;               // Признак открытого порта
    FPort        : string;                // Текущий COM-порт

    // Проверка ответа устройства
//    function CheckDevice(): boolean;

    // Открывает порт
    function OpenPort(APort: string): boolean;

    // закрыть порт
    function ClosePort(): boolean;

    // Получить список доступных портов
    procedure GetListPorts(var APortBox : TStringList);

    // заблокировать секцию
    procedure Lock;

    // разблокировать секцию
    procedure UnLock;

    // Выполнение команды; См. const CMD_XXX;
    procedure ExeCmd(AtxCmd: byte; AtxCount: byte); overload;
    procedure ExeCmd(AtxCmd: byte; AtxCount: byte;const AtxData: TWakeData;var ArxData: TWakeData); overload;
    procedure ExeCmd(ATimeOut:integer; AtxCmd: byte; AtxCount: byte;const AtxData: TWakeData;var ArxData: TWakeData); overload;

    // Отправляет устройству FtxData, возвращает в FrxData эхо-ответ устройства
    function GetEcho(ACount: integer): boolean;{ virtual;}

    // Проверка на наличие ошибки
    procedure CheckErrorCode(ACmd: byte; AErrCode: byte);virtual;

  public
    // ABaudRate - Скорость двоичной передачи; ATimeOut - RX Таймаут, мсек
    constructor Create;{ virtual;}

    destructor Destroy(); override;

    // Возвращает инфо
    function GetInfo(var Inf: string):boolean; overload;

    // Возвращает инфо
    function GetInfo(var ADeviceName : string; var ADeviceVersion : string; var ADeviceSerialNumber: integer): boolean; overload;

    // Поиск устройства
    function DeviceSearch(ADeviceName : string; ADeviceVersion : string; ADeviceSerialNumber: integer): boolean; overload;
    function DeviceSearch(Const AInf : string): boolean; overload;

    // Список подключенных устройств
    procedure DiveceList(AList: TStrings);virtual;

    // Очистка буфера порта
    function PurgePort():boolean;

    function Disconnect:boolean;

    // Текущий порт
    property Port: string read FPort;

    // Скорость двоичной передачи
    property BaudRateCOM: integer read FBaudRateCOM;  // TODO : BaudRate
    property BaudRateUSB: integer read FBaudRateUSB;  // TODO : BaudRate

    // Имя устройства
    property DeviceName: string read FDeviceName;

    // Версия устройства
    property DeviceVersion: string read FDeviceVersion;

    // Серийный номер устройства
    property DeviceSerialNumber: integer read FDeviceSerialNumber;

  end;

//---------------------------------------------------------------------------
//  EWakePortError = class (Exception); Ошибки при работе с портом
//---------------------------------------------------------------------------

  EWakePortError = class (Exception);

//---------------------------------------------------------------------------
//  EWakeDeviceError = class (Exception); Ошибки при работе с устройством
//---------------------------------------------------------------------------

  EWakeDeviceError = class (Exception);

//---------------------------------------------------------------------------
//  Ошибки при работе с портом
//---------------------------------------------------------------------------
resourcestring

  SPortNotOpened      = 'Wake: Порт не открыт.';
  SCantOpenPort       = 'Wake: Невозможно открыть порт.';
//  SCantAccessPort     = 'Wake: Порт недоступен.';
//  SWaitEventError     = 'Wake: Ошибка при ожидании события порта.';
//  SSendDataError      = 'Wake: Ошибка при передаче данных в порт.';
//  SReceiveDataError   = 'Wake: Ошибка при приёме данных из порта.';
  SSendFrameError     = 'Wake: Ошибка при передаче пакета в порт.';
  SReceiveFrameError  = 'Wake: Ошибка при приёме пакета из порта.';
//  SFlushError         = 'Wake: Ошибка порта в вызове Flush().';
  SPurgeError         = 'Wake: Ошибка порта в вызове Purge.';
  SCloseError         = 'Wake: Ошибка при закрытии порта.';
//  SGetModemLinesError = 'Wake: Ошибка порта в вызове GetModLns().';
//  SSetModemLinesError = 'Wake: Ошибка порта в вызове SetModLns().';
//  SGetMaskError       = 'Wake: Ошибка порта в вызове GetMaskCOM().';
//  SSetMaskError       = 'Wake: Ошибка порта в вызове SetMaskCOM().';

  // Ошибки при работе с устройством
  SIOError                  = 'Неправильный пакет.';     // код = $01
  SDeviceBusyError          = 'Устройство занято.';      // код = $02
  SDeviceNotReady           = 'Устройство не готово.';   // код = $03
  SParametersError          = 'Неправильные параметры.'; // код = $04
  SDeviceNotRespondingError = 'Устройство не отвечает.'; // код = $05

implementation

//---------------------------------------------------------------------------
//  Имортировать функции из wsp32.dll
//---------------------------------------------------------------------------
const
  wsp32_dll = 'wsp32.dll';
  // Проверяет доступность порта.
  // В качестве параметра передается имя порта (например, "COM1").
  // Возвращает true в случае доступности порта.
  // bool AccessCOM(char *P);
//  function AccessCOM(P: PChar): BOOL; stdcall; external wsp32_dll;

  // Открыть порт.
  // В качестве параметров передаются имя порта (например, "COM1") и скорость
  // в бодах, которая может принимать одно из стандартных значений (например, 115200).
  // Возвращает true в случае успешного выполнения. Функция устанавливает на линии
  // DTR уровень -12В, а на линии RTS уровень +12В.
  // bool WINAPI OpenCOM(char *P, DWORD baud);
  function OpenCOM(P: PChar; Baud: DWORD): BOOL; stdcall; external wsp32_dll;

  // Закрыть порт.
  // Возвращает true в случае успешного выполнения.
  // bool CloseCOM(void);
  function CloseCOM: BOOL; stdcall; external wsp32_dll;

  // Функция осуществляет управление линиями RTS и DTR.
  // Возвращает true в случае успешного выполнения.
  // Параметр такой же, как у функции API EscapeCommFunction.
  // bool SetModLns(DWORD F);
//  function SetModLns(F: DWORD): BOOL; stdcall; external wsp32_dll;

  // Функция считывает линии управления модема CTS и DSR.
  // Возвращает true в случае успешного выполнения.
  // Параметр такой же, как у функции API GetCommModemStatus.
  // bool GetModLns(LPDWORD lpD);
//  function GetModLns(var lpD: DWORD): BOOL; stdcall; external wsp32_dll;

  // Очистить буфер COM-порта и прерывает текущие операции приема/передачи.
  // Возвращает true в случае успешного выполнения.
  // bool PurgeCOM(void);
  function PurgeCOM: BOOL; stdcall; external wsp32_dll;

  // Очистить буфер COM-порта, дождавшись завершения передачи.
  // Возвращает true в случае успешного выполнения.
  // bool FlushCOM(void);
//  function FlushCOM: BOOL; stdcall; external wsp32_dll;

  // функция считывает маску событий COM-порта.
  // Возвращает true в случае успешного выполнения.
  // Параметр такой же, как у функции API GetCommMask.
  // bool GetMaskCOM(LPDWORD lpEvtMask)
//  function GetMaskCOM(var lpEvtMask: DWORD): BOOL; stdcall; external wsp32_dll;

  // Функция устанавливает маску Возвращает true в случае успешного выполнения.
  // Параметр такой же, как у функции API SetCommMask.
  // bool SetMaskCOM(DWORD EvtMask)
//  function SetMaskCOM(EvtMask: DWORD): BOOL; stdcall; external wsp32_dll;

  // функция служит для ожидания события COM-порта.
  // Возвращает true в случае успешного выполнения.
  // bool WaitEventCOM(LPDWORD lpEvtMask)
//  function WaitEventCOM(var lpEvtMask: DWORD): BOOL; stdcall; external wsp32_dll;

  // осуществляет прием WAKE-пакета.
  // Возвращает true в случае успешного выполнения
  // bool RxFrame(DWORD To, unsigned char &ADD,
  //   unsigned char &CMD, unsigned char &N, unsigned char *Data);
  function RxFrameCOM(TimeOut: DWORD; var Addr: UCHAR; var Cmd: UCHAR; var Count: UCHAR;
       var Data): BOOL;  stdcall; external wsp32_dll name 'RxFrame';

  // существляет передачу WAKE-пакета.
  // Возвращает true в случае успешного выполнения.
  // bool TxFrame(unsigned char ADDR, unsigned char CMD,
  //   unsigned char N, unsigned char *Data);
  function TxFrameCOM(Addr: UCHAR; Cmd: UCHAR; Count: UCHAR;
       const Data): BOOL; stdcall; external wsp32_dll name 'TxFrame';


//---------------------------------------------------------------------------
//  Имортировать функции из wusb32.dll
//---------------------------------------------------------------------------
const
  wusb32_dll = 'wusb32.dll';

  function AccessUSB(devID: integer): BOOL; stdcall; external wusb32_dll;
  function OpenUSB(devID: integer; Baud: DWORD): BOOL; stdcall; external wusb32_dll;
  function CloseUSB: BOOL; stdcall; external wusb32_dll;
  function PurgeUSB: BOOL; stdcall; external wusb32_dll;
  function RxFrameUSB(Timeout: DWORD; var Addr: UCHAR; var Cmd: UCHAR; var Count: UCHAR;
           var Data): BOOL;  stdcall; external wusb32_dll;
  function TxFrameUSB(Addr: UCHAR; Cmd: UCHAR; Count: UCHAR;
           const Data): BOOL; stdcall; external wusb32_dll;
  function NumUSB(var numDevs: DWORD): BOOL; stdcall; external wusb32_dll;

//---------------------------------------------------------------------------
//  TWakeDevice = class(TObject)
//---------------------------------------------------------------------------

constructor TWakeDevice.Create;
begin
  InitializeCriticalSection(FCriticalSection);

  FPort               := '';
  FDeviceName         := '';
  FDeviceVersion      := '';
  FDeviceSerialNumber := 0;
  FBaudRateCOM        := 115200;
  FBaudRateUSB        := 500000;
  FTimeOut            := 200;
  FOpened             := false;

end;

destructor TWakeDevice.Destroy();
begin
  if FOpened then
      ClosePort;
  DeleteCriticalSection(FCriticalSection);
end;

procedure TWakeDevice.Lock;
begin
  EnterCriticalSection(FCriticalSection);
end;

procedure TWakeDevice.Unlock;
begin
  LeaveCriticalSection(FCriticalSection);
end;

procedure TWakeDevice.GetListPorts(var APortBox : TStringList);
var
  i : integer;
  USBCount : Longword;
begin
  with TRegistry.Create() do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    if OpenKey('\HARDWARE\DEVICEMAP\SERIALCOMM', false) then
    begin
      GetValueNames(APortBox);
      for i := 0 to APortBox.Count - 1 do
          APortBox.Strings[i] := ReadString(APortBox.Strings[i]);

      CloseKey;
    end
    else
    begin
      APortBox.Add('COM1');
      APortBox.Add('COM2');
    end;

    if NumUSB(USBCount) then
        for i := 0 to USBCount - 1 do
            APortBox.Add({'USB' + }IntToStr(i));

  finally
    Free;
  end;

end;

// Поиск устройства
function TWakeDevice.DeviceSearch(const AInf : string): boolean;
var
  PortBox : TStringList;
  i : integer;

  s         : string;
begin
  Result := false;

  if FOpened then
      ClosePort;

  PortBox := TStringList.Create;
  try
    GetListPorts(PortBox);

    for i := 0 to PortBox.Count - 1 do
    begin
      try
        if OpenPort(PChar(PortBox.Strings[i])) then
        begin
          Sleep(1);
          if GetInfo(s) then
          begin
            if AnsiSameText(s, AInf) then
            begin
              Result := true;
//              FDeviceName         := DeviceName;
//              FDeviceVersion      := DeviceVersion;
//              FDeviceSerialNumber := DeviceSerialNumber;
              Exit;
            end;
          end

        end;
      except on EWakePortError do
      end;
      if FOpened then
          ClosePort;
    end;

  finally
    PortBox.free;
  end;

end;

function TWakeDevice.DeviceSearch(ADeviceName : string; ADeviceVersion : string; ADeviceSerialNumber : integer): boolean; 
var
  PortBox : TStringList;
  i : integer;

  DeviceName         : string;
  DeviceSerialNumber : integer;
  DeviceVersion      : string;
begin
  Result := false;

  if FOpened then
      ClosePort;

  PortBox := TStringList.Create;
  try
    GetListPorts(PortBox);

    for i := 0 to PortBox.Count - 1 do
    begin
      try
        if OpenPort(PChar(PortBox.Strings[i])) then
        begin
          Sleep(1);
          if GetInfo(DeviceName, DeviceVersion, DeviceSerialNumber) then
          begin
            if ((AnsiCompareText(ADeviceName, DeviceName) = 0 ) or (ADeviceName = '')) and
               ((AnsiCompareText(ADeviceVersion, DeviceVersion) = 0  ) or (ADeviceVersion = '')) and
               ((ADeviceSerialNumber = DeviceSerialNumber ) or (ADeviceSerialNumber = 0))
               then
            begin
              Result := true;
              FDeviceName         := DeviceName;
              FDeviceVersion      := DeviceVersion;
              FDeviceSerialNumber := DeviceSerialNumber;
              Exit;
            end;
          end

        end;
      except on EWakePortError do
      end;
      if FOpened then
          ClosePort;
    end;

  finally
    PortBox.free;
  end;

end;

// Список подключенных устройств
procedure TWakeDevice.DiveceList(AList: TStrings);
var
  PortBox : TStringList;
  i : integer;
  Inf         : string;
begin
  AList.Clear;

  if FOpened then
      ClosePort;

  PortBox := TStringList.Create;
  try
    GetListPorts(PortBox);

    for i := 0 to PortBox.Count - 1 do
    begin
      try
        if OpenPort(PChar(PortBox.Strings[i])) then
        begin
          Sleep(1);
          if GetInfo(Inf) then
             AList.Add(Inf);

        end;
      except on EWakePortError do
      end;
      if FOpened then
          ClosePort;
    end;

  finally
    PortBox.free;
  end;

end;

// Открывает порт
function TWakeDevice.OpenPort(APort: string): boolean;
begin
  Lock;
  try
    FOpened :=  false;
    FPort := '';
    if Pos('COM',APort) > 0 then
    begin
      FOpened := OpenCOM(PChar(APort), FBaudRateCOM);
      FPort := APort;
    end
    else
    begin
      FOpened := OpenUSB(StrToInt(APort), FBaudRateUSB);
      FPort := 'USB'{ + APort};
    end;

//    if not FOpened then
//       ClosePort;

  finally
    UnLock;
  end;
  result := FOpened;
end;

// закрыть порт
function TWakeDevice.ClosePort(): boolean;
begin
  Lock;
  try
    FDeviceName         := '';
    FDeviceVersion      := '';
    FDeviceSerialNumber := 0;

    FOpened := false;
    if FPort = '' then
        raise EWakePortError.Create(SCloseError);

    if Pos('COM',FPort) > 0 then
    begin
      if not CloseCOM then
          raise EWakePortError.Create(SCloseError);
    end
    else
    begin
      if not CloseUSB then
          raise EWakePortError.Create(SCloseError);
    end;
  finally
    FPort := '';
    UnLock;
  end;
  result := true;
end;

// Очистка буфера порта
function TWakeDevice.PurgePort(): boolean;
begin
  Lock;
  try
    if not FOpened then
        raise EWakePortError.Create(SPortNotOpened);

    if Pos('COM',FPort) > 0 then
    begin
    if not PurgeCOM() then
        raise EWakePortError.Create(SPurgeError);
    end
    else
    if not PurgeUSB() then
        raise EWakePortError.Create(SPurgeError);

  finally
    UnLock;
  end;
  result := true;
end;

// Выполнение команды
procedure TWakeDevice.ExeCmd(AtxCmd: byte; AtxCount: byte);
begin
  ExeCmd(AtxCmd, AtxCount, FtxData, FrxData);
end;

procedure TWakeDevice.ExeCmd(AtxCmd: byte; AtxCount: byte;const AtxData: TWakeData;var ArxData: TWakeData);
begin
  ExeCmd(FTimeOut, AtxCmd, AtxCount, AtxData, ArxData);
end;

procedure TWakeDevice.ExeCmd(ATimeOut:integer; AtxCmd: byte; AtxCount: byte;const AtxData: TWakeData;var ArxData: TWakeData);
var
  rxAddr,
  rxCmd,
  rxCount : byte;

begin
  Lock;
  try
    if not FOpened then
        raise EWakePortError.Create(SPortNotOpened);

    FillChar(FrxData, SizeOf(FrxData), 0); // очищаем буфер приема

    if Pos('COM',FPort) > 0 then
    begin
      if not TxFrameCOM({Addr} 0, AtxCmd, AtxCount, AtxData) then
          raise EWakePortError.Create(SSendFrameError);

      if not RxFrameCOM(ATimeOut, rxAddr, rxCmd, rxCount, ArxData) then
          raise EWakePortError.Create(SReceiveFrameError);

    end
    else
    begin
      if not TxFrameUSB({Addr} 0, AtxCmd, AtxCount, AtxData) then
          raise EWakePortError.Create(SSendFrameError);

      if not RxFrameUSB(ATimeOut, rxAddr, rxCmd, rxCount, ArxData) then
          raise EWakePortError.Create(SReceiveFrameError);

    end;


    CheckErrorCode(rxCmd, ArxData[0]);
  finally
    UnLock;
  end;

end;
(*
void __fastcall TEquip::ExeCmd(bool chkcon, DWORD tmslp, int txCmd)
{
  unsigned char rxAdd, rxCmd, rxN;
  bool rx;

   int err;
  if(chkcon && !Connected) return;

  TxFrame(0, txCmd, CmdLength[txCmd], TxData);    //передаем пакет
  if(tmslp) Sleep(tmslp);                         //если просили, ждем
  rxCmd = 0; memset(RxData, 0, sizeof(RxData));   //очищаем буфер приема

  rx = RxFrame(FRxTo, rxAdd, rxCmd, rxN, RxData); //принимаем пакет

  switch (rxCmd) {
   case C_Info: err = Err_No; break;
// case C_GetR: err = (rxData[0]==Err_Re)? Err_No : rxData[0]; break;
   default: err = RxData[0]; break;
  }

  if(txCmd > C_Max - 1) txCmd = C_Err;
  if(rxCmd > C_Max - 1) rxCmd = C_Err;
  if(err > Err_Max - 1) err = Err_Tx;
  if (!rx && FUsedCOM) {
    Connected = false;
    ClearCOM();
  throw EHardwareException("Ошибка команды "+Commands[txCmd]+
    ":\rНет ответа на команду.", 0);
  }
  else if (txCmd != rxCmd && FUsedCOM)
  throw EHardwareException("Ошибка команды "+Commands[txCmd]+
    ":\rНеверный ответ на команду.", 0);
  else if (err && FUsedCOM)
    throw EHardwareException("Ошибка команды "+Commands[txCmd]+
    ":\r"+Errors[err], 0);
}
*)

// Возвращает эхо
function TWakeDevice.GetEcho(ACount: integer): boolean;
begin
  Lock;
  try
    ExeCmd(CMD_ECHO, ACount);
  finally
    UnLock;
  end;
  result := true;
end;

// Возвращает инфо
function TWakeDevice.GetInfo(var Inf: string): boolean;
begin
  Lock;
  try
    ExeCmd(CMD_INFO, 0);
    Inf := StrPas(@FrxData);
  finally
    Unlock;
  end;
  result := true;
end;

// Возвращает инфо
function TWakeDevice.GetInfo(var ADeviceName : string; var ADeviceVersion : string; var ADeviceSerialNumber: integer): boolean;
var
  i,j : integer;
  Inf, Tmp : string;
begin
  if GetInfo(Inf) then
      Inf := Inf + ' ';
  Tmp                 := '';
  ADeviceName         := '';
  ADeviceVersion      := '';
  ADeviceSerialNumber := 0;
  j := 0;
  for i := 1 to Length(Inf) do
  begin
    if (Inf[i] = ' ')then
    begin
      case j of
        0 : ADeviceName := Tmp;
        1 : ADeviceVersion := Tmp;
        2 : ADeviceSerialNumber := StrToInt(Tmp);
      end;
      Tmp := '';
      inc(j);
    end
    else
        Tmp := Tmp + Inf[i];

  end;
  result := true;

end;

// Проверка на наличие ошибки
procedure TWakeDevice.CheckErrorCode(ACmd: byte; AErrCode: byte);
var
  ErrStr: string;
begin
  if (not (ACmd in [CMD_INFO, CMD_ECHO])) and
     (AErrCode <> 0) then
  begin
    case AErrCode of
      $01 : ErrStr := SIOError;
      $02 : ErrStr := SDeviceBusyError;
      $03 : ErrStr := SDeviceNotReady;
      $04 : ErrStr := SParametersError;
      $05 : ErrStr := SDeviceNotRespondingError;
      else
          ErrStr := Format('Неизвестная ошибка.'#13'Код: %d'#13'Class: %s', [AErrCode, Self.ClassName]);
    end;

//    if assigned(FOnGetErrString) then
//        FOnGetErrString(Cmd, ErrCode, ErrStr);
    raise EWakeDeviceError.Create(ErrStr);
  end;
end;

function TWakeDevice.Disconnect:boolean;
begin
  result := ClosePort;
end;

initialization


finalization


end.
