一个磁卡机的例子，还是要自己看懂程序，自己慢慢调试吧：
type
TWriteCardForm = class(TForm)
Comm: TComm;
procedure FormDestroy(Sender: TObject);
procedure CommReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
bWriteCard, bWriteCardResult: Boolean;
function OpenComm: Boolean;
function WriteCard(sText: string): Boolean;
public
{ Public declarations }
end;
implementation
{$R *.DFM}
uses
Utils;
{ 磁卡机状态：
1. 三个灯都亮：电源打开而串口没有打开
2. 绿灯亮：准备好读磁卡
3. 黄灯亮：准备好写磁卡，20秒后超时
4. 红灯亮：出现错误
5. 声音：读写成功或收到电脑信息响一声，失败三声
}
procedure TWriteCardForm.FormCreate(Sender: TObject);
begin
bWriteCard := False;
OpenComm;
end;
procedure TWriteCardForm.FormDestroy(Sender: TObject);
begin
Comm.StopComm;
end;
procedure TWriteCardForm.CommReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
var
p: array[0..256] of Char;
sText: string;
i: Integer;
begin
if BufferLength < 256 then
begin
Dec(BufferLength); //最后一个BCC字符不要
StrLCopy(p, Buffer, BufferLength);
p[BufferLength] := #0;
sText := '';
for i := 0 to BufferLength - 1 do
if not (p in [#2, #3, '%', ';', '+', '?']) then
sText := sText + p; //从接收到的字符中去掉控制符，得到实际内容
if p[1] = #21 then //错误标志：#2 15h #3 BCC
begin
if bWriteCard then
begin
bWriteCardResult := False;
ShowError('出现错误，写卡失败。请重试！');
end
else ShowError('读卡失败')
end
else
begin
if bWriteCard then
begin
bWriteCardResult := True;
ShowMessage('写卡成功，写的内容是：' + sText);
end
else
begin
if Assigned(ReadCardEdit) and ReadCardEdit.Focused then
begin
ReadCardEdit.Text := sText;
if Assigned(ReadCardEdit.OnEnterPress) then
ReadCardEdit.OnEnterPress(ReadCardEdit);
end
else ShowMessage('从磁卡读到：' + sText);
end;
end;
end
else
begin
if bWriteCard then bWriteCardResult := False;
ShowError('接收的信息超过系统估计的256个字符');
end;
bWriteCard := False;
end;
function TWriteCardForm.OpenComm: Boolean;
begin
Result := True;
if Comm.Handle = 0 then
try
Comm.StartComm;
except
on E: Exception do
begin
Result := False;
ShowError('写卡机故障：' + E.Message, True);
end;
end;
end;
function TWriteCardForm.WriteCard(sText: string): Boolean;
var
sBuffer: string;
BCC: Byte;
i: Integer;
dw: DWord;
begin
Result := OpenComm;
if not Result then Exit;
sBuffer := ';' + sText + '?'#3; //第一轨起始符"%"、第二轨起始符";"、第三轨起始符"+"、结束符都是"?"，所有数据结束符#3
BCC := 0; //求异或和
for i := 1 to Length(sBuffer) do //
BCC := BCC xor Byte(sBuffer); //
sBuffer := #2 + sBuffer + Char(BCC); //所有数据以#2起始，BCC结束
Result := Comm.WriteCommData(PChar(sBuffer), Length(sBuffer));
if not Result then ShowMessage('系统错误，无法启动写卡过程')
else
begin
Result := False;
BeginWait('开始写卡，请把磁卡划过写卡机...');
bWriteCard := True; //进入写卡状态
bWriteCardResult := False; //写卡结果
dw := GetTickCount;
repeat
Sleep(1);
Application.ProcessMessages;
until not bWriteCard or (GetTickCount - dw > 20000); //超时或完成
EndWait;
if bWriteCard then
ShowError('超时，写卡失败。请重试！') //超时
else Result := bWriteCardResult;
bWriteCard := False; //退出写卡状态
end;
end;
