main.~pas

一个通过串口读写WAV语音文件的的小程序

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 := 255;
    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);