comsys.pas

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

    FreeAndNil(FReceiveStream);
  inherited;
end;

procedure TfrmComSys.Progress(APos: Integer);
begin
  ProgressSend.Position := APos;
end;

procedure TfrmComSys.comFileReceiveData(Sender: TObject; DataPtr: Pointer;
  DataSize: Integer);
var
  Buf:array[1..9999] of char;
  Bytes, i:Integer;
begin
  Bytes := DataSize;
  Move(DataPtr^, buf, bytes);

  for i := 1 to Bytes do
    FReceiveData := FReceiveData + buf[i];

  FiltCommData;   //处理信息
end;

procedure TfrmComSys.FiltCommData;
var
  dispstr:string;
  filtret:Boolean;      //检测7F是否出现的检索结果
  tmpstr,tmpstr2:string;
  i,Bytes,P:integer;
begin
  filtret := false;
  Bytes := Length(FReceiveData);

  if Bytes >= MAX_COMM_STRING then
    Delete(FReceiveData,1,Bytes);

  P :=0;
  for i := 1 to bytes do
  if Byte(FReceiveData[i])=$7F then  //$7F为命令结束符
  begin
    P := i;
    filtret := true;
    break;
  end;
  if false = filtret then    //没有7F字符，退出
    exit;

  tmpstr := Copy(FReceiveData, 1, p);   //取出一帧
  Delete(FReceiveData, 1, P);      //从ReceiveBuf第一个开始，删除P个字符

  if DEBUG_MODE then
  begin
    dispstr := '';
    for i:=1 to (Length(tmpstr)) do
      dispstr := dispstr + Format('%.2x',[Byte(tmpstr[i])])+' ';
    AddMsg('接收未解析数据：' + dispstr);
  end;

  tmpstr2 := DataRevert(tmpstr);    //取出真正的数据
  if tmpstr2='' then    //处理数据帧错误，可能是接收了错误的数据帧
  begin
    if DEBUG_MODE then
      AddMsg('解析数据失败');
    exit;
  end;

  if Length(tmpstr2)<2 then     //如果少于二位，肯定是错误的帧
    exit;

  if DEBUG_MODE then    //调试状态,显示接收的串口数据
  begin
    dispstr := '';
    for i:=1 to (Length(tmpstr)) do
      dispstr := dispstr + Format('%.2x',[Byte(tmpstr[i])])+' ';
    AddMsg('接收数据：' + dispstr);
  end;

  //以下开始分析数据
  case Integer(tmpstr2[1]) of    //根据命令字节判断
    P_PREPARE_SEND_FILE:  RetPrepareSendFile(tmpstr2);  //发送方->接收方：开始准备发送一个新文件
    P_SEND_FILE_DATA:     RetSendFileData(tmpstr2);     //发送方->接收方：发送的文件的数据
    P_FINISHED_SEND_FILE: RetFinishSendFile(tmpstr2);   //发送方->接收方：当前文件已经发送完毕

    P_CAN_SEND_NEW_FILE:  RetCanReceiveFile(tmpstr2);   //接收方->发送方：可以接收新文件，准备发送数据
    P_RECEIVED_FILE_DATA: RetHadReceiveData(tmpstr2);   //接收方->发送方：可以发送数据，继续发送数据或者发送完毕
    P_HAD_SAVED_FILE:     RetHadSaveFile(tmpstr2);      //接收方->发送方：已经保存文件，文件发送结束
  end;
end;

procedure TfrmComSys.TimerOutTimer(Sender: TObject);
var
  TmpData: string;
begin
  if FSendFinished = true then    //已经发送完成
  begin
    TimerOut.Enabled := false;
    Exit;
  end;
  if FTimeOutFlag = true then   //说明系统已经收到回复，没有超时
    Exit;
  if FWaitRetTime > FSetupValue.TimeOut then    //超时,重新发送
  begin
    AddMsg('系统超时，没有收到反馈信息，正在重发');
    TProtocol.SendComData(comFile, FRecentData, TmpData, TimerOut,
      FTimeOutFlag, FWaitRetTime);   //因为这里不需要返回FRecentData ，所以放个临时数据TmpData
    FWaitRetTime := 0;
  end;
  FWaitRetTime := FWaitRetTime + Integer(TimerOut.Interval);
end;

procedure TfrmComSys.RetCanReceiveFile(AData: string);
var
  FSign: Byte;
begin
  if FSendFinished then Exit;    //如果文件是已经发送完毕的，不处理接收数据

  if Length(AData) < 2 then Exit;   //错误的协议

  FSign := Byte(AData[2]);
  if FSign <> FFileSign then Exit;   //如果文件随机码不对，忽略

  FTimeOutFlag := true;      //说明已经收到信息了，超时Timer要作处理

  SendFileData;
