100分求 SYRIS 控制器通讯协议（SY210NT）

SYRIS常用协议都支持，包括:TCP,UDP,IP,ICMP,ARP等。

TO yi10000SYRIS常用协议？？？这是什么东东，有没有？发来瞧瞧，有用的话分全给你。[email protected]

以前开发过，如果需要，可以找找发给你，试下如下代码是否可以，代码比较乱
unit syrismanfrmu;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SPComm, StdCtrls, Buttons, ComCtrls, ExtCtrls, AppEvnts, ShellApi;const
  listen_CardId = 1;
  isFindCardId = 2;
  DelCard = 3;
  IniControl = 4;
  AddCard = 5;
  listen_CardId_Read = 6;
  Listen_CardId_DelAll = 7;  App1 = '013031454130313333463030303030303030303030303030303002344641310D';
  App2 = '013031454130323131463030303030303030303030303030303002323639320D';
  App3 = '013031454130333232463030303030303030303030303030303002383038320D';
  App4 = '013031454130343030463030303030303030303030303030303002364446340D';const
  idSysAbout = 100;type
  Tsyrismanfrm = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    edtCardNo: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    edtACardID: TEdit;
    sbutAddCard: TSpeedButton;
    chkDoor2: TCheckBox;
    chkDoor1: TCheckBox;
    Label13: TLabel;
    cmbSelControl: TComboBox;
    sbutSetApp: TSpeedButton;
    Comm1: TComm;
    lisCardID: TListBox;
    tmReadInvailCardNo: TTimer;
    StatusBar1: TStatusBar;
    TabSheet4: TTabSheet;
    meoDebug: TMemo;
    btnConnect: TButton;
    Label1: TLabel;
    sbtnListen: TSpeedButton;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    sbutDelCard: TSpeedButton;
    cbComPort: TComboBox;
    Label2: TLabel;
    ApplicationEvents1: TApplicationEvents;
    procedure tmReadInvailCardNoTimer(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure FormCreate(Sender: TObject);
    procedure sbutDelCardClick(Sender: TObject);
    procedure sbutSetAppClick(Sender: TObject);
    procedure sbutAddCardClick(Sender: TObject);
    procedure lisCardIDDblClick(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure sbtnListenClick(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    procedure Panel1DblClick(Sender: TObject);
  private
    isComPortOpen: boolean;
    SysStatus: Integer;
    //  checkstr: string;
    iOrder: integer;
    // myLorder: integer;
    sListenOrder: string;
    isListening: boolean;
    procedure ReadCardIoData;
    procedure ListenCardIDDelAll;
    procedure SendData2Com(str: string);
    function CreatCrcStr(str: string): string;
    function CreatAddCardCode(CardNo, CardID: string; iApp: byte): string;
    procedure AddDebugMsg(sMsg: string; Reason: string = '');
    procedure AddStatusMsg(sMsg: string; iPanel: integer = 1);
    function CreatListenCardIdOrder(iNo: byte): string;
  public
    { Public declarations }
  end;var
  syrismanfrm: Tsyrismanfrm;implementation
uses sysriscrcu, BinHexTools, getverfu;
{$R *.dfm}procedure Delay(msecs: DWord);
var
  J: DWORD; //Longint;
begin
  J := GetTickCount;
  repeat
    Application.ProcessMessages; {不要让程序死沉}
  until ((GetTickCount - J) >= msecs);
end;procedure Tsyrismanfrm.AddDebugMsg(sMsg: string; Reason: string = '');
begin
  if MeoDebug.Lines.Count > 300 then MeoDebug.Clear;
  meoDebug.Lines.Add(DateTimeToStr(Now) + '- ' + Reason + '- ' + sMsg);
  if Length(Reason) > 0 then
    AddStatusMsg(Reason);
end;procedure Tsyrismanfrm.AddStatusMsg(sMsg: string; iPanel: integer = 1);
begin
  StatusBar1.Panels[iPanel].Text := sMsg;
end;procedure Tsyrismanfrm.ReadCardIoData;
var
  s, s1: string;
begin
  SysStatus := listen_CardId_Read;
  s := '01' + 'IA';
  s1 := CreatCrcStr(s);
  SendData2Com(s1);
end;

procedure Tsyrismanfrm.ListenCardIDDelAll;
var
  s, s1: string;
begin
  SysStatus := Listen_CardId_DelAll;
  s := '01' + 'IH';
  s1 := CreatCrcStr(s);
  SendData2Com(s1);
end;procedure Tsyrismanfrm.SendData2Com(str: string);
var
  sTx, stmpTX: string;
  iTx: word;
  bTx: array[0..100] of byte;
  i, iLen: Integer; // Buffer: Pointer;
begin  AddStatusMsg('正在通信...');  try
    sTx := str;
    iLen := Length(sTx);
    iTx := iLen div 2;
    for I := 0 to (iTx - 1) do
    begin
      sTmpTx := sTx;
      Delete(sTmpTx, 1, 2 * i);
      Delete(sTmpTx, 3, 100);
      sTmpTx := '$' + sTmpTx;
      bTx[i] := StrToInt(sTmpTx);
    end;
    bTx[iTx] := 0;    sTx := '';
    for I := 0 to iTx - 1 do
      sTx := sTx + IntToHex(bTx[i], 2);    Comm1.WriteCommData(pchar(@bTx[0]), iTx);    AddStatusMsg('');
  except
    on E: Exception do
      ShowMessage(E.Message);
  end;end;function Tsyrismanfrm.CreatCrcStr(str: string): string;
var
  crc, s1: string;
begin
  s1 := '01' + AscToHex(str) + '02';
  crc := getcrc(s1);
  case Length(crc) of
    3: crc := '0' + crc;
    2: crc := '00' + crc;
    else
      ;
  end;
  Result := s1 + AscToHex(crc) + '0D';
end;function Tsyrismanfrm.CreatAddCardCode(CardNo, CardID: string; iApp: byte):
  string;
var
  s, crcNo: string;
  App: string;
begin
  App := '0' + IntToStr(iApp);
  s := '01' + 'HA' + CardNo + CardID +
    App + '0XXXX0';
  //群组   0:type XXXX:Pin 0:APB       //'010XXXX0';
  crcNo := CreatCrcStr(s);
  Result := crcNo;
end;function Tsyrismanfrm.CreatListenCardIdOrder(iNo: byte): string;
var
  s, crcNo, sI: string;
begin
  sI := IntToStr(iNo);
  if Length(sI) = 1 then sI := '0' + sI;
  s := '01II' + sI;  crcNo := CreatCrcStr(s);
  Result := crcNo;
end;procedure Tsyrismanfrm.tmReadInvailCardNoTimer(Sender: TObject);
var
  str: string;
  iO: integer;
begin
  tmReadInvailCardNo.Enabled := False;
  case SysStatus of
    Listen_CardId_DelAll:
      begin
        ListenCardIDDelAll;
      end;
    listen_CardId_Read:
      begin
        ReadCardIoData;
      end;
    listen_CardId:
      begin
        iO := StrToIntDef(sListenOrder, 3031) - 3030;
        str := CreatListenCardIdOrder(iO);
        SendData2Com(str);
      end;
    IniControl:
      begin
        case iOrder of
          1: SendData2Com(App1);
          2: SendData2Com(App2);
          3: SendData2Com(App3);
          4: SendData2Com(App4);
        end;
      end;
  end;
end;procedure Tsyrismanfrm.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
  tmpRx, tmp1: string;
  i, iLen: Integer;
  isFind: Boolean;
  rbuf: array[0..1024] of byte;
begin
  iLen := BufferLength;
  try
    move(buffer^, pchar((@rbuf)^), iLen);
    for i := 0 to iLen - 1 do
    begin
      tmp1 := IntToHex(rbuf[i], 2);
      if tmp1 = '04' then
        break
      else
        tmpRx := tmpRx + tmp1;
    end;
    Delete(tmpRx, 1, 2);    case SysStatus of
      Listen_CardId_DelAll:
        begin
          AddDebugMsg(tmpRx, '删除资料');
          SysStatus := listen_CardId_Read;
          if isListening then
            tmReadInvailCardNo.Enabled := True;
          Exit;
        end;
      listen_CardId_Read:
        begin
          AddDebugMsg(tmpRx, '读取资料');
          i := Length(tmpRx);
          if I = 56 then
          begin
            I := Pos('5858', tmpRx);
            if i = 39 then
            begin
              Delete(tmpRx, 1, 42);
              Delete(tmpRx, 5, 1000);
            end;
            sListenOrder := tmpRx;
            AddDebugMsg(tmpRx);
            SysStatus := listen_CardId;
          end;
          if isListening then
            tmReadInvailCardNo.Enabled := True;
          Exit;
        end;
      listen_CardId:
        begin
          Delete(tmpRx, 1, 8);
          isFind := False;
          if (LisCardId.Count > 0) and (Length(tmpRx)>5) then
          begin
            for I := 0 to LisCardId.Count - 1 do
            begin
              if LisCardId.Items.Strings[i] = tmpRx then
              begin
                isFind := True;
                break;
              end;
            end;
          end;
          if not isFind then
            lisCardID.Items.Add(tmpRx);
          SysStatus := Listen_CardId_DelAll;
          if isListening then
            tmReadInvailCardNo.Enabled := True;
          Exit;
        end;
      AddCard:
        begin
          if Length(tmpRx) <> 8 then
          begin
            Delete(tmpRx, 1, 8);
            AddDebugMsg(tmpRx, '增加卡片失败');
            ShowMessage('增加卡片失败');
          end
          else
          begin
            AddDebugMsg(tmpRx, '增加卡片成功');
            ShowMessage('增加卡片成功');
          end;
        end;
      DelCard:
        begin
          if Length(tmpRx) <> 8 then
          begin
            Delete(tmpRx, 1, 8);
            AddDebugMsg(tmpRx, '删除卡片失败');
            ShowMessage('删除卡片失败');
          end
          else
          begin
            AddDebugMsg(tmpRx, '删除卡片成功');
            ShowMessage('删除卡片成功');
          end;
        end;
      IniControl:
        begin
          begin
            if Length(tmpRx) <> 8 then
            begin
              Delete(tmpRx, 1, 8);
              AddDebugMsg(tmpRx, '设置群组失败 - ' + IntToStr(iOrder));
              ShowMessage('设置群组失败');
            end
            else
            begin
              if iOrder = 4 then
              begin
                AddDebugMsg(tmpRx, '设置群组成功');
                ShowMessage('设置群组成功');
              end;
            end;
            if iOrder < 4 then
            begin
              Inc(iOrder);
              tmReadInvailCardNo.Enabled := True;
            end;
          end;
        end;
    end;  except
    on E: Exception do
      Meodebug.Lines.Add(E.Message);
  end;
end;

TO aiirii好啊，发来看看。
刚刚发的代码里面有个CreatCrcStr函数，这个函数里面调用了GetCRC，可不可以把代码发全一点啊，我的邮箱：[email protected]

TO aiiriifunction Tsyrismanfrm.CreatCrcStr(str: string): string;
var
  crc, s1: string;
begin
  s1 :=  '01 ' + AscToHex(str) +  '02 ';
  crc := getcrc(s1); //可否贴出GetCRC这个函数的源码
  case Length(crc) of
    3: crc :=  '0 ' + crc;
    2: crc :=  '00 ' + crc;
    else
      ;
  end;
  Result := s1 + AscToHex(crc) +  '0D ';
end;

unit sysriscrcu;interfaceuses SysUtils;function getcrc(source: string): string;
function gcrcLo(sr: integer): integer;
function gcrcHi(sr: integer): integer;
function getcrc1(source: string): string;implementationfunction getcrc(source: string): string;
var
  mCRCLo, mCRCHi, mStrLen, i, ret, mIndex: integer;
  AscIIstr: string;
  mAsc: integer;
  mHigh, mLow: integer;
begin
  //mCRCLo:=$ff;mCRCHi:=$ff;
  mCRCLo := 0;
  mCRCHi := 0;
  mStrlen := (Length(source) div 2);
  for i := 1 to mStrLen do
  begin
    AscIIstr := source;
    delete(AscIIstr, 1, 2 * (i - 1));
    delete(AscIIstr, 3, 1000);
    mAsc := StrToInt('$' + AscIIstr);
    if (mAsc >= 0) and (mAsc < 256) then
    begin
      mIndex := (mAsc xor mCRCLo);
      mCRCLo := gCRCLo(mIndex) xor mCRCHi;
      mCRCHi := gCRCHi(mIndex);
    end
    else
    begin
      mHigh := mAsc div 256;
      mLow := mAsc mod 256;
      mIndex := (mHigh xor mCrcLo) + 1;
      mCrcLo := gCrcLo(mIndex) xor mCrchi;
      mCrcHi := gCrcHi(mIndex);
      mIndex := (mLow xor mCrcLo) + 1;
      mCrcLo := gCrcLo(mIndex) xor mCrchi;
      mCrchi := gCrchi(mIndex);
    end;
  end;
  ret := mCRCHi * 256 + mCRCLo;
  //  ret:=mCRCHi+mCRCLo*256;
  getcrc := inttohex(ret, 0);
end;function getcrc1(source: string): string;
var
  mCRCLo, mCRCHi, mStrLen, i, mIndex: integer;
  AscIIstr: string;
  mAsc: integer;
  mHigh, mLow: integer;
  ret: int64;
begin
  //mCRCLo:=$ff;mCRCHi:=$ff;
  mCRCLo := 0;
  mCRCHi := 0;
  mStrlen := (Length(source) div 2);
  for i := 1 to mStrLen do
  begin
    AscIIstr := source;
    delete(AscIIstr, 1, 2 * (i - 1));
    delete(AscIIstr, 3, 1000);
    mAsc := StrToInt('$' + AscIIstr);
    if (mAsc >= 0) and (mAsc < 256) then
    begin
      mIndex := (mAsc xor mCRCLo);
      mCRCLo := gCRCLo(mIndex) xor mCRCHi;
      mCRCHi := gCRCHi(mIndex);
    end
    else
    begin
      if mAsc < 0 then
        mAsc := mAsc + 65536;
      mHigh := mAsc div 256;
      mLow := mAsc mod 256;
      mIndex := (mHigh xor mCrcLo) + 1;
      mCrcLo := gCrcLo(mIndex) xor mCrchi;
      mCrcHi := gCrcHi(mIndex);
      mIndex := (mLow xor mCrcLo) + 1;
      mCrcLo := gCrcLo(mIndex) xor mCrchi;
      mCrchi := gCrchi(mIndex);
    end;
  end;
  ret := mCRCHi * 256 + mCRCLo;
  //  ret:=mCRCHi+mCRCLo*256;
  getcrc1 := inttohex(ret, 0);
end;

function gcrcLo(sr: integer): integer;
const
  lowArray: array[0..255] of integer = (
    $00, $C1, $81, $40, $01, $C0, $80, $41, $01, $C0, $80, $41, $00, $C1, $81,
    $40,
    $01, $C0, $80, $41, $00, $C1, $81, $40, $00, $C1, $81, $40, $01, $C0, $80,
    $41,
    $01, $C0, $80, $41, $00, $C1, $81, $40, $00, $C1, $81, $40, $01, $C0, $80,
    $41,
    $00, $C1, $81, $40, $01, $C0, $80, $41, $01, $C0, $80, $41, $00, $C1, $81,
    $40,
    $01, $C0, $80, $41, $00, $C1, $81, $40, $00, $C1, $81, $40, $01, $C0, $80,
    $41,
    $00, $C1, $81, $40, $01, $C0, $80, $41, $01, $C0, $80, $41, $00, $C1, $81,
    $40,
    $00, $C1, $81, $40, $01, $C0, $80, $41, $01, $C0, $80, $41, $00, $C1, $81,
    $40,
    $01, $C0, $80, $41, $00, $C1, $81, $40, $00, $C1, $81, $40, $01, $C0, $80,
    $41,
    $01, $C0, $80, $41, $00, $C1, $81, $40, $00, $C1, $81, $40, $01, $C0, $80,
    $41,
    $00, $C1, $81, $40, $01, $C0, $80, $41, $01, $C0, $80, $41, $00, $C1, $81,
    $40,
    $00, $C1, $81, $40, $01, $C0, $80, $41, $01, $C0, $80, $41, $00, $C1, $81,
    $40,
    $01, $C0, $80, $41, $00, $C1, $81, $40, $00, $C1, $81, $40, $01, $C0, $80,
    $41,
    $00, $C1, $81, $40, $01, $C0, $80, $41, $01, $C0, $80, $41, $00, $C1, $81,
    $40,
    $01, $C0, $80, $41, $00, $C1, $81, $40, $00, $C1, $81, $40, $01, $C0, $80,
    $41,
    $01, $C0, $80, $41, $00, $C1, $81, $40, $00, $C1, $81, $40, $01, $C0, $80,
    $41,
    $00, $C1, $81, $40, $01, $C0, $80, $41, $01, $C0, $80, $41, $00, $C1, $81,
    $40);
begin
  gcrcLo := lowArray[sr];
end;function gcrcHi(sr: integer): integer;
const
  HiArray: array[0..255] of integer = (
    $00, $C0, $C1, $01, $C3, $03, $02, $C2, $C6, $06, $07, $C7, $05, $C5, $C4,
    $04,
    $CC, $0C, $0D, $CD, $0F, $CF, $CE, $0E, $0A, $CA, $CB, $0B, $C9, $09, $08,
    $C8,
    $D8, $18, $19, $D9, $1B, $DB, $DA, $1A, $1E, $DE, $DF, $1F, $DD, $1D, $1C,
    $DC,
    $14, $D4, $D5, $15, $D7, $17, $16, $D6, $D2, $12, $13, $D3, $11, $D1, $D0,
    $10,
    $F0, $30, $31, $F1, $33, $F3, $F2, $32, $36, $F6, $F7, $37, $F5, $35, $34,
    $F4,
    $3C, $FC, $FD, $3D, $FF, $3F, $3E, $FE, $FA, $3A, $3B, $FB, $39, $F9, $F8,
    $38,
    $28, $E8, $E9, $29, $EB, $2B, $2A, $EA, $EE, $2E, $2F, $EF, $2D, $ED, $EC,
    $2C,
    $E4, $24, $25, $E5, $27, $E7, $E6, $26, $22, $E2, $E3, $23, $E1, $21, $20,
    $E0,
    $A0, $60, $61, $A1, $63, $A3, $A2, $62, $66, $A6, $A7, $67, $A5, $65, $64,
    $A4,
    $6C, $AC, $AD, $6D, $AF, $6F, $6E, $AE, $AA, $6A, $6B, $AB, $69, $A9, $A8,
    $68,
    $78, $B8, $B9, $79, $BB, $7B, $7A, $BA, $BE, $7E, $7F, $BF, $7D, $BD, $BC,
    $7C,
    $B4, $74, $75, $B5, $77, $B7, $B6, $76, $72, $B2, $B3, $73, $B1, $71, $70,
    $B0,
    $50, $90, $91, $51, $93, $53, $52, $92, $96, $56, $57, $97, $55, $95, $94,
    $54,
    $9C, $5C, $5D, $9D, $5F, $9F, $9E, $5E, $5A, $9A, $9B, $5B, $99, $59, $58,
    $98,
    $88, $48, $49, $89, $4B, $8B, $8A, $4A, $4E, $8E, $8F, $4F, $8D, $4D, $4C,
    $8C,
    $44, $84, $85, $45, $87, $47, $46, $86, $82, $42, $43, $83, $41, $81, $80,
    $40);
begin
  gcrcHi := HiArray[sr];
end;end.

有没有AscToHex(str)函数啊？

调试易

100分求 SYRIS 控制器通讯协议（SY210NT）

解决方案 »