unit1.~pas

spcomm是DELPHI

//*********************************************************
//                 Kaersoft    卡尔软件
//         *************************************
//          http://www.kaer.cn/default.aspx
//          Email:[e-mail]
//          QQ:54076683
//          Delphi 7.0   PASS
//          调测人：JPYC
//**********************************************************
//                      程序功能
//            演示SPCOMM收发数据的例子
//             
//**********************************************************
//实现思路：打开窗体时自动打开串口1，关闭是自动关闭串口
//**********************************************************
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Comm1: TComm;
    Memo1: TMemo;
    Memo2: TMemo;
    Button3: TButton;
    Button4: TButton;
    Check1: TCheckBox;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure SendHex(S: String);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

procedure TForm1.SendHex(S: String);
var
  s2:string;
  buf1:array[0..50000] of char;
  i:integer;
begin
  s2:='';
  for i:=1 to  length(s) do
  begin
    if ((copy(s,i,1)>='0') and (copy(s,i,1)<='9'))or((copy(s,i,1)>='a') and (copy(s,i,1)<='f'))
        or((copy(s,i,1)>='A') and (copy(s,i,1)<='F')) then
    begin
        s2:=s2+copy(s,i,1);
    end;
  end;
  for i:=0 to (length(s2) div 2-1) do
    buf1[i]:=char(strtoint('$'+copy(s2,i*2+1,2)));
  Comm1.WriteCommData(buf1,(length(s2) div 2));
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  p:pchar;
  x:integer;
begin
  if Check1.Checked then
    SendHex(Memo1.Lines.Text)   //发送十六进制
  else begin
    x:=Length(Memo1.Lines.Text);    //发送字符
    p:=Pchar(Memo1.Lines.Text);
    Comm1.WriteCommData(p,x);
  end;
end;

procedure TForm1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
 tmpArray:array[0..4096] of Byte;
 ArraySize,i: DWORD;
 Count:DWORD;
 tmpStr:string;
 pStr:PChar;
begin
  if Check1.Checked  then
  begin
   pStr:=Buffer;
   tmpStr:=string(pStr);
   Dec(PStr);
   for i:=0 to Length(tmpStr)-1 do
    begin
     inc(PStr);
     tmpArray[i]:=Byte(PSTR^);
     Memo2.Lines.Add(IntToHEX(Ord(tmpArray[i]),2));
    end;
   exit;
  end;
  pStr:= Buffer;
  memo2.Lines.Add(pStr);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Comm1.StartComm;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Comm1.StopComm;
end;

end.