comsys.pas

用C++ vc编程的串口通讯软件和源代码

unit ComSys;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, ComDrv32, StdCtrls, ExtCtrls, ActnList, ComCtrls,
  FileCtrl, Setup, RzFilSys, AppEvnts, ZlibEx, Sockets;

type
  TfrmComSys = class(TForm)
    comFile: TCommPortDriver;
    ActionList1: TActionList;
    Label1: TLabel;
    actReceiveFile: TAction;
    actSendFile: TAction;
    Label2: TLabel;
    lblFileName: TLabel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    edFileName: TEdit;
    Panel1: TPanel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Image1: TImage;
    SpeedButton1: TSpeedButton;
    ProgressSend: TProgressBar;
    SpeedButton2: TSpeedButton;
    actSetup: TAction;
    flbDataFile: TRzFileListBox;
    actSelFile: TAction;
    SpeedButton3: TSpeedButton;
    actRefreshListFile: TAction;
    ApplicationEvents1: TApplicationEvents;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    actOpenCom: TAction;
    actCloseCom: TAction;
    TimerOut: TTimer;
    SpeedButton6: TSpeedButton;
    actCancelSend: TAction;
    mmInfo: TMemo;
    tcpOrderClient: TTcpClient;
    procedure actSetupExecute(Sender: TObject);
    procedure actSelFileExecute(Sender: TObject);
    procedure actRefreshListFileExecute(Sender: TObject);
    procedure actSendFileExecute(Sender: TObject);
    procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
    procedure actCloseComExecute(Sender: TObject);
    procedure actOpenComExecute(Sender: TObject);
    procedure comFileReceiveData(Sender: TObject; DataPtr: Pointer;
      DataSize: Integer);
    procedure TimerOutTimer(Sender: TObject);
    procedure actCancelSendExecute(Sender: TObject);
  private
    FSetupValue: TSetupValue;   //设置串口属性的数据类型
    FDataPath: string;        //放文件的目录

    FFileSign: Byte;     //发送一个文件时候的随机数字标识，用来接收方判别用
    FSendFinished: Boolean;   //发送某一个文件是否已经完成
    FSendFileName: string;      //发送文件的文件名数据
    FSendFileData: TStrings;    //发送文件的缓冲区,最多2M

    FReceiveData: string;   //接收缓冲区
    FTimeOutFlag: Boolean;  //超时判断
    FWaitRetTime: Integer;    //用于判断命令已经发送时间的临时变量
    FRecentData: string;    //最近发送的一次数据

    FReceiveStream: TFileStream;
    FReceiveFileName: string;

    DeCompressionStream: TZDecompressionStream;   //用于压缩解压
    CompressionStream: TZCompressionStream;   //用于压缩解压

    function OpenCom: Boolean;
    procedure CloseCom;

    procedure SendFile(AFile: string);    //发送文件函数
    procedure Progress(APos: Integer);     //控制进度条位置
    procedure FiltCommData;   //分析接收到得数据

    //==================================================================
    //对方已经准备接收新文件，开始发送文件数据，
    procedure RetCanReceiveFile(AData: string);
    //对方已经接收了数据,继续发送文件数据或发送完毕信息
    procedure RetSendFileData(AData: string);
    //对方已经接收和保存了文件，一个文件发送结束，一切置为未开始
    procedure RetFinishSendFile(AData: string);
    //==================================================================
    //对方发送新文件，准备接收和发馈信息
    procedure RetPrepareSendFile(AData: string);
    //对方已经发送了数据,继续发送文件数据或发送完毕信息
    procedure RetHadReceiveData(AData: string);
    //对方发送一个文件发送结束信息，保存文件，等待下一个接收
    procedure RetHadSaveFile(AData: string);
    //==================================================================
    procedure SendFileData;   //发送文件数据
    procedure SendCanSendFile;    //发送信息，说明准备完毕
    procedure SendHadReceiveData(FPos: Int64);   //发送信息，说明已经接收数据完毕
    procedure SendHadSaveFile;    //发送信息，说明已经保存了接收的文件
  public
    procedure AddMsg(AMsg: string);

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

var
  frmComSys: TfrmComSys;

implementation

uses send, hexconv;

{$R *.dfm}

{ TfrmComSys }

procedure TfrmComSys.AddMsg(AMsg: string);
var
  NowTime: string;
begin
  NowTime := '[' + FormatDateTime('hh:mm.ss.zzz', Now) + ']';

  mmInfo.Lines.Insert(0, NowTime + AMsg);
end;

procedure TfrmComSys.actSetupExecute(Sender: TObject);
var
  TmpValue: TSetupValue;
begin
  if TfrmSetup.Setup(TmpValue) then
  begin
    FSetupValue := TmpValue;
    if comFile.Connected then
      OpenCom;
  end;
end;

constructor TfrmComSys.Create(AOwner: TComponent);
begin
  inherited;
  TimerOut.Enabled := false;
  edFileName.Text := '';
  mmInfo.Lines.Clear;
  FSendFinished := true;

  FDataPath := ExtractFilePath(Application.ExeName) + 'DATA\';
  flbDataFile.Clear;
  if False = DirectoryExists(FDataPath) then
  begin
    AddMsg('没有发现系统目录：..\DATA,将创建该目录');
    CreateDir(FDataPath);
  end;
  flbDataFile.Directory := FDataPath;

  FSetupValue := TfrmSetup.GetSetupValue;
  if FSetupValue.AutoOpenComFlag then
    OpenCom;

  FSendFileData := TStringList.Create;
  ProgressSend.Min := 0;
  ProgressSend.Max := 100;

  if false = FSetupValue.SendFlag then
  begin
    actSendFile.Enabled := false;
    actCancelSend.Enabled := false;

    lblFileName.Caption := '要接收的文件：';

    WindowState := wsMinimized;     //接收程序启动就最小化
  end
  else begin
    lblFileName.Caption := '要发送的文件：';
  end;

  tcpOrderClient.Active := false;
end;

procedure TfrmComSys.CloseCom;
begin
  if comFile.Connected then
  begin
    AddMsg('正在关闭串口,请稍候...');
    comFile.Disconnect;
    AddMsg('串口已经被关闭');
    TimerOut.Enabled := false;
    FSendFinished := true;    //串口关闭，该发送完成标志设置为true
    if FReceiveStream <> NIL then
      FreeAndNil(FReceiveStream);
  end;
end;

function TfrmComSys.OpenCom: Boolean;
begin
  CloseCom;
  AddMsg('正在打开串口,请稍候...');
  comFile.ComPortInBufSize := COM_IN_BUF_SIZE;
  comFile.ComPortOutBufSize := COM_OUT_BUF_SIZE;
  comFile.ComPortHwHandshaking := hhNone;//hhRTSCTS;      //设置为硬件控制
  comFile.ComPortParity := ptNONE;
  comFile.ComPortPollingDelay := COM_PORT_POLLING_DELAY;
  comFile.ComPortSwHandshaking := shNONE;
  comFile.EnableDTROnOpen := true;
  comFile.OutputTimeout := OUTPUT_TIME_OUT;

  case FSetupValue.PortIndex of
    0: comFile.ComPort := pnCOM1;
    1: comFile.ComPort := pnCOM2;
    2: comFile.ComPort := pnCOM3;
    3: comFile.ComPort := pnCOM4;
  end;
  case FSetupValue.SpeedIndex of
    0: comFile.ComPortSpeed := br9600;
    1: comFile.ComPortSpeed := br4800;
    2: comFile.ComPortSpeed := br2400;
    3: comFile.ComPortSpeed := br1200;
    4: comFile.ComPortSpeed := br600;
    5: comFile.ComPortSpeed := br300;
    6: comFile.ComPortSpeed := br110;
  end;
  case FSetupValue.DataIndex of
    0: comFile.ComPortDataBits := db5BITS;
    1: comFile.ComPortDataBits := db6BITS;
    2: comFile.ComPortDataBits := db7BITS;
    3: comFile.ComPortDataBits := db8BITS;
  end;
  case FSetupValue.StopIndex of
    0: comFile.ComPortStopBits := sb1BITS;
    1: comFile.ComPortStopBits := sb1HALFBITS;
    2: comFile.ComPortStopBits := sb2BITS;
  end;
  Result := comFile.Connect;

  if Result then
    AddMsg('串口已经被打开')
  else
    AddMsg('打开串口错误,无法发送和接收文件');  
end;

procedure TfrmComSys.actSelFileExecute(Sender: TObject);
begin
  if FSetupValue.SendFlag then
  begin
    if Trim(flbDataFile.FileName) <> '' then
      edFileName.Text := flbDataFile.FileName;
  end;
end;

procedure TfrmComSys.actRefreshListFileExecute(Sender: TObject);
begin
  flbDataFile.Directory := '';
  flbDataFile.Directory := FDataPath;
  flbDataFile.Update;
end;

procedure TfrmComSys.actSendFileExecute(Sender: TObject);
begin
  SendFile(edFileName.Text);
end;

procedure TfrmComSys.ApplicationEvents1Exception(Sender: TObject;
  E: Exception);
begin
  AddMsg('未知错误：' + E.Message);
end;

procedure TfrmComSys.actCloseComExecute(Sender: TObject);
begin
  CloseCom;
end;

procedure TfrmComSys.actOpenComExecute(Sender: TObject);
begin
  OpenCom;
end;

procedure TfrmComSys.SendFile(AFile: string);
var
  SourceStream, SendStream: TFileStream;
  i, j, packagenum: Integer;
  ReadCount, bufpos, len: Int64;
  FName, BufStr, TmpPath: string;
  buf: array[1..999] of char;    //这个数组的上限要>=Send单元定义的FILE_PACKAGE_SIZE
begin
  TmpPath := ExtractFilePath(Application.ExeName);

  if FSendFinished = false then
  begin
    AddMsg('正在发送文件，请稍后发送');
    Exit;
  end;
  if comFile.Connected = false then
  begin
    AddMsg('串口没有被打开，无法发送');
    Exit;
  end;
  if FileExists(AFile) = false then
  begin
    AddMsg('文件不存在，无法发送');
    Exit;
  end;
  FName := ExtractFileName(AFile);
  if Length(FName) > FIFLE_TITLE_LEN then    //如果文件名称太长,无法发送
  begin
    AddMsg('文件名太长，无法发送');
    Exit;
  end;

  SendStream := TFileStream.Create(TmpPath + TMP_FILE_NAME, fmCreate or fmOpenWrite);
  try
    SourceStream := TFileStream.Create(AFile, fmOpenRead);
    try
      CompressionStream := TZCompressionStream.Create(SendStream, COMPRESS_LEVEL);
      try
        AddMsg('开始压缩文件,请稍后...');
        CompressionStream.CopyFrom(SourceStream, SourceStream.Size);
      finally
        CompressionStream.Free;     //只有在这条语句执行完毕后，OutputStream中流才是被压缩过的
        AddMsg('压缩文件完毕');
      end;
    finally
      FreeAndNil(SourceStream);
    end;

    len := SendStream.Size;
    if len > MAX_FILE_SIZE then
    begin
      AddMsg('压缩后的文件尺寸吵过' + IntToStr(MAX_FILE_SIZE div 1024) +'K，无法发送');
      Exit;
    end;

    mmInfo.Lines.Clear;

    FWaitRetTime := 0;
    TimerOut.Enabled := false;    //发了数据以后采置为true

    Randomize;
    FFileSign := random(255);
    FSendFileName := TProtocol.ProtocolPrepareSend(FFileSign, FName, SendStream.Size);

    FSendFileData.Clear;
    packagenum := Integer(len div FILE_PACKAGE_SIZE);   //一共需要的文件包数量
    if (len mod Int64(FILE_PACKAGE_SIZE)) <> 0 then
      Inc(packagenum);
    for i := 1 to packagenum do
    begin
      bufpos := Int64((i-1) * FILE_PACKAGE_SIZE);
      SendStream.Seek(bufpos, soFromBeginning);
      ReadCount := SendStream.Read(buf, FILE_PACKAGE_SIZE);

      BufStr := '';
      for j := 1 to ReadCount do
        BufStr := BufStr + buf[j];

      FSendFileData.Add(TProtocol.ProtocolSendData(FFileSign, bufpos, BufStr));
    end;
    FSendFinished := false;     //准备开始发送,标志位置为False;
    FTimeOutFlag := false;      //开始进入超时判断
    FReceiveData := '';

    ProgressSend.Max := packagenum;
    if packagenum <= 0 then
      ProgressSend.Max := 1;
    Progress(0);

    TProtocol.SendComData(comFile, FSendFileName, FRecentData, TimerOut,
      FTimeOutFlag, FWaitRetTime);
  finally
    FreeAndNil(SendStream);
  end;
end;

destructor TfrmComSys.Destroy;
begin
  FSendFileData.Free;
  if FReceiveStream <> NIL then