?? main.pas
字號:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, Menus,Registry, StdCtrls, Buttons,
CPort, CPortCtl, ExtCtrls;
type
TparaArray = array [0..7] of byte;
//********數據傳送命令格式******************
{發送格式 命令號0X00~0X0F}
Tdatasend = packed Record
Sendpc : byte;
Recpc : byte;
mlh : byte;
databuff : TparaArray;
momedata : array [0..3] of byte;
Rec : byte;
end;
{回應格式}
TdataRec = packed Record
Recpc : byte;
mlh : byte;
databuff : TparaArray;
momedata : array [0..4] of byte;
Rec : byte;
end;
//************寫頁命令格式**************
{發送格式 命令號 := 0X10}
TWriteCard = packed Record
Sendpc : byte;
Recpc : byte;
mlh : byte;
card_k : Smallint;
card_y : byte;
momedata: array [0..8] of byte;
Rec : byte;
end;
{回應格式}
TRe_WriteCard = packed Record
Recpc : byte;
mlh : byte;
card_k : Smallint;
card_y : byte;
momedata: array [0..9] of byte;
Rec : byte;
end;
//***************執行讀頁命令************
{發送格式 命令號 := 0x11}
TReadCard = packed Record
Sendpc : byte;
Recpc : byte;
mlh : byte;
card_k : Smallint;
card_y : byte;
momedata: array [0..8] of byte;
Rec : byte;
end;
{接受格式}
TRe_ReadCard = packed Record
Recpc : byte;
mlh : byte;
card_k : Smallint;
card_y : byte;
momedata: array [0..9] of byte;
Rec : byte;
end;
//***************擦出指定塊**********
{發送格式 命令號 :=0x12}
TEarseCard = packed Record
Sendpc : byte;
Recpc : byte;
mlh : byte;
card_k : Smallint;
momedata: array [0..9] of byte;
Rec : byte;
end;
TRe_EarseCard = packed Record
Recpc : byte;
mlh : byte;
card_k : Smallint;
momedata: array [0..10] of byte;
Rec : byte;
end;
//**************停止語音輸出************
{發送格式 命令號 := 0x13}
TStopSound = packed Record
Sendpc : byte;
Recpc : byte;
mlh : byte;
momedata: array [0..11] of byte;
Rec : byte;
end;
TRe_StopSound = packed Record
Recpc : byte;
mlh : byte;
momedata: array [0..12] of byte;
Rec : byte;
end;
//**************啟動語音輸出************
{發送格式 命令號 := 0x13}
TopenSound = packed Record
Sendpc : byte;
Recpc : byte;
mlh : byte;
momedata: array [0..11] of byte;
Rec : byte;
end;
TRe_openSound = packed Record
Recpc : byte;
mlh : byte;
momedata: array [0..12] of byte;
Rec : byte;
end;
TForm1 = class(TForm)
Panel1: TPanel;
ComLed1: TComLed;
ComLed2: TComLed;
ComLed3: TComLed;
ComLed4: TComLed;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
ComLed5: TComLed;
ComLed6: TComLed;
Label1: TLabel;
Label6: TLabel;
ComLed7: TComLed;
Label7: TLabel;
Memo1: TMemo;
ComPort: TComPort;
sbtn_open: TSpeedButton;
sbtn_seting: TSpeedButton;
sbtn_selectFile: TSpeedButton;
sbtn_send: TSpeedButton;
OpenDialog1: TOpenDialog;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
procedure sbtn_setingClick(Sender: TObject);
procedure sbtn_openClick(Sender: TObject);
procedure sbtn_selectFileClick(Sender: TObject);
procedure ComPortAfterClose(Sender: TObject);
procedure ComPortAfterOpen(Sender: TObject);
procedure sbtn_sendClick(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure ComPortRxChar(Sender: TObject; Count: Integer);
procedure SpeedButton4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
hevent : THandle;
sendtype : integer; //0:語音數據；1:寫卡指令；2:讀卡指令；3:擦卡指令；4:停止放音；5:開始放音
datasend : Tdatasend;
dataRec,DataRec_bak : TDataRec;
WriteCard : TWriteCard;
Re_writeCard,Re_writeCard_bak : TRe_WriteCard;
ReadCard : TReadCard;
Re_ReadCard,Re_ReadCard_Bak : TRe_ReadCard;
EarseCard : TEarseCard;
Re_Earsecard ,Re_Earsecard_bak : TRe_EarseCard;
stopsound : TStopSound;
Re_stopsound,Re_stopsound_Bak : TRe_StopSound;
Opnesound : TopenSound;
Re_opensound,Re_opensound_Bak : TRe_openSound;
isbuscc : boolean;
WavFileName : string;
procedure GetCOMName(Sender : TCombobox);
procedure SendData(pFileName : string);
function GetDatasend(pMlh : byte; pdata : TparaArray) : Tdatasend;
function GetWritecard(pcard_k : smallint; pcard_y : byte) : TWriteCard;
function GetReadcard(pcard_k : smallint; pcard_y : byte) : TReadCard;
function GetEarsecard(pcard_k : smallint) : TEarseCard;
function Getstopsound : TStopSound;
function Getopensound : TopenSound;
function GetdataRec(pMlh : byte; pdata : TparaArray) : TdataRec;
function GetRe_Writecard(pcard_k : smallint; pcard_y : byte) : TRe_WriteCard;
function GetRe_Readcard(pcard_k : smallint; pcard_y : byte) : TRe_ReadCard;
function GetRe_Earsecard(pcard_k : smallint) : TRe_EarseCard;
function GetRe_stopsound : TRe_StopSound;
function GetRe_opensound : TRe_openSound;
function CompareDataRec(DataRec1,DataRec2 : TdataRec) : Boolean;
function CompareRe_writecard(DataRec1,DataRec2 : TRe_WriteCard) : Boolean;
function CompareRe_ReadCard(DataRec1,DataRec2 : TRe_ReadCard) : Boolean;
function compareRe_Earsecard(DataRec1,DataRec2 : TRe_EarseCard) : Boolean;
function CompareRe_stopsound(DataRec1,DataRec2 : TRe_StopSound) : Boolean;
function CompareRe_opensound(DataRec1,DataRec2 : TRe_openSound) : Boolean;
end;
var
Form1: TForm1;
implementation
uses ucomThread;
{$R *.dfm}
{ TForm1 }
procedure TForm1.GetCOMName(Sender: TCombobox);
var
Registry: TRegistry;
Value:TRegKeyInfo;
i:integer;
List:TStringList;
begin
//在注冊表中查找可用串口
Sender.Items.Clear; //清空選擇項
try
Registry:=TRegistry.Create; //創建注冊表
try
List:=TStringList.Create; //創建字符串列表,裝入注冊表的鍵名
Registry.RootKey:=HKEY_LOCAL_MACHINE;
//如果打開成功
if Registry.OpenKey('\HardWare\DeviceMap\SerialComm',False) then
begin
Registry.GetKeyInfo(Value); //得到鍵數量
Registry.GetValueNames(List); //得到鍵名
for i:=0 to Value.NumValues-1 do
begin
//加入選擇項
Sender.items.Add(Registry.ReadString(List.Strings[i]));
end;
end;
finally
List.Free;
end;
finally
Registry.Free;
end;
end;
procedure TForm1.sbtn_setingClick(Sender: TObject);
begin
ComPort.ShowSetupDialog;
end;
procedure TForm1.sbtn_openClick(Sender: TObject);
begin
try
if ComPort.Connected then
begin
ComPort.Close ;
Memo1.Lines.Add('串口已關閉！');
end
else
begin
ComPort.Open;
Memo1.Lines.Add('串口已打開！');
end;
except
Memo1.Lines.Add('串口操作失敗！');
MessageBox(Application.Handle,pchar('端口打開失??！'),pchar('信息提示'),MB_OK);
end;
end;
procedure TForm1.sbtn_selectFileClick(Sender: TObject);
begin
if opendialog1.Execute then
WavFileName := OpenDialog1.FileName;
sbtn_send.Enabled := True;
end;
procedure TForm1.SendData(pFileName: string);
var wavFile : TFileStream;
wavLen : integer;
stempstr : string[4];
swavLen : array [0..3] of byte;
sendnum,EndNum,cardy_num ,i, sendID : integer;
cardk_num : Word;
sdata : TparaArray;
stemp1 : TdataRec;
stemp2 : TdataRec;
begin
cardk_num :=0;
stopsound := Getstopsound;
Re_stopsound_Bak := GetRe_stopsound;
sendtype := 4;
isbuscc := False;
ComPort.Write(stopsound,16);
resetevent(hevent);
if WaitForSingleObject(hevent,1000) = WAIT_TIMEOUT then
begin
Re_stopsound := Re_stopsound_Bak;
memo1.Lines.Add('接收超時,重新發送');
ComPort.Write(stopsound,16);
if WaitForSingleObject(hevent,1000) = WAIT_TIMEOUT then
begin
memo1.Lines.Add('接收超時,重新發送');
ComPort.Write(stopsound,16);
end;
end;
EarseCard := GetEarsecard(cardK_num);
Re_Earsecard_bak := GetRe_Earsecard(cardk_num);
sendtype := 3;
isbuscc := False;
ComPort.Write(Earsecard,16);
ResetEvent(hevent);
if WaitForSingleObject(hevent,1000) = WAIT_TIMEOUT then
begin
Re_Earsecard := Re_Earsecard_bak;
memo1.Lines.Add('接收擦卡超時,重新發送');
ComPort.Write(Earsecard,16);
ResetEvent(hevent);
if WaitForSingleObject(hevent,1000) = WAIT_TIMEOUT then
begin
memo1.Lines.Add('接收擦卡超時,重新發送');
ComPort.Write(Earsecard,16);
end;
end;
memo1.Lines.Add('開始發送語音文件......');
sendnum :=0;
endnum := 0;
cardy_num := 0;
sendID := 0;
wavLen := 0 ;
stempstr := '';
wavFile := TFileStream.Create(pFileName,fmopenRead);
wavLen := wavFile.Size -44;
wavFile.Position :=45 ;
EndNum := wavLen mod 8 ;
if EndNum = 0 then sendnum := wavlen div 8 else sendnum := wavlen div 8 + 1;
for i := 0 to sendnum - 1 do
begin
if (EndNum <> 0) and (i = sendnum - 1 )then
begin
wavFile.Read(sData,EndNum);
DataSend := GetDatasend(sendID,sdata);
DataRec_Bak := getDataRec(SendID,sData);
sendtype := 0;
ComPort.Write(DataSend,16);
{resetevent(hevent);
if WaitForSingleObject(hevent,500) = WAIT_TIMEOUT then
begin
stemp1 := DataRec_bak;
stemp2 := dataRec;
memo1.Lines.Add('接收超時,重新發送');
ComPort.Write(DataSend,16);
resetevent(hevent);
if WaitForSingleObject(hevent,500) = WAIT_TIMEOUT then
begin
stemp1 := DataRec_bak;
stemp2 := dataRec;
memo1.Lines.Add('接收超時,重新發送');
ComPort.Write(DataSend,16);
end;
end; }
WriteCard := GetWritecard(cardK_num,cardy_num);
Re_writeCard_bak := GetRe_Writecard(cardk_num,cardy_num);
sendtype := 1;
isbuscc := False;
comport.Write(writecard,16);
{ resetevent(hevent);
if WaitForSingleObject(hevent,1000) = WAIT_TIMEOUT then
begin
Re_writeCard := Re_writeCard_bak;
memo1.Lines.Add('接收超時,重新發送');
ComPort.Write(writecard,16);
resetevent(hevent);
if WaitForSingleObject(hevent,1000) = WAIT_TIMEOUT then
begin
memo1.Lines.Add('接收超時,重新發送');
ComPort.Write(writecard,16);
end;
end; }
Break;
end
else WavFile.Read(Sdata,8);
DataSend := GetDatasend(sendID,sdata);
DataRec_Bak := getDataRec(SendID,sData);
sendtype := 0;
ComPort.Write(DataSend,16);
{ resetevent(hevent);
if WaitForSingleObject(hevent,500) = WAIT_TIMEOUT then
begin
stemp1 := DataRec_bak;
stemp2 := dataRec;
memo1.Lines.Add('接收超時,重新發送');
ComPort.Write(DataSend,16);
resetevent(hevent);
if WaitForSingleObject(hevent,500) = WAIT_TIMEOUT then
begin
stemp1 := DataRec_bak;
stemp2 := dataRec;
memo1.Lines.Add('接收超時,重新發送');
ComPort.Write(DataSend,16);
end;
end; }
if sendID = 15 then
begin
WriteCard := GetWritecard(cardK_num,cardy_num);
Re_writeCard_bak := GetRe_Writecard(cardk_num,cardy_num);
sendtype := 1;
isbuscc := False;
comport.Write(writecard,16);
resetevent(hevent);
if WaitForSingleObject(hevent,1000) = WAIT_TIMEOUT then
begin
memo1.Lines.Add('接收寫卡超時,重新發送'+inttostr(cardK_num)+'--'+inttostr(cardy_num));
Re_writeCard := Re_writeCard_bak;
ComPort.Write(writecard,16);
resetevent(hevent);
if WaitForSingleObject(hevent,1000) = WAIT_TIMEOUT then
begin
memo1.Lines.Add('接收寫卡超時,重新發送'+inttostr(cardK_num)+'--'+inttostr(cardy_num));
ComPort.Write(writecard,16);
end;
end;
SendID := 0;
if cardy_num = 31 then
begin
cardy_num := 0;
inc(cardK_num,1);
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -