unit1.~pas

用Delphi语言实现的串口通讯

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, SPComm, Menus;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    Label1: TLabel;
    Memo1: TMemo;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    Comm1: TComm;
    Memo2: TMemo;
    PopupMenu2: TPopupMenu;
    SaveDialog1: TSaveDialog;
    N1: TMenuItem;
    N2: TMenuItem;
    SpeedButton1: TSpeedButton;
    PopupMenu1: TPopupMenu;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    BitBtn5: TBitBtn;
    Label2: TLabel;
    EditHex: TEdit;
    BitBtn6: TBitBtn;
    CheckBoxDecode: TCheckBox;
    SpeedButton2: TSpeedButton;
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure MenuItem1Click(Sender: TObject);
    procedure MenuItem2Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  private
    { Private declarations }


  public
    { Public declarations }
    CurrentComPort    : string;
    CurrentBaudRate   : integer;

    CurrentBytesize      : TByteSize;
    CurrentStopBits      : TStopBits;
    CurrentOutx_CtsFlow  : boolean;
    CurrentOutx_DsrFlow  : boolean;
    CurrentParityCheck   : Boolean;
    CurrentParity        : TParity;
    CurrentOutx_XonXoffFlow : boolean;

    Procedure InitCom;
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
  InitCom;
end;

Procedure TForm1.InitCom;
begin
  Comm1.StopComm ;
  Comm1.CommName := CurrentComPort;
  Comm1.BaudRate := CurrentBaudRate;
  Comm1.Bytesize := CurrentBytesize;
  Comm1.StopBits := CurrentStopBits;
  Comm1.Parity   := CurrentParity;
  Comm1.Outx_CtsFlow     := CurrentOutx_CtsFlow  ;
  Comm1.Outx_DsrFlow     := CurrentOutx_DsrFlow  ;
  Comm1.ParityCheck      := CurrentParityCheck   ;
  Comm1.Outx_XonXoffFlow := CurrentOutx_XonXoffFlow;

  try
    Comm1.Startcomm;
  except
    GroupBox1.Caption := '';
    ShowMessage('无法打开串口：'+CurrentComPort);
  end;
  GroupBox1.Caption := CurrentComPort;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  Form2.ShowModal;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CurrentComPort  := 'COM1';
  CurrentBaudRate := 9600;
  CurrentBytesize      := _8;
  CurrentStopBits      := _1;
  CurrentOutx_CtsFlow  := false;
  CurrentOutx_DsrFlow  := false;
  CurrentParityCheck   := false;
  CurrentParity        := None;
  CurrentOutx_XonXoffFlow := false;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin

  if Comm1.WriteCommData(pchar(Edit1.Text),Length(Edit1.Text)) then
  begin
    Memo1.Lines.Add('Send: '+Edit1.Text );
    Edit1.Text := '';
  end
  else
    ShowMessage('发送错误！');
  Edit1.SetFocus;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Memo1.Lines.Clear;
  Memo2.Lines.Clear;
  BitBtn4Click(Self);
end;

procedure TForm1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
Var
s:string;
i:integer;
S2:string;
CurrentLenOfHour   : string;
CurrentLenOfMinute : string;
CurrentLenOfSecond : string;
CurrentCallerNumber: string;
CurrentCalledNumber: string;
CurrentStartHour   : string;
CurrentStartMinute : string;
CurrentStartSecond : string;
CurrentStartYear   : string;
CurrentStartMonth  : string;
CurrentStartDay    : string;
StartTime : string;

InfString : string;
begin
   SetLength(s, BufferLength);
   Move(Buffer^, pchar(s)^, BufferLength);

   if not CheckBoxDeCode.Checked then
      Memo1.Lines.Add('Recv: '+ s);
   else
   begin
      InfString := s;
      //判断长度
      if Length(InfString) <> 83 then
      begin
         ShowMessage('帧长度不匹配！');
         exit;
      end;
      //取标志位
      if Copy(InfString,4,3) <> 'POT' THEN
      begin
        ShowMessage('话单标记不匹配！');
        EXIT;
      end;
      CurrentLenOfHour   := Copy(InfString,27,2);
      CurrentLenOfMinute := COpy(InfString,30,2);
      CurrentLenOfSecond := Copy(InfString,33,2);
      CurrentCallerNumber:= Copy(InfString,36,4);
      CurrentCalledNumber:= Copy(InfString,47,12);
      CurrentStartHour   := Copy(InfString,10,2);
      CurrentStartMinute := Copy(InfString,13,2);
      CurrentStartSecond := '00';
      //CurrentStartYear   := Copy(InfString,);
      //CurrentStartMonth  := Copy(InfString,);
      //CurrentStartDay    := Copy(InfString,);
      StartTime          := CurrentStartHour   + ':' +
                        CurrentStartMinute + ':' +
                        CurrentStartSecond;


     Memo1.Lines.Add('主叫：'+ CurrentCallerNumber);
     Memo1.Lines.Add('被叫：'+ CurrentCalledNumber);
     Memo1.Lines.Add('日期：'+ '');
     Memo1.Lines.Add('通话开始时间：'+ StartTime );
     Memo1.Lines.Add('时长：'+ CurrentLenOfHour+':'+CurrentLenOfMinute+':'+CurrentLenOfSecond);
   end;

   //转换成十六进制
   s2:='';
   for i:=0 to BufferLength-1 do
   begin
     if s2='' then
        s2 := s2 +  IntToHex(Byte((Buffer^)),2)
     else
        s2 := s2 +  '-' +IntToHex(Byte((Buffer^)),2);
     Buffer:= Pointer(Integer(Buffer)+sizeof(byte));
   end;
   Memo2.lines.add(s2);




