期货量化交易客户端开源教学第七节——键盘串口线程

筱璦
已于 2024-07-10 18:03:41 修改
阅读量206
点赞数 1
文章标签：开源
于 2024-07-10 17:31:13 首次发布
本文链接：https://blog.csdn.net/qq_35600909/article/details/140329758
版权
unit CControl_Communication;

interface

uses
  System.Classes, Winapi.MMSystem ,Winapi.Windows, System.SysUtils, System.StrUtils,
  FMX.Dialogs, Winapi.Messages, FMX.Platform.Win, ShellAPI, System.UITypes, System.DateUtils;

{$I Define.inc}

const
  ComMax=20;
  WM_MyMsg=WM_USER+100;
  CellTitle:array [0..8] of string=('静态权益','动态权益','手续费','平仓盈亏',
                                    '实际盈亏','持仓盈亏','合约','手数','风险度');


  FrontC =$00FFFF;{前景色}
  BackC  =$000000;{背景色}

type
  TBuySellEvent = procedure (cmd: Byte) of object;
  TCmdRrecord=record
    {以下五个属性只有在向屏幕发送字幕时会使用到}
    CmdFontTy:Integer;{	字体类型 01  大字体（32*32）无背景色 有前景色   不要轻易使用，会出现字体重叠
                                 03 大字体（32*32）有背景色 有前景色
                                 00 小字体（24*24）无背景色 有前景色
                                 02 小字体（24*24）有背景色 有前景色
                                 建议 用02或者03 这样 只会切换字体大小}
    CmdFrontColor:Integer;{前景色}
    CmdBackColor:Integer;	{背景色}
    CmdX:Integer ;{位置X坐标}
    CmdY:Integer ;{位置Y坐标}

    CmdType:Integer;{帧类型}
    CmdNote:string;{帧内容}
    CellRow:Integer;{单元格的第几行，一个单元格有两行，第一行显示标题，第二行显示内容}
    CellNo:Integer;{第几个单元格  共有9个单元格，一行3格，共3行}
  end;

  TMutiCmdRecord=record
    {以下五个属性只有在向屏幕发送字幕时会使用到}
    CmdFontTy:Integer;{	字体类型 01  大字体（32*32）无背景色 有前景色   不要轻易使用，会出现字体重叠
                                 03 大字体（32*32）有背景色 有前景色
                                 00 小字体（24*24）无背景色 有前景色
                                 02 小字体（24*24）有背景色 有前景色
                                 建议 用02或者03 这样 只会切换字体大小}
    CmdFrontColor:Integer;{前景色}
    CmdBackColor:Integer;	{背景色}
    CmdX:array [0..3] of Integer ;{位置X坐标}
    CmdY:array [0..3] of Integer ;{位置Y坐标}

    CmdType:Integer;{帧类型}
    CmdNote:array [0..3] of string;{帧内容}
    CellRow:Integer;{单元格的第几行，一个单元格有两行，第一行显示标题，第二行显示内容}
    CellNo:Integer;{第几个单元格  共有9个单元格，一行3格，共3行}
    RowCount:Integer;{本次显示多少行，最多不超过4行}
  end;

  TThread_OrderConfirm = class(TThread)
  private
    procedure runBuySellEvent;
  protected
    procedure Execute;override;
  public
    FCmd: Byte;
    FBuySellEvent: TBuySellEvent;
    constructor Create(CreateSuspended: Boolean);
  end;

  TThread_Communicate= class(TThread)
  const
    CmdStart='BB';
    CmdEnd='AA';
  private
    HComm, Post_Event:THandle;
    cmdCount:Integer;
    CommSrl:Integer;{端口序号1-20}
    ISInit:Boolean;

    RecvInit:Integer;
    StrRcvCmd:string;

    LpolW,LpolR:Poverlapped;
    FCmdStr:string;{上次发送的命令}
    FErrorCount:integer;{命令出错或者未接到下位机回复的次数，超过9次试为通讯异常}
    SendDateTime,ReadDateTime: TDateTime;
    procedure CtrTable;{在键盘屏幕上抽做表格}
    function  DealStr(Str:string;Len:Integer):string;{处理字符串}  
    function  OpenComm:Boolean;{打开串口}
    procedure ReadData();
    procedure AddMutiRowDataToTable(NoteType: Integer);
    function CrtMutiCmd(cmdRec: TMutiCmdRecord): string;{接收键盘发送的命令}
  public
    lstCmd:TStrings;{待发命令列表}
    CellNote:array [0..8] of string;
    procedure CloseComm;{关闭串口}
    procedure AddToTable(NoteType:integer);{添加信息到屏幕表格整行添加}
    procedure AddToTableCell(cmdRec:TCmdRrecord);{添加信息到单元格}
    procedure AddTitleToScreen();{添加标题到屏目下方}
    procedure SendData; {向键盘发送命令}
    procedure SendData1(cmd:string); {向键盘发送命令}
    function  CrtCmd(cmdRec:TCmdRrecord):string;{创建下位机命令}
    procedure InitPic;
    constructor Create(CreateSuspend: Boolean;TemSrl:Integer);
    destructor Destroy;override;
  protected
    procedure Execute; override;
  end;

  procedure EnumComPorts(Ports: TStrings);{获取串口列表 2023-04-14 黄}
var
   ValidSrl:integer;{有效的串口序列号}
   CommLst:TStrings;{串口列表}

implementation

uses
  uMain, uGlobalvariable, CControl_GlobalVariable, uLog, uMsgDlg, uOrderConfirm,
  uMain_Mini ;

procedure EnumComPorts(Ports: TStrings);
var
  KeyHandle: HKEY;
  ErrCode, Index: Integer;
  ValueName, Data: string;
  ValueLen, DataLen, ValueType: DWORD;
  TmpPorts: TStringList;
begin
  Ports.Clear;
  try
    ErrCode := RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'HARDWARE\DEVICEMAP\SERIALCOMM', 0,
      KEY_READ, KeyHandle);
    if ErrCode <> ERROR_SUCCESS then
      Exit;
    TmpPorts := TStringList.Create;
    try
      Index := 0;
      repeat
        ValueLen := 256;
        DataLen := 256;
        SetLength(ValueName, ValueLen);
        SetLength(Data, DataLen);
        ErrCode := RegEnumValue(KeyHandle, Index, PChar(ValueName),
          Cardinal(ValueLen), nil, @ValueType, PByte(PChar(Data)), @DataLen);

        if ErrCode = ERROR_SUCCESS then
        begin
          SetLength(Data, DataLen);
          TmpPorts.Add(Data);
          Inc(Index);
        end
        else if ErrCode <> ERROR_NO_MORE_ITEMS then
          Exit;

      until (ErrCode <> ERROR_SUCCESS);

      TmpPorts.Sort;
      Ports.Assign(TmpPorts);
    finally
      RegCloseKey(KeyHandle);
      TmpPorts.Free;
    end;
  except
    on exception do

  end;
end;

{ TThread_Communicate }
{添加信息到屏幕表格}
procedure TThread_Communicate.AddTitleToScreen();
var
  cmdRec: TCmdRrecord;
  compName: string;
begin
  cmdRec.CmdFontTy :=2;  {大字体（24*24）有背景色 有前景色}
  cmdRec.CmdFrontColor :=FrontC;
  cmdRec.CmdBackColor :=BackC;
  cmdRec.CmdType:=3;{帧类型}
  cmdRec.CellNo :=-1;
  cmdRec.CmdX :=0;
  cmdRec.CmdY :=239;
  compName := KeyboardName;
  cmdRec.CmdNote :=FormatDateTime('yyyy-mm-dd HH:nn:ss',Now)+'   ' + compName;
  cmdRec.CmdNote:=DealStr(cmdRec.CmdNote,40);
  cmdRec.CmdNote :=StringReplace(cmdRec.CmdNote,'|','',[rfReplaceAll]);
  CrtCmd(cmdRec);
end;

procedure TThread_Communicate.AddToTable(NoteType:integer);
var
  i,j:Integer;
  Str:string;
  cmdRec:TCmdRrecord;
begin
  cmdRec.CmdFontTy :=2;  {小字体（24*24）有背景色 有前景色}
  cmdRec.CmdFrontColor :=FrontC;
  cmdRec.CmdBackColor :=BackC;
  cmdRec.CmdType:=3;{帧类型}
  cmdRec.CellNo :=-1;
  cmdRec.CmdX :=0;

  for i := 0 to 2 do
  begin
    Str:='|';
    for j := 0 to 2 do
    begin
      if NoteType =1 then
      begin
        Str:=Str+ DealStr(CellTitle[i*3+j],12);
        cmdRec.CmdY :=23+3*i*24;
      end else begin
        Str:=Str+ DealStr(CellNote[i*3+j],12);
        cmdRec.CmdY :=47+3*i*24;
      end;
      cmdRec.CmdNote:=Str;
    end;
    CrtCmd(cmdRec);
  end;
  AddTitleToScreen;
end;

procedure TThread_Communicate.AddToTableCell(cmdRec: TCmdRrecord);
var
  TemRow,TemCol:integer;
  str:string;
begin
  TemRow :=  cmdRec.CellNo div 3;
  TemCol :=  cmdRec.CellNo mod 3;
  cmdRec.CmdX :=TemCol*13*12+15;
  if cmdRec.CellRow =1 then
  begin
    Str:=Str+ DealStr(cmdRec.CmdNote,12);
    cmdRec.CmdY :=23+3*TemRow *24;
  end else begin
    Str:=Str+ DealStr(cmdRec.CmdNote,12);
    cmdRec.CmdY :=47+3*TemRow*24;
  end;
  Str:=StringReplace(str,'|','',[rfReplaceAll]);
  cmdRec.CmdNote:=Str;
  CrtCmd(cmdRec);
end;

procedure TThread_Communicate.CloseComm;
begin
  if HComm>0 then
  begin
    CloseHandle(HComm);
    HComm:=0;
  end;
end;

{创建线程}
constructor TThread_Communicate.Create(CreateSuspend: Boolean;TemSrl:Integer);
begin
  inherited Create(CreateSuspend);
  lstCmd:=TStringList.Create;
  FCmdStr :='';
  FreeOnTerminate :=True;
  HComm:=0;
  ISInit:=true;
  CommSrl:=TemSrl;
  StrRcvCmd:='';
  RecvInit:=0;
  New(LpolW);
  New(LpolR);
  cmdCount :=0;
  FErrorCount :=0;
end;

{释放线程}
destructor TThread_Communicate.Destroy;
begin
  if HComm>0 then
  begin
    CloseComm;
  end;
  lstCmd.Free;
  Dispose(LpolW);
  Dispose(LpolR);
  inherited;
end;

function TThread_Communicate.CrtCmd(cmdRec: TCmdRrecord): string;
var
  CmdStr,SubCmdStr:AnsiString;
  str1:AnsiString;
  p : PAnsiChar;
  TemInt,i:Integer;
begin
  CmdStr :='';
  SubCmdStr:='';
  if cmdCount<$20 then
    cmdCount :=cmdCount +1
  else
    cmdCount :=1;
  case cmdRec.CmdType  of
    02:
    begin
      CmdStr:=CmdStart+'06'+IntToHex(cmdCount,2)+'02'+IntToHex(StrToInt(cmdRec.CmdNote),2)+CmdEnd;
    end;
    03:
    begin
      str1 := AnsiString(cmdRec.CmdNote);
      p := Pointer(str1);
      TemInt:=Length(str1)+16;   {命令长度}
      for i:=0 to length(str1)-1 do
        SubCmdStr:=SubCmdStr+format('%.2x',[Byte(p[i])]);
      CmdStr :=CmdStart+IntToHex(TemInt,2)+IntToHex(cmdCount,2)+'03';

      with cmdRec do
      begin
        cmdStr:=cmdStr+format('%.2x',[CmdFontTy]);
        cmdStr:=cmdStr+format('%.6x',[CmdFrontColor]);
        cmdStr:=cmdStr+format('%.6x',[CmdBackColor]);
        cmdStr:=cmdStr+format('%.4x',[CmdX]);
        cmdStr:=cmdStr+format('%.4x',[CmdY]);
        CmdStr:=CmdStr+SubCmdStr;
      end;
      cmdStr:=cmdStr+CmdEnd;
    end;
  end;
  if CmdStr <>'' then
    lstCmd.Add(CmdStr);
  Result :=CmdStr;
end;

procedure TThread_Communicate.CtrTable;
var
  cmdRec:TCmdRrecord;
  i:Integer;
