www.pudn.com > spcomm使用.rar > Unit1.pas

//********************************************************* 
//                 Kaersoft    卡尔软件 
//         ************************************* 
//          http://www.kaer.cn/default.aspx 
//          Email:Sdwhxyr@YEAH.NET 
//          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.