end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then
     Bitbtn1Click(self);
end;




procedure TForm1.N1Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
  begin
    Memo2.Lines.SaveToFile(SaveDialog1.FileName);
  end;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  memo2.Lines.Clear;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
Buf : array[1..16] of char;
i : integer;
begin
  for i:=1 to 8 do
      Buf[i] := chr( ord('0')+i);
  for i:=1 to 8 do
      Buf[i+8] := chr( $f1 + i);

  Comm1ReceiveData(Self, @Buf,16);
end;

procedure TForm1.MenuItem1Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
  begin
    Memo1.Lines.SaveToFile(SaveDialog1.FileName);
  end;
end;

procedure TForm1.MenuItem2Click(Sender: TObject);
begin
  Memo1.Clear;
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
var
Buf : array[1..8] of byte;
i : integer;
begin
/////////////////////////////
  Buf[1] := $40;
  Comm1.WriteCommData(@Buf,1);
  Sleep(200);
  Buf[1] := $0a;
  Comm1.WriteCommData(@Buf,1);
  //Sleep(200);
  Memo2.Lines.Add('(Hex)Send: 40-0A');
//////////////////////////////
  for i:=1 to 7 do
      Buf[i] := $F4; // TXSYNCB
  Buf[8] := $F5;     //RXSYNCB
  Comm1.WriteCommData(@Buf,8);
  Memo2.Lines.Add('(Hex)Send: F4-F4-F4-F4-F4-F4-F4-F5');
  
end;

procedure TForm1.BitBtn6Click(Sender: TObject);
var
s : string;
i : integer;
Index : integer;
Buf : array[1..80] of char;
Len : integer;
begin
  for i:=1 to 80 do
      Buf[i] := chr(0);

  Len := Length(EditHex.text);
  i := 1;
  Index := 1;
  while i < Len do
  begin
    s := copy(EditHex.text,i,2);
    Buf[Index] := char( StrtoInt('$'+s) );
    Index := Index + 1;
    i := i+3;
  end;
  Comm1.WriteCommData(@buf,Index-1 );
  s := '';
  for i:=1 to Index-1 do
     s := s+Buf[i];
  Memo1.Lines.Add('(HexEdit)Send:' + s );

  //EditHex.Text := '';


end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
Buf : array[1..83] of char;
begin
  //Test data
  Buf[1] := 'H';
  Buf[2] := 'T';
  Buf[3] := 'C';

  Buf[4] := 'P';
  Buf[5] := 'O';
  Buf[6] := 'T';

  //拨号开始时间
  Buf[10] := '1';
  Buf[11] := '9';
  Buf[13] := '0';
  Buf[14] := '7';

  //时长
  Buf[27] := '0';
  Buf[28] := '1';
  Buf[30] := '2';
  Buf[31] := '3';
  Buf[33] := '4';
  Buf[34] := '5';

  //主叫
  Buf[36] := '9';
  Buf[37] := '8';
  Buf[38] := '7';
  Buf[39] := '6';
  //被叫
  Buf[47] := '1';
  Buf[48] := '2';
  Buf[49] := '3';
  Buf[50] := '4';
  Buf[51] := '5';
  Buf[52] := '6';
  Buf[53] := '7';
  Buf[54] := '8';
  Buf[55] := '9';
  Buf[56] := '0';
  Buf[57] := '1';
  Buf[58] := '2';

  //结束
  Buf[80] := '5';
  Buf[81] := 'T';
  Buf[82] := 'E';
  Buf[83] := 'L';

  Comm1ReceiveData(Self, @Buf,83);
end;

end.

 //ShowMessage('value:'+IntToStr(Byte(_9)) +':' +IntToStr(Byte(_5))+'-'+IntToStr(Byte(_6))+'-'+IntToStr(Byte(_7))+'-'+IntToStr(Byte(_8)));