⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 umileagegetter.pas

📁 a voice guide client ,it is the second part of voice guide center
💻 PAS
字号:

{
  车辆里程信息查询客户端对象,负责向里程服务器进行里程查询
  Create by mous 2006-03-01
  
}

unit uMileageGetter;

interface

uses
  Classes
  , IdTCPClient
  , ExtCtrls
  , Windows
  , SysUtils
  , IdException
  , SyncObjs
  , etUtils
  , etTimers
  , etHash
  ;

type

  {: 车辆里程信息记录
  }  
  TCarMileageInfo = record
    MileageValue  : Double;
    MileageTime   : TDateTime;
  end;

  { 车辆里程查询客户类
  }
  TMileageGetter  = class(TObject)
  private
    FCarLock        : TCriticalSection;
    FCars           : TEtIntHashTable;

    FTcpConn        : TIdTCPClient;
    FActive         : Boolean;
    FLastError      : String;
    FHost           : String;
    FPort           : Word;
    FUser           : String;

    FbkWorker       : TEtDaemonWorker;
    FtmReconn       : TTimer;
    FTmUpdate       : TTimer;

    procedure   ConnectToServer;
    function    Logon: Boolean;
    function    QueryFromServer( _car_id: cardinal; var _info: TCarMileageInfo ): Boolean;

    procedure   setActive(const Value: Boolean);
    procedure   OnReconnTimer( Sender: TObject );
  public
    constructor Create;
    destructor  Destroy; override;

    { 获取某车辆的里程信息 }
    function    GetMileage( _car_id: cardinal; var _res: TCarMileageInfo ): Boolean;

    { 连接到服务器所需要的参数 }
    property    Host: String read FHost write FHost;
    property    Port: Word read FPort write FPort;
    property    User: String read FUser write FUser;

    { 工作状态设置 }
    property    Active: Boolean read FActive write setActive;

    { 最后错误信息 }
    property    LastError: String read FLastError;
  end;

{ TMileageClient }

implementation


  (******************************************)
  (*                                        *)
  (* 以下定义的是内部类,仅在本单元内有效, *)
  (*                                        *)
  (******************************************)

procedure TMileageGetter.ConnectToServer;
var
  logonOK : Boolean;

begin
  try
    FTcpConn.Connect();
    FTcpConn.GetResponse(110); // get welcom message
    FtmReconn.Enabled := True;

    logonOK := Logon;
    if logonOK then
    begin
      FtmReconn.Enabled := True;
      FLastError  := '';
    end;
  except
    on E: EIdSocketError do
    begin
      FLastError  := '服务器没有响应';
      FtmReconn.Enabled := False;
      raise Exception.Create('服务器没有响应。');  // translate
    end
  end;
end;

function TMileageGetter.Logon: Boolean;
begin
  Result  := FTcpConn.Connected;

  if Result then
  begin
    FTcpConn.SendCmd( 'AUTH '+ FUser );
    Result  := FTcpConn.LastCmdResult.NumericCode = 201; // logon OK
  end
  else
    FLastError  := '登录失败';

end;

constructor TMileageGetter.Create;
begin
  inherited;
                 
  FCarLock    := TCriticalSection.Create;
  FCars       := TEtIntHashTable.Create( etHitObject );
  FTcpConn    := TIdTCPClient.Create(nil);
  FbkWorker   := TEtDaemonWorker.Create;

  FtmReconn         := TTimer.Create(nil);
  FtmReconn.OnTimer := OnReconnTimer;
  FtmReconn.Enabled := False;
  FtmReconn.Interval:= 30*1000;

  FPort       := 2012;
  FHost       := '127.0.0.1';
  FUser       := 'admin';
end;

destructor TMileageGetter.Destroy;
begin  
  FtmReconn.Enabled := False;
  FtmReconn.Free;

  FbkWorker.Terminate;
  FbkWorker.Free;

  FTcpConn.Disconnect;
  Sleep(200);
  FTcpConn.Free;

  FCars.Free;
  FCarLock.Free;

  FLastError  := '';

  inherited;
end;

procedure TMileageGetter.OnReconnTimer(Sender: TObject);
begin
  if not FTcpConn.Connected then
    FbkWorker.AddTask( 'ReconnectToServer', ConnectToServer );
end;

procedure TMileageGetter.setActive(const Value: Boolean);
begin
  FActive := Value;

  if FActive then
  begin
    FTcpConn.Host := FHost;
    FTcpConn.Port := FPort;

    OnReconnTimer( self );
  end
  else
  begin
    FbkWorker.ClearTasks;
    FTcpConn.Disconnect;
  end;
end;

function TMileageGetter.QueryFromServer( _car_id: cardinal; var _info: TCarMileageInfo ): Boolean;
var
  cols    : TStrings;
  i       : Integer;
begin
  Result  := FTcpConn.Connected;
  if not Result then
  begin
    FLastError  := '未连接到服务器';
    Exit;
  end;

  FTcpConn.SendCmd( Format( 'mileage %d', [ _car_id ] ) );
  Case FTcpConn.LastCmdResult.NumericCode of
    303 :// no this car
    begin
      Result  := False;
      FLastError  := '车辆不存在';
    end;
    206 :// Mileage info
    begin
      cols   := TStringList.Create;
      try
        FTcpConn.Capture( cols );
        if cols.Count = 2 then
        begin
          _info.MileageValue  := StrToFloatDef( cols[0], 0 );
          _info.MileageTime   := StrToDateTimeDef( cols[1], Now );
          FLastError  := '';
        end;
      finally
        cols.Free;
      end;
    end;

  end;
  
end;


function TMileageGetter.GetMileage(_car_id: cardinal;
  var _res: TCarMileageInfo): Boolean;
begin
  Result  := QueryFromServer( _car_id, _res );
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -