unit1.pas

模仿DCS系统主站的仿真软件

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, cyscomm;

//16位CRC校验表
const
  auchCRCHi: array[0..255] of Byte =(
    $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);

  auchCRCLo:array[0..255] of Byte = (
    $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);

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    Button1: TButton;
    Button2: TButton;
    RadioGroup1: TRadioGroup;
    btnSend: TButton;
    RadioGroup2: TRadioGroup;
    Timer1: TTimer;
    mSend: TMemo;
    mReceive: TMemo;
    Button3: TButton;
    cbRepeat: TCheckBox;
    cbBaud: TComboBox;
    cbData: TComboBox;
    cbCheck: TComboBox;
    cbStop: TComboBox;
    Button4: TButton;
    Timer2: TTimer;
    Edit1: TEdit;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure mSendKeyPress(Sender: TObject; var Key: Char);
    procedure mReceiveChange(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
////////////////////////////dcs test/////////////////////////////////////
    procedure Timer2Timer(Sender: TObject);
    procedure SendDownDOFrameCode;
    procedure SendDownDIFrameCode;
    procedure SendDownRM1FrameCode;
    procedure SendDownRM2FrameCode;
    procedure SendDownRM3FrameCode;
    procedure SendDownRP1FrameCode;
    procedure SendDownRP2FrameCode;
    procedure WriteCOMPort(Frame: array of Byte; nLen: Integer);
    procedure FormCreate(Sender: TObject);
    procedure mSendChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
//////////////////////////////////////////////////////////////////

  private
  public
    procedure OpenComm;
    function CheckCRC(pInfo: array of Byte; nLen: Integer): Word;
  end;

var
  Form1: TForm1;
  hComm: THandle;
  QueryInx: integer;
  QueryCnt: integer;
  Addr: integer;
  procedure StrToHexStr(const SourceStr: string; var HexStr: string);
  Function StringToFrame(s:string): string;
  Function IntToByte(intValue: integer): byte;
  procedure writeFrame;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin
  if (hComm <> INVALID_HANDLE_VALUE) and (hComm <> 0) then begin
    ShowMessage('通信端口已打开!');
    exit;
  end;
  OpenComm;
end;

procedure TForm1.OpenComm;
var
  cc:TCOMMCONFIG;
  Temp:string;
begin
  Temp:='com'+inttostr(ComboBox1.ItemIndex + 1);
  if ComboBox1.ItemIndex > 8 then
    Temp :=  '\\.\' + Temp;
  hComm := CreateFile(PChar(Temp), GENERIC_READ or GENERIC_WRITE,
       0, nil, OPEN_EXISTING, 0, 0);
  if (hComm = INVALID_HANDLE_VALUE) then begin
    MessageBox(0, pchar('打开端口'+Temp+'失败!'),'error!',MB_OK);
    exit;
  end;     

  GetCommState(hComm,cc.dcb);
  cc.dcb.BaudRate := strToint(cbBaud.Text);
  cc.dcb.ByteSize := strToint(cbData.Text);
  cc.dcb.Parity := cbCheck.ItemIndex;
  cc.dcb.StopBits := cbStop.ItemIndex;

  if not SetCommState(hComm, cc.dcb) then begin
    MessageBox(0, pchar('设置端口' + Temp + '失败!'),'',MB_OK);
    CloseHandle(hComm);
    exit;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   CloseHandle(hComm);
   close;
end;

procedure TForm1.btnSendClick(Sender: TObject);
var
  Temp:string;
  lrc:LongWord;
  FrmCode: string;
begin
 if (hComm = 0) or (hComm = INVALID_HANDLE_VALUE) then exit;
//if (hComm = 0) then exit;
  case RadioGroup1.ItemIndex of
  0:begin
      Temp := msend.Text ;
      WriteFile(hComm,Pointer(Temp)^,Length(Temp), lrc, nil);
    end;
  1:begin
      FrmCode := stringToFrame(msend.Lines.Text);
      WriteFile(hComm,Pointer(FrmCode)^,Length(FrmCode), lrc, nil);
    end;
  end;
end;

procedure StrToHexStr(const SourceStr: string; var HexStr: string);
const
  HexChars : array[0..15] of Char = '0123456789ABCDEF';
var
  i, j ,l, Len: WORD;
begin
  l := Length(SourceStr);
  Len := l * 3 - 1;
  SetLength(HexStr, Len);
  j := 1;
  for i := 1 to l do
  begin
    HexStr[j] := HexChars[Ord(SourceStr[i]) shr 4];
    Inc(j);
    HexStr[j] := HexChars[Ord(SourceStr[i]) and 15];

    if j >= len then
      Break;

    Inc(j);
    HexStr[j] := #32;
    Inc(j);
  end;
end;

Function StringToFrame(s: string): string;
var
  Frame: array of byte;
  strTemp: string;
  i,j,len,FrmLen: integer;
  FrmCode: string;
begin
  len := length(s);
  if len < 3 then
    FrmLen := 1
  else FrmLen := (len + 1) div 3;
  setlength(Frame,FrmLen);
  
  j := 0;
  for i := 0 to FrmLen - 1 do
  begin
    strTemp := s[j + 1] + s[j + 2];
    Frame[i] := IntToByte(strtoint(strTemp));
    j := j + 3;
  end;

  SetLength(FrmCode, FrmLen);
  for i := 1 to FrmLen do
    FrmCode[i] := Char(Frame[i - 1]);

  Result := FrmCode;
end;

procedure writeFrame;
begin

end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  RadioGroup2.ItemIndex := RadioGroup1.ItemIndex;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Temp : string;
  inbuff: array[0..2047] of Char;
  nBytesRead, dwError:LongWORD ;
  cs:TCOMSTAT;
  HexStr: string;
begin
   ClearCommError(hComm,dwError,@CS);  //取得状态
   if cs.cbInQue =0 then exit;
   if cs.cbInQue > sizeof(inbuff) then begin
     PurgeComm(hComm, PURGE_RXCLEAR);  // 清除COM 数据