unit uMsgRevcSend; {$mode objfpc}{$H+} interface uses Classes, SysUtils, IdTCPClient, uParamConfig, uDevProtocol, ExtCtrls, uInputBusineParam, uConst; type TTaskParse = class; { TMsgSendMg } TMsgSendMg = class(TThread) private FSendTcp: TIdTCPClient; FCfgObj: TConfigData; FBreakFlag: boolean; FTask: TTaskParse; FHost: string; FPort: integer; procedure ReadData; procedure CfgAssign(cd: TConfigData); procedure ReConnect; public constructor Create(CreateSuspended: Boolean; PcdAddr: Pointer); destructor Destroy; override; procedure Execute; override; //连接中心 function Connect: boolean; function DisConn: boolean; procedure Send(sCmd: string); property BreakState: boolean read FBreakFlag write FBreakFlag; property ParamInfo: TConfigData read FCfgObj; property Task: TTaskParse read FTask; end; { TTaskParse } TTaskParse = class private FPdp: TParseDevProtocol; FSend: TMsgSendMg; FHeartTime: TTimer; FPosTime: TTimer; //中心接受请求 FReqCenterAgree: boolean; //定时发送心跳 procedure DoHeartTimer(Sender: TObject); //定时上传定位信息 procedure DoPosTime(Sender: TObject); //处理设置信息 procedure ProcessConfigPam(sProtocol: string); //Unicode转换为界面显示 function UnicodeToForm(sM: string): string; public constructor Create(SendMsg: TMsgSendMg); destructor Destroy; override; function TaskCmd(sCmd: string): string; //登录 procedure Login; //发送定时上传定位信息 procedure HandSendPosTimeInfo; //自动发送心跳 end; implementation function OddRepEven(sSrc: string): string; var i: integer; sRet: string; d: integer; begin sRet := sSrc; for i := 1 to length(sRet) do begin if odd(i) then begin d := ord(sRet[i]); sRet[i] := sRet[i+1]; sRet[i+1] := chr(d); end; end; Result :=sRet; end; { TMsgSendMg } procedure TMsgSendMg.ReadData; var sCmd: String; sEndChar: Char; b: boolean; begin try if not FSendTcp.Connected then begin try Sleep(3000); ReConnect; except end; exit; end; except try Sleep(3000); ReConnect ; except end; exit; end; sCmd := ''; try repeat sEndChar := FSendTcp.IOHandler.ReadChar(); sCmd := sCmd +sEndChar; until sEndChar = ']'; except end; // sCmd := FSendTcp.IOHandler.read(b); if trim(sCmd) <> '' then begin //读出数据。 TBusineParam.ShowCmd(sCmd); FCfgObj.CurrRecvMsgMemo := sCmd; FTask.TaskCmd(sCmd); TBusineParam.ShowCurrRecv(FCfgObj.CurrRecvMsgMemo); end; end; procedure TMsgSendMg.CfgAssign(cd: TConfigData); begin end; procedure TMsgSendMg.ReConnect; begin try FSendTcp.Disconnect; FSendTcp.Connect; except // on e: Exception do // WriteLn('conn eoor ='+ e.Message); end; end; procedure TMsgSendMg.Send(sCmd: string); begin try if not FSendTcp.Connected then exit; except exit; end; TBusineParam.ShowCmd(sCmd); try FSendTcp.IOHandler.Write(sCmd); FCfgObj.CurrSendMsgMemo := sCmd; TBusineParam.ShowCurrSend(FCfgObj.CurrSendMsgMemo); Except; end; end; constructor TMsgSendMg.Create(CreateSuspended: Boolean; PcdAddr: Pointer); var i: integer; begin Inherited Create(CreateSuspended); FSendTcp := TIdTCPClient.Create(nil); FCfgObj := TConfigData(PcdAddr); // WriteLn(FCfgObj.Id); FBreakFlag := false; FTask := TTaskParse.Create(Self); end; destructor TMsgSendMg.Destroy; begin FCfgObj.LoginState := 0; FCfgObj.LoginTime := DateTimeToStr(now); FSendTcp.Disconnect; FreeAndNil(FSendTcp); FreeAndNil(FTask); //FCfgObj.Free; inherited Destroy; end; procedure TMsgSendMg.Execute; begin FreeOnTerminate := false; Connect; while (not FBreakFlag) and (not Terminated) do begin //循环读取 ReadData; Sleep(2000); //暂停2秒 end; end; function TMsgSendMg.Connect: boolean; begin result := false; // WriteLn(FCfgObj.CenterIp); // writeln(FSendTcp.Host); FSendTcp.Host := FCfgObj.CenterIp; FSendTcp.Port := StrToInt(FCfgObj.CenterPort); FHost := FSendTcp.Host; FPort := FSendTcp.Port; FSendTcp.ConnectTimeout := 15 * 1000; //连接超时5秒 FSendTcp.ReadTimeout := 60 * 1000; //读数据超时60秒 try FSendTcp.Connect; FCfgObj.LoginState := 1; FCfgObj.LoginTime := DateTimeToStr(now); //发送终端登录 FTask.Login; result := true; except FCfgObj.LoginState := 0; FCfgObj.LoginTime := DateTimeToStr(now); Raise Exception.Create('连接出错!'); end; end; function TMsgSendMg.DisConn: boolean; begin try FSendTcp.Disconnect; FCfgObj.LoginState := 0; FCfgObj.LoginTime := DateTimeToStr(now); except end; end; { TTaskParse } procedure TTaskParse.DoHeartTimer(Sender: TObject); begin if not FReqCenterAgree then exit; FSend.Send('[2]'); end; procedure TTaskParse.DoPosTime(Sender: TObject); begin //暂时不使用, 通过车载轨迹发送上位信息 // HandSendPosTimeInfo; end; procedure TTaskParse.ProcessConfigPam(sProtocol: string); var k: integer; sTmpCmd: string; sPosId: string; sFlag: string; sM: string; sM2: string; i, d: integer; dcm: integer; DevRd: TDEV_PlanRd; begin k := Pos('CBM', sProtocol); if k > 0 then begin sTmpCmd := Copy(sProtocol, 13, 1); dcm := Ord(sTmpCmd[1]); //dcm := StrToInt(sTmpCmd); case dcm of $81: begin //预存电话 sPosId := copy(sProtocol, 14,2); d := StrToInt(sPosId); sTmpCmd := copy(sProtocol, 16, Length(sProtocol)); k := Pos(',', sTmpCmd); //0代表呼入呼出都允许;1代表只允许呼出;2代表只允许呼入;3代表呼入呼出都限制 sFlag := copy(sTmpCmd, 1, k-1); //电话 sTmpCmd := copy(sTmpCmd, k+1, length(sTmpcmd)); k := pos(',', sTmpCmd); sM := copy(sTmpCmd, 1, k-1); //备注 sTmpCmd := copy(sTmpCmd, k+1, length(sTmpcmd)); k := Pos(')', sTmpCmd); sM2 := copy(sTmpCmd, 1, k-1); //将Unicode转换为utf8 sM2 := UnicodeToForm(sM2); FSend.ParamInfo.TelList.Values[IntToStr(d)] := sM+','+sM2; //界面显示 TBusineParam.ShowTel; end; $83: begin //清除电话本信息 sPosId := copy(sProtocol, 14,2); d := StrToInt(sPosId); if StrToInt(sPosId) <> 0 then //单个清空 FSend.ParamInfo.TelList.Values[IntToStr(d)] := 'Null,' else begin //全部清空 FSend.ParamInfo.TelList.Clear; for i :=1 to 10 do FSend.ParamInfo.TelList.Add(format('%d=%s,%s',[i, 'Null', ''])); end; //界面显示 TBusineParam.ShowTel; end; $0f: begin //预存短信 sPosId := copy(sProtocol, 14,2); sTmpCmd := copy(sProtocol, 16, Length(sProtocol)); k := Pos(')', sTmpCmd); sM := copy(sTmpCmd, 1, k-1); //将Unicode转换为utf8 sM := UnicodeToForm(sM); FSend.ParamInfo.SMSList.BeginUpdate; FSend.ParamInfo.SMSList.Values[sPosId] := trim( sM ); FSend.ParamInfo.SMSList.EndUpdate; //界面显示 TBusineParam.ShowSMS; end; $84: begin //清除短信消息信息 sPosId := copy(sProtocol, 14,2); if StrToInt(sPosId) <> 0 then //单个清空 FSend.ParamInfo.SMSList.Values[sPosId] := 'Null' else begin //全部清空 FSend.ParamInfo.SMSList.BeginUpdate; FSend.ParamInfo.SMSList.Clear; for i :=24 to 30 do FSend.ParamInfo.SMSList.Add(format('%d=%s',[i, 'Null'])); FSend.ParamInfo.SMSList.EndUpdate; end; //界面显示 TBusineParam.ShowSMS; end; $80: //行车计划 begin DevRd.CarNum := copy(sProtocol, 14, 3); DevRd.groupNum := copy(sProtocol, 17, 3); DevRd.LineNum := copy(sProtocol, 20, 5); DevRd.SxFlag := Copy(sProtocol, 25, 1); DevRd.RunCarBTime:= copy(sProtocol, 26, 4); DevRd.RunCarETime:= copy(sProtocol, 30, 4); DevRd.RunType:= copy(sProtocol, 34, 1); k := Pos(')', sProtocol); sTmpcmd := copy(sProtocol, 35, k - 35 ); sTmpCmd := UnicodeToForm(sTmpCmd); k := pos(',', sTmpCmd); DevRd.RunBPos:= Copy(sTmpCmd, 1, k-1); sTmpCmd := copy(sTmpCmd, k+1, Length(sTmpCmd)); k := Pos(',', sTmpCmd); DevRd.RunEPos := Copy(sTmpCmd, 1, k-1); sTmpCmd := copy(sTmpCmd, k +1, Length(sTmpCmd)); DevRd.DevName := copy(sTmpCmd, 1, k -1); //sTmpCmd := copy(sProtocol, 35, MaxInt); //k := pos(',', sTmpCmd); //DevRd.RunBPos:= Copy(sTmpCmd, 1, k-1); //sTmpCmd := copy(sTmpCmd, k+1, Length(sTmpCmd)); //k := Pos(',', sTmpCmd); //DevRd.RunEPos := Copy(sTmpCmd, 1, k-1); //sTmpCmd := copy(sTmpCmd, k +1, Length(sTmpCmd)); //k := Pos(')', sTmpCmd); //DevRd.DevName := copy(sTmpCmd, 1, k -1); TBusineParam.ShowDevPlan(DevRd); end ; $82: begin sM2 := copy(sProtocol, 14, 1); //显示类型 k := Pos(')', sProtocol); sM := copy(sProtocol, 15, k-15); sM := UnicodeToForm(sM); TBusineParam.ShowDispatch(sM2, sM); end ; else end; end else begin //判断撤销报警 k := Pos('CLR', sProtocol); //界面报警设为空 if k > 0 then TBusineParam.SetAlterError(FSend.FCfgObj.Id); end; end; function TTaskParse.UnicodeToForm(sM: string): string; var iLen, i: integer; sTmpSrc: string; sDes: string; begin //将大尾转小尾 sTmpSrc := OddRepEven(sM); iLen := 0; //计算长度 for i := 1 to length(sTmpSrc) do begin //WriteLn(Format('%X',[ord(sTmpSrc[i])])); if Ord(sTmpSrc[i]) <> 0 then inc(iLen); if odd(i) then if Ord(sTmpSrc[i+1]) <> 0 then inc(iLen); end; //分配空间,转换为UTF8格式 SetLength(sDes, iLen+1); i:=UnicodeToUtf8(PChar(sDes),iLen+1, PUnicodeChar(sTmpSrc), length(sTmpSrc)); //转换为组件显示的Ansi值并返回 result := AnsiToUtf8(Utf8ToAnsi(sDes)); end; constructor TTaskParse.Create(SendMsg: TMsgSendMg); begin FPdp := TParseDevProtocol.Create; FSend := SendMsg; FPdp.DevId := FSend.ParamInfo.Id; FHeartTime := TTimer.Create(nil); FHeartTime.Enabled := false; FHeartTime.Interval := StrToInt(FSend.ParamInfo.HeartSpeed); FHeartTime.OnTimer:= @DoHeartTimer; FHeartTime.Enabled := true; FReqCenterAgree := false; FPosTime := TTimer.Create(nil); FPosTime.Enabled:= false; FPosTime.Interval := StrToInt(FSend.ParamInfo.OneSpeed); FPosTime.OnTimer := @DoPosTime; FPosTime.Enabled := true; end; destructor TTaskParse.Destroy; begin FreeAndNil(FPdp); FSend := nil; FreeAndNil(FHeartTime); FreeAndNil(FPosTime); inherited Destroy; end; function TTaskParse.TaskCmd(sCmd: string): string; var sRevMsg: String; k: integer; ival: Integer; begin if sCmd = '[11]' then begin //中心接受请求, 并向中心发送心跳检测 FReqCenterAgree:= true; FSend.Send('[2]'); exit; end; if sCmd = '[12]' then begin //中心接受拒绝 exit; end; //及时修改发送调整时间 //if FHeartTime.Enabled then //begin // //FHeartTime.Enabled := false; // //ival := StrToInt(copy(sCmd, 3,2)); // ival := StrToInt(FSend.ParamInfo.HeartSpeed); // FHeartTime.Interval := ival;//ival * 1000 * 60; // FHeartTime.Enabled := true; //end; //if FPosTime.Enabled then //begin // FPosTime.Enabled:= false; // FPosTime.Interval := StrToInt(FSend.ParamInfo.OneSpeed); // FPosTime.Enabled := true; //end; k := pos('[3', sCmd) ; if k > 0 then begin //FHeartTime.Enabled := false; ival := StrToInt(copy(sCmd, 3,2)); //ival := StrToInt(FSend.ParamInfo.HeartSpeed); //FHeartTime.Interval := ival;//ival * 1000 * 60; //FHeartTime.Enabled := true; exit; end; //先处理设置 ProcessConfigPam(sCmd); //回执处理 sRevMsg := trim (FPdp.Parse(sCmd)); if sRevMsg <> '' then //终端回执 begin FSend.Send(sRevMsg); end; end; procedure TTaskParse.Login; var sCmd: string; begin sCmd := FPdp.Login('0', FSend.ParamInfo.Sim); FSend.Send(sCmd); end; procedure TTaskParse.HandSendPosTimeInfo; var sCmd: string; vData: TPub_AttrRd; h,n,s,ms: Word; begin if not FReqCenterAgree then exit; TBusineParam.GetDevPos(vData); sCmd := format('[%s%s(%s,%s%s%s%s%s%s%s%s%s%s)]',[ '4', FSend.ParamInfo.OneId, 'ONE', vData.glTime, FSend.ParamInfo.DPosState[1], vData.Latitude + FSend.ParamInfo.DLatitudeFX, vData.Longtitude + FSend.ParamInfo.DLongtitudeFX, vData.Speed, vData.Direction, vData.sdate, format('%s%s%s%s',[FSend.ParamInfo.DAlertJJBJ, FSend.ParamInfo.DAlertDDBJ, FSend.ParamInfo.DAlertYL1BJ, FSend.ParamInfo.DAlertYL2BJ ]), FSend.ParamInfo.LineNum, FSend.ParamInfo.RunUpDown ]); FSend.Send(sCmd); end; end.