begin
  cmdRec.CmdFontTy :=2;  {小字体（24*24）有背景色 有前景色}
  cmdRec.CmdFrontColor :=FrontC;
  cmdRec.CmdBackColor :=BackC;
  cmdRec.CmdType :=3;{帧类型}
  cmdRec.CellNo :=-1;
  for i := 0 to 10 do
  begin
    cmdRec.CmdX :=0;
    if i=0 then
      cmdRec.CmdY:=0
    else
      cmdRec.CmdY :=23+(i-1)*24;
    if i mod 3=0 then
    begin
      cmdRec.CmdNote:=' -------------------------------------- ';
    end    else
      cmdRec.CmdNote:='|            |            |            |';
    CrtCmd(cmdRec);
  end;

  cmdRec.CmdY :=240;
  cmdRec.CmdFontTy :=3;  {大字体（32*32）有背景色 有前景色}
  cmdRec.CmdNote:='                                        ';
  CrtCmd(cmdRec);{这一行命令是为了把屏幕的背景色铺满}

  AddTitleToScreen;
  AddToTable(1);
end;

function TThread_Communicate.DealStr(Str: string; Len: Integer): string;
var
  i,TemInt:Integer;
  TemStr:AnsiString;
begin
  if Length(Str)<len then
  begin
    TemStr :=AnsiString(Str);

    TemInt:=Len-Length(TemStr);
    for I := 1 to (TemInt div 2) do
      TemStr :=' '+TemStr+' ';
    for I := 1 to (TemInt Mod 2) do
      TemStr :=TemStr+' ';
  end
  else
    TemStr:=AnsiString(LeftStr(Str,Len));
  TemStr:=TemStr+'|';
  Result :=TemStr;
end;

{添加信息到屏幕表格}
procedure TThread_Communicate.AddMutiRowDataToTable(NoteType:Integer);
var
  i,j:Integer;
  Str:string;
  cmdRec:TMutiCmdRecord;
  compName:string;
begin
  cmdRec.CmdFontTy :=2;  {小字体（24*24）有背景色 有前景色}
  cmdRec.CmdFrontColor :=FrontC;
  cmdRec.CmdBackColor :=BackC;
  cmdRec.CmdType:=4;{帧类型}
  cmdRec.CellNo :=-1;
  cmdRec.RowCount :=4;
  for i := 0 to 2 do
  begin
    Str:='|';
    cmdRec.CmdX[i] :=0;
    if NoteType =1 then
      cmdRec.CmdY[i] :=23+3*i*24
    else
      cmdRec.CmdY[i] :=47+3*i*24;
    for j := 0 to 2 do
    begin
      if NoteType =1 then
        Str:=Str+ DealStr(CellTitle[i*3+j],12)
      else
        Str:=Str+ DealStr(CellNote[i*3+j],12);
    end;
    cmdRec.CmdNote[i]:=Str;
  end;
  cmdRec.CmdX[3] :=0;
  cmdRec.CmdY[3] :=239;
  compName := KeyboardName;
  cmdRec.CmdNote[3] :=FormatDateTime('yyyy-mm-dd HH:nn:ss',Now)+'   ' + compName;
  cmdRec.CmdNote[3]:=DealStr(cmdRec.CmdNote[3],40);
  cmdRec.CmdNote[3] :=StringReplace(cmdRec.CmdNote[3],'|','',[rfReplaceAll]);

  CrtMutiCmd(cmdRec);
//  AddTitleToScreen;
end;

function TThread_Communicate.CrtMutiCmd(cmdRec: TMutiCmdRecord): string;
var
  CmdStr,SubCmdStr:AnsiString;
  str1:AnsiString;
  p : PAnsiChar;
  TemInt,i,j:Integer;