end;

procedure TfrmComSys.RetSendFileData(AData: string);
var
  FPos: Int64;
  FSign: Byte;
  FData: string;
  buf: array[1..999] of char;
  bufcount, i: Integer;
begin
  if Length(AData) < 6 then Exit;   //错误的协议

  FSign := Byte(AData[2]);
  if FSign <> FFileSign then Exit;   //如果文件随机码不对，忽略

  FPos := Byte(AData[3]) * 256 * 256 * 256 +
          Byte(AData[4]) * 256 * 256 +
          Byte(AData[5]) * 256 +
          Byte(AData[6]);
  FData := Copy(AData, 7, Length(AData) - 6);

  if FReceiveStream = NIL then Exit;   //如果文件没有被打开，忽略
  try
    FReceiveStream.Seek(FPos, soFromBeginning);
    bufcount := Length(FData);
    for i := 1 to bufcount do
      buf[i] := FData[i];
    FReceiveStream.Write(buf, bufcount);
  except
    if FReceiveStream <> NIL then
      FreeAndNil(FReceiveStream);
    AddMsg('写入文件错误，无法接收，按错误协议处理');
    Exit;
  end;

  Progress(FPos);

  FTimeOutFlag := true;      //说明已经收到信息了，超时Timer要作处理

  SendHadReceiveData(FPos);
end;

procedure TfrmComSys.RetFinishSendFile(AData: string);
var
  FSign: Byte;
  SaveStream: TFileStream;
  SendBuf: string;
  i: Integer;
begin
  if Length(AData) < 2 then Exit;   //错误的协议

  FSign := Byte(AData[2]);
  if FSign <> FFileSign then Exit;   //如果文件随机码不对，忽略

  tcpOrderClient.Active := false;
  tcpOrderClient.RemoteHost := SOCKET_ORDER_SERVER;
  tcpOrderClient.RemotePort := SOCKET_ORDER_PORT;
  tcpOrderClient.Active := true;
  SendBuf := SOCKET_ORDER_HEAD + SOCKET_ORDER_STOP;
  if tcpOrderClient.Active then
  begin
    tcpOrderClient.SendBuf(SendBuf, Length(SOCKET_ORDER_HEAD));
    for i := 1 to 10 * 2 do    //暂停2秒钟,等待播放器关闭
    begin
      sleep(100);
      Application.ProcessMessages;
    end;
  end
  else
    AddMsg('可能没有打开播放系统,找不到命令服务器.,无法发送取消文件锁定命令.');

  SaveStream := TFileStream.Create(FReceiveFileName, fmCreate or fmOpenWrite);
  try
    AddMsg('开始解压缩文件,请稍后...');
    DecompressionStream := TZDecompressionStream.Create(FReceiveStream);
    try
      SaveStream.CopyFrom(DecompressionStream, 0);
    finally
      DecompressionStream.Free;
    end;
  finally
    FreeAndNil(SaveStream);
  end;
  AddMsg('解压缩文件完成');

  SendBuf := SOCKET_ORDER_HEAD + SOCKET_ORDER_RESUME;
  if tcpOrderClient.Active then
    tcpOrderClient.SendBuf(SendBuf, Length(SOCKET_ORDER_HEAD));

  if FReceiveStream <> NIL then      //如果临时文件是被打开得，关闭
    FreeAndNil(FReceiveStream);

  Progress(ProgressSend.Max);

  actRefreshListFileExecute(Nil);

  SendHadSaveFile;
end;

procedure TfrmComSys.RetPrepareSendFile(AData: string);
var
  FSize: Int64;
  AppPath, FFile: string;
begin
  AppPath := ExtractFilePath(Application.ExeName);

  if Length(AData) < 6 then Exit;   //错误的协议

  if FReceiveStream <> NIL then
    FreeAndNil(FReceiveStream);

  FFileSign := Byte(AData[2]);
  FSize := Byte(AData[3]) * 256 * 256 * 256 +
           Byte(AData[4]) * 256 * 256 +
           Byte(AData[5]) * 256 +
           Byte(AData[6]);
  FFile := Copy(AData, 7, Length(AData) - 6);
  FReceiveFileName :=FFile;

  ProgressSend.Max := FSize;
  Progress(0);
  edFileName.Text := FFile;
  mmInfo.Lines.Clear;

  try
    FReceiveStream := TFileStream.Create(AppPath + TMP_FILE_NAME, fmCreate or fmOpenWrite);
  except
    if FReceiveStream <> NIL then
      FreeAndNil(FReceiveStream);
    AddMsg('接收缓冲文件：' + FFile + '已经被锁定，请重新启动软件');
    Exit;
  end;
  FReceiveStream.Size := FSize;

  FTimeOutFlag := true;      //说明已经收到信息了，超时Timer要作处理

  SendCanSendFile;
end;

procedure TfrmComSys.RetHadReceiveData(AData: string);
var
  i: Integer;
  FSign: Byte;
  FRetAddr, FRecentAddr: Int64;
begin
  if FSendFinished then Exit;    //如果文件是已经发送完毕的，不处理接收数据

  if Length(AData) < 6 then Exit;   //错误的协议
  FRetAddr := Byte(AData[3]) * 256 * 256 * 256 +
             Byte(AData[4]) * 256 * 256 +
             Byte(AData[5]) * 256 +
             Byte(AData[6]);

  FSign := Byte(AData[2]);
  if FSign <> FFileSign then Exit;   //如果文件随机码不对，忽略

  if Length(FRecentData) < 6 then Exit;    //发送的协议和返回的协议不合，忽略
  FRecentAddr := Byte(FRecentData[3]) * 256 * 256 * 256 +
                 Byte(FRecentData[4]) * 256 * 256 +
                 Byte(FRecentData[5]) * 256 +
                 Byte(FRecentData[6]);
  if FRetAddr <= FRecentAddr then   //如果返回的地址比当前的地址小，说明是合法协议
  begin
    FTimeOutFlag := true;      //说明已经收到信息了，超时Timer要作处理

    //===============================================================
    //去掉已经发送的数据
    for i := 1 to FSendFileData.Count - 1 do
      FSendFileData.Strings[i-1] := FSendFileData.Strings[i];
    FSendFileData.Delete(FSendFileData.Count - 1);
    //===============================================================

    SendFileData;
  end;
end;

procedure TfrmComSys.RetHadSaveFile(AData: string);
var
  FSign: Byte;
begin
  if FSendFinished then Exit;    //如果文件是已经发送完毕的，不处理接收数据

  if Length(AData) < 2 then Exit;   //错误的协议

  FSign := Byte(AData[2]);
  if FSign <> FFileSign then Exit;   //如果文件随机码不对，忽略

  Progress(ProgressSend.Max);
  FTimeOutFlag := true;      //说明已经收到信息了，超时Timer要作处理
  FSendFinished := true;     //发送文件完毕标志置为true，表明完成
  AddMsg('发送文件完毕，接收方已经保存文件');
end;

procedure TfrmComSys.SendFileData;
var
  count: Integer;
  TmpData: string;
begin
  count := FSendFileData.Count;
  Progress(ProgressSend.Max - count);
  if count > 0 then   //还存在数据，继续发送数据
    TProtocol.SendComData(comFile, FSendFileData.Strings[0], FRecentData, TimerOut,
      FTimeOutFlag, FWaitRetTime)
  else begin    //发送文件发送完毕信息给接收方
    TmpData := Char(P_FINISHED_SEND_FILE) + Char(FFileSign);
    TProtocol.SendComData(comFile, TmpData, FRecentData, TimerOut,
      FTimeOutFlag, FWaitRetTime);
  end;
end;

procedure TfrmComSys.SendCanSendFile;
var
  TmpData: string;
begin
  TmpData := Char(P_CAN_SEND_NEW_FILE) + Char(FFileSign);
  TProtocol.SendComData(comFile, TmpData, FRecentData, TimerOut,
    FTimeOutFlag, FWaitRetTime);
end;

procedure TfrmComSys.SendHadReceiveData(FPos: Int64);
var
  TmpData: string;
begin
  TmpData := Char(P_RECEIVED_FILE_DATA) + Char(FFileSign) +
    TProtocol.Int64ConvertChar4(FPos);
  TProtocol.SendComData(comFile, TmpData, FRecentData, TimerOut,
    FTimeOutFlag, FWaitRetTime);
end;

procedure TfrmComSys.SendHadSaveFile;
var
  TmpData: string;
  TmpFlag: Boolean;
begin
  TmpData := Char(P_HAD_SAVED_FILE) + Char(FFileSign);
  FTimeOutFlag := true;     //不需要返回，因此置为true，不会产生超时现象
  TProtocol.SendComData(comFile, TmpData, FRecentData, TimerOut,
    TmpFlag, FWaitRetTime);
  AddMsg('接收文件完毕，文件已经保存');
end;

procedure TfrmComSys.actCancelSendExecute(Sender: TObject);
begin
  if false = FSendFinished then   //如果还在发送文件
  begin
    TimerOut.Enabled := false;
    FSendFinished := true;
    AddMsg('已经取消发送文件:' + edFileName.Text);
  end;
end;

end.