begin
  CmdStr :='';
  SubCmdStr:='';
  TemInt :=0;
  if cmdCount<$20 then
    cmdCount :=cmdCount +1
  else
    cmdCount :=1;
  case cmdRec.CmdType  of
    04:
    begin
      with cmdRec do
      begin
        for I := 0 to RowCount -1  do
        begin
          SubCmdStr:=SubCmdStr+format('%.4x',[CmdX[i]]);
          SubCmdStr:=SubCmdStr+format('%.4x',[CmdY[i]]);
          str1 := AnsiString(cmdRec.CmdNote[i]);
          p := Pointer(str1);
          TemInt:=TemInt+Length(str1)+4;   {命令长度}
          for j:=0 to length(str1)-1 do
            SubCmdStr:=SubCmdStr+format('%.2x',[Byte(p[j])]);

        end;
      end;
      TemInt :=TemInt+13;

      CmdStr :=CmdStart+IntToHex(TemInt,2)+IntToHex(cmdCount,2)+'04';
      with cmdRec do
      begin
        cmdStr:=cmdStr+format('%.2x',[CmdFontTy]);
        cmdStr:=cmdStr+format('%.6x',[CmdFrontColor]);
        cmdStr:=cmdStr+format('%.6x',[CmdBackColor]);
        cmdStr:=cmdStr+format('%.2x',[RowCount]);
        CmdStr:=CmdStr+SubCmdStr;
      end;
      cmdStr:=cmdStr+CmdEnd;
    end
    else
    begin
      ShowMessage('命令类型错误，不能处理');
      Exit;
    end;

  end;
  if CmdStr <>'' then
    lstCmd.Add(CmdStr);
  Result :=CmdStr;
end;

procedure TThread_Communicate.Execute;
var
  cmdRec:TCmdRrecord;
  I:Integer;
  coin_id:string;
begin
  inherited;
  if OpenComm then
  begin
    while HComm>0 do
    begin
      if ISInit and (RecvInit=0) then
      begin
        cmdRec.CmdType:=2;{帧类型}
        cmdRec.CmdNote :='00';
        CrtCmd(cmdRec);
      end;

      if lstCmd.Count =0 then
      begin
        if Length(VGUserFunds) > 0 then
        begin
          {根据下单界面的合约币种类型发送相关资金信息}
          if Assigned(SimpleOrder) then
          begin
            if SimpleOrder.lblID.Text <> '' then
            begin
              for I := 0 to Length(VGStocks) - 1 do
              begin
                if VGStocks[I].id = SimpleOrder.lblID.Text then
                begin
                  coin_id := VGStocks[I].coin_id;
                  Break;
                end;
              end;
              for I := 0 to Length(VGUserFunds) - 1 do
              begin
                if VGUserFunds[I].coin_id = StrToInt(coin_id) then
                begin
                  CellNote[0] := VGUserFunds[I].static_rights;
                  CellNote[1] := VGUserFunds[I].dynamic_equity;
                  CellNote[2] := VGUserFunds[I].sx_fee;
                  CellNote[3] := VGUserFunds[I].ping_yk;
                  CellNote[4] := VGUserFunds[I].actual_yk;
                  CellNote[5] := VGUserFunds[I].float_yk;
                  CellNote[6] := SimpleOrder.edtHyName.Text;
                  CellNote[7] := SimpleOrder.edtHand.Text;
                  CellNote[8] := VGUserFunds[I].risk_degree;
                  Break;
                end;
              end;
            end;
          end;
          AddMutiRowDataToTable(2);
        end;
      end;
      Synchronize(SendData);
      Sleep(10);
      Synchronize(ReadData);
      if RecvInit > 3 then
      begin
        CloseComm;
      end;
    end;
  end;
end;

procedure TThread_Communicate.InitPic;
begin
  SendData1('BB06010200AA');
end;

function TThread_Communicate.OpenComm:Boolean;
var
  TemStr:string;
  ComC:TCommConfig;
  CommTM:COMMTIMEOUTS;
begin
  TemStr := 'Com'+intToStr(CommSrl);

  HComm :=CreateFile(PChar('\\.\'+TemStr),Generic_read or Generic_write,0,nil,OPEN_EXISTING,
          File_Flag_Overlapped,0);
  if HComm = INVALID_HANDLE_VALUE then
  begin
    Result :=false;
    exit;
  end;
  SetupComm(HComm,4096,4096);
  PurgeComm(HComm,PURGE_TXCLEAR or PURGE_RXCLEAR);
  CommTM.ReadIntervalTimeout := 50 ;
  CommTM.ReadTotalTimeoutMultiplier := 50 ;
  CommTM.ReadTotalTimeoutConstant := 500 ;
  CommTM.WriteTotalTimeoutMultiplier := 50 ;
  CommTM.WriteTotalTimeoutConstant := 500 ;
  SetCommTimeouts(HComm, CommTM ) ;
  ComC.dcb.DCBlength :=SizeOf(TDCB);
  GetCommState(HComm,ComC.dcb);
  ComC.dcb.BaudRate := 57600;
  ComC.dcb.ByteSize := 8;
  ComC.dcb.StopBits :=0;
  ComC.dcb.Parity := 0;

  if not setCommstate(HComm,ComC.dcb) then
  begin
    CloseComm;
    Result :=false;
    Exit;
  end;

  try
    LpolW^.Internal:=0;
    LpolW^.InternalHigh:=0;
    LpolW^.Offset:=0;
    LpolW^.OffsetHigh:=0;
    LpolW^.hEvent:=Createevent(nil,true,False,nil);
    Lpolr^.Internal:=0;
    Lpolr^.InternalHigh:=0;
    Lpolr^.Offset:=0;
    Lpolr^.OffsetHigh:=0;
    Lpolr^.hEvent:=Createevent(nil,true,False,nil);
    PurgeComm(HComm,Purge_TxAbort or Purge_RxAbort or Purge_Txclear or Purge_Rxclear);
    Post_Event:=Createevent(nil,true,true,nil);
    Result :=true;
  finally

  end;
end;

procedure TThread_Communicate.ReadData;
var
  InBuff:array[0..20000] of Byte;
  nBytesRead,Dwerror:LongWord;
  cs:TCOMSTAT;
  ReadLen:DWORD;
  I:integer;

  ReadBytedata:array of Byte;
  tem:String;
  TemLen:integer;
  cmdLen:DWORD;
  ISAnalysis:Boolean;
  Thread_OrderConfirm: TThread_OrderConfirm;
begin
  try
    if (HComm=0) then exit;
    ClearCommError(HComm,dwError,@CS);

    if (MilliSecondsBetween(ReadDateTime,Now)>50) then
    begin
      FErrorCount := FErrorCount+1;
      if FErrorCount > 9 then
      begin
        FrmMain.machine_stat.Fill.Color := DISCONCOLOR;
        CloseComm;
        if ValidSrl=CommSrl then
          ValidSrl := -1;

      end;
      ReadDateTime:=now;
    end;
    if cs.cbInQue=0 then
    begin

      exit;
    end
    else begin
      FErrorCount:=0;
    end;
    ReadFile(HComm,inBuff,cs.cbInQue,nBYtesRead,LpolR);
    if cs.cbInQue>sizeof(inbuff) then
    begin
      PurgeComm(HComm,PuRGE_RXCLEAR);
      exit;
    end;
    ReadLen := cs.cbInQue;
    cs.cbInQue := 0;
    TemLen := Length(StrRcvCmd) div 2;
    SetLength(ReadByteData,ReadLen+TemLen);
    if TemLen>0 then
    begin
      for i:=0 to TemLen-1 do
        ReadByteData[i]:=StrToInt('$'+Copy(StrRcvCmd,i*2+1,2));
    end;
    Tem:='';
    for i:=0 to ReadLen-1 do
    begin
      ReadBytedata[i+TemLen]:=inbuff[i];
      Tem:=Tem+InttoHex(inbuff[i],2)+' ';
    end;
    ReadLen:=ReadLen+TemLen;

    {解析}
    ISAnalysis:=True;
    while ISAnalysis do
    begin
      case ReadBytedata[0] of
        $23:
        begin
          FrmMain.machine_stat.Fill.Color:= CONCOLOR;        //绿色颜色
          cmdLen :=2;
          if ReadLen <cmdLen then
          begin
            ISAnalysis :=false;
            StrRcvCmd:='';
            for i:=Low(ReadByteData) to High(ReadByteData) do
              StrRcvCmd:=StrRcvCmd+IntToHex(ReadByteData[i],2);
          end
          else begin
            case ReadByteData[1] of
              {0..9 的数字键}
              $51: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_NUMPAD0,0);
              $4D: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_NUMPAD1,0);
              $4E: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_NUMPAD2,0);
              $4F: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_NUMPAD3,0);
              $46: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_NUMPAD4,0);
              $45: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_NUMPAD5,0);
              $44: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_NUMPAD6,0);
              $41: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_NUMPAD7,0);
              $42: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_NUMPAD8,0);
              $43: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_NUMPAD9,0);

              $47: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_BACK,0);  {退格键}
              $48: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_DIVIDE,0);
              $49: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_MULTIPLY,0);
              $4A: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_SUBTRACT,0);
              $4B: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_ADD,0);
              $4C:
              begin
                {需要优先处理下单确认界面，否则两个窗体同时存在时程序会假死}
                if Assigned(FrmOrderConfirm) then
                begin
                  PostMessage(WindowHandleToPlatform(FrmOrderConfirm.Handle).Wnd,wm_KeyDown,VK_RETURN,0);
                  Exit;
                end;
                if Assigned(FrmMsgDlg) then
                  PostMessage(WindowHandleToPlatform(FrmMsgDlg.Handle).Wnd,wm_KeyDown,VK_RETURN,0) {回车键}
              end;
              $50: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_DECIMAL,0);

              $52,$57,$58: {平，买，卖}
              begin
                if not Assigned(FrmOrderConfirm) then
                begin
                  Thread_OrderConfirm := TThread_OrderConfirm.Create(True);
                  Thread_OrderConfirm.FCmd := ReadBytedata[1];
                  Thread_OrderConfirm.Start;
                end;
              end;

              $61: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_UP,0);{↑}
              $62: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_RIGHT,0);{→}
              $63: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_Down,0);{↓}
              $64: PostMessage(WindowHandleToPlatform(FrmMain.Handle).Wnd,wm_KeyDown,VK_LEFT,0);{←}
              {左上角8个按键}
              $59: FrmMain.mniAllEntrustClick(FrmMain.mniAllEntrust);
              $5A: FrmMain.mniTransRecClick(FrmMain.mniTransRec);
              $5B: FrmMain.mniClosePosClick(FrmMain.mniClosePos);
              $5C:
              begin
                FrmMain.mniFollowOrdClick(FrmMain.mniFollowOrd);
                FrmMain.mniFollowRankClick(FrmMain.mniFollowRank);
              end;
              $5F:
              begin
                for I := 0 to FrmMain.MenuMarket.ItemsCount - 1 do
                begin
                  if FrmMain.MenuMarket.Items[I].Text = '自选合约' then
                  begin
                    FrmMain.MenuMarket.Items[I].OnClick(FrmMain.MenuMarket.Items[I]);
                  end;
                end;
              end;
              $60:
              begin
                FrmMain.mniSimpleOrderClick(FrmMain.mniSimpleOrder);
                SimpleOrder.edtHand.SetFocus;
              end;
              $5E:
              begin
                if Assigned(AllEntrust) then
                  AllEntrust.btnAll.OnClick(AllEntrust);
              end;
              $5D:
              begin
                if Assigned(Holdings) then
                  Holdings.btnFlatAll.OnClick(Holdings);
              end;
              {上部4个按键}
              $53: FrmMain.MenuItem2.OnClick(FrmMain);
              $54: FrmMain.MenuItem11.OnClick(FrmMain);
              $55: ShellExecute(WindowHandleToPlatform(FrmMain.Handle).Wnd, 'open', 'Calc.EXE', nil, nil, 3);
              $56: FrmMain.MenuItem17.OnClick(FrmMain);
            end;

            ISAnalysis :=true;
            StrRcvCmd:='';
            for i:=cmdLen to ReadLen-1 do
              StrRcvCmd:=StrRcvCmd+IntToHex(ReadByteData[i],2);
          end;
        end;

        $DD:
        begin
          FrmMain.machine_stat.Fill.Color:= CONCOLOR;        //绿色颜色
          cmdLen := 5;
          if ReadLen<CmdLen then
          begin
            ISAnalysis :=false;
            StrRcvCmd:='';
            for i:=Low(ReadByteData) to High(ReadByteData) do
              StrRcvCmd:=StrRcvCmd+IntToHex(ReadByteData[i],2);
          end
          else begin
            if lstCmd.Count >0 then
            begin
              if (ReadBytedata[2]=StrToInt('$'+Copy(lstCmd.Strings[0],5,2 ))) then
              begin
                lstCmd.Delete(0);
              end;
            end;

            if ISInit  then
            begin
              ValidSrl :=CommSrl;
              ISInit :=False;
              CtrTable;
            end;
            ISAnalysis :=true;
            StrRcvCmd:='';
            if ReadBytedata[4]<>$CC then
            begin
              for I := 2 to  ReadLen-1  do
                StrRcvCmd:=StrRcvCmd+IntToHex(ReadByteData[i],2);
            end
            else
            begin
              for I := cmdLen to ReadLen-1  do
                StrRcvCmd:=StrRcvCmd+IntToHex(ReadByteData[i],2);
            end;
          end;
        end
        else begin
          StrRcvCmd:='';
          TemLen :=-1;
          for i:=Low(ReadByteData)+1 to High(ReadByteData) do
          begin
            if (ReadByteData[i]=$23) or (ReadByteData[i]=$DD)  then
            begin
              TemLen :=i;
              Break;
            end;
          end;
          if TemLen <0 then
            TemLen :=High(ReadBytedata)+1;

          for i:=TemLen to High(ReadByteData) do
          begin
            StrRcvCmd:=StrRcvCmd+IntToHex(ReadByteData[i],2);
          end;

        end;
      end;
      if StrRcvCmd<>'' then
      begin

        ReadLen:=Length(StrRcvCmd) div 2;
        SetLength(ReadByteData,ReadLen);
        if ReadLen>0 then
        begin
          for i:=0 to ReadLen-1 do
            ReadByteData[i]:=StrToInt('$'+Copy(StrRcvCmd,i*2+1,2));
        end;
      end
      else
        ISAnalysis :=false;
    end;
  except
    {$IFDEF MONI}
    on E:Exception do
    begin
      LogE('machine:'+inttostr(Length(ReadBytedata))+E.Message);
    end;
    {$ENDIF}
  end;
end;

{键盘发送命令}
procedure TThread_Communicate.SendData;
var
  i:Integer;
  lrc:LongWord;
  TemInt:Integer;
  ByteSend:array  of Byte;
  cmdStr:string;
begin
  if lstCmd.Count >0 then
  begin
    if (MilliSecondsBetween(SendDateTime,Now)<50) and (FCmdStr=lstCmd.Strings[0]) then
      Exit
    else begin
      if ISInit then
        RecvInit:=RecvInit +1;
    end;

    FCmdStr :=lstCmd.Strings[0];
    cmdStr :=lstCmd.Strings[0];
    TemInt:= Length(CmdStr) Div 2;
    SetLength(ByteSend,TemInt);

    for i:=0 to TemInt-1 do
    begin
      ByteSend[I]:=StrToInt('$'+LeftStr(CmdStr,2));
      CmdStr:=RightStr(CmdStr,Length(CmdStr)-2);
    end;

    WriteFile(hComm,ByteSend[0],Length(ByteSend),lrc, LpolW);

    SendDateTime := Now;
    ReadDateTime := Now;
  end;
end;

procedure TThread_Communicate.SendData1(cmd: string);
var
  i:Integer;
  lrc:LongWord;
  TemInt:Integer;
  ByteSend:array  of Byte;
  cmdStr:string;
begin
  if HComm>0 then
  begin
    cmdStr:=cmd;
    TemInt:= Length(CmdStr) Div 2;
    SetLength(ByteSend,TemInt);
    for i:=0 to TemInt-1 do
    begin
      ByteSend[I]:=StrToInt('$'+LeftStr(CmdStr,2));
      CmdStr:=RightStr(CmdStr,Length(CmdStr)-2);
    end;

    for i:=Low(ByteSend) to High(ByteSend) do
    begin
      WriteFile(hComm,ByteSend[i],1,lrc, LpolW);
    end;
  end;
end;

{ TThread_OrderConfirm }

constructor TThread_OrderConfirm.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
end;

procedure TThread_OrderConfirm.Execute;
begin
  inherited;
  if Assigned(SimpleOrder) then
  begin
    FBuySellEvent := SimpleOrder.processMachineOper;
    Synchronize(runBuySellEvent);
  end;
end;

procedure TThread_OrderConfirm.runBuySellEvent;
begin
  if Assigned(FBuySellEvent) then
    FBuySellEvent(FCmd);
end;
initialization
  CommLst:=TStringList.Create;
finalization
  CommLst.Free;
end.