useatthread.pas

自己写的用delphi封装东劲板卡api.

unit uSeatThread;

interface

uses Classes,unitHsMessagePub,IdTcpClient,SysUtils,DjBase,unitStatThreadList
     ,windows;

type

  TMsgList = class(Tobject)
  private
    MsgDataList:TThreadList;
    MsgPoolList:TThreadList;
    MsgSendList:TThreadList;
  protected

  public
    constructor Create;
    destructor Destroy;override;
    function RemoveData:PHsMessage;
    procedure AddData(HsMsg:PHsMessage);
    function RemovePool:PHsMessage;
    procedure AddPool(HsMsg:PHsMessage);
    function RemoveSend:PHsMessage;
    procedure AddSend(HsMsg:PHsMessage);
    function GetSendCount:integer;
    function GetDataCount:integer;
    function GetPoolCount:integer;
  end;

  TClentThread = class(TThread)
  private
    FIsRun :boolean;
    FIsStop :Boolean;
    MsgCount:Integer;
    SendMsgCount:Integer;
    MainHwd:THandle ;
    idTcpClient: TIdTCPClient ;
    CurrentSendMsg :TStatMessage;
    procedure SendMsgToServer;
    function CheckSendMsgTimeOut:boolean;
    function CheckSendMsg:boolean;
    procedure DisConnectToServer;
    function CreateHeartMessage: PHsMessage;
    procedure GetHeartMessage;
    function RcvMsgFromSvr:integer;
    procedure EndSendMsg;
    procedure ExceptionManager(AExceptionMessage:string);
    procedure AddLog(Log:string);
  protected
    procedure Execute;override;
  public
    constructor create(FormHwd:THandle;TcpClient:TIdTCPClient);
    destructor Destroy;override;
    property IsRun :Boolean read FIsRun write FIsRun ;
    property IsStop :Boolean read FIsStop write FIsStop ;
  end;

var
  MsgList:TMsgList;

implementation

uses UnitWriteLogThread, uSysStr;

{ TClentThread }

function TClentThread.CheckSendMsg: boolean;
begin
  Result := MsgList.GetSendCount > 0 ;
end;

function TClentThread.CheckSendMsgTimeOut: boolean;
begin
  Result := false ;
  if CurrentSendMsg.Status = MessageSending then
  begin
    if GetTickCount - CurrentSendMsg.KeyTime > 18006000 then
    begin
      Result := true ;
    end;
  end;
end;

constructor TClentThread.create(FormHwd: THandle; TcpClient: TIdTCPClient);
begin
  inherited Create(true);
  MsgCount := 0 ;
  MainHwd := FormHwd ;
  idTcpClient := TcpClient ;
  IsStop := false ;
  CurrentSendMsg.Status := MessageFinish ;
  Resume ;
end;

destructor TClentThread.Destroy;
begin

  inherited;
end;

procedure TClentThread.DisConnectToServer;
begin
  idTcpClient.Disconnect;
  EndSendMsg ;
end;

procedure TClentThread.Execute;
var
  CurrentReadSize,CountReadSize:integer;
  hsmsg:THSMessage;
  phsmsg:PHsMessage;
begin
  inherited;
  CurrentReadSize := 0 ;
  CountReadSize := 0 ;
  while not IsStop do
  begin
    if (not IsRun) or (not idTcpClient.Connected) then
    begin
      Suspend;
    end;
    try
      CurrentReadSize :=  0 ;
      if CountReadSize < sizeof(THsMessage) then
      begin
        CurrentReadSize := idTcpClient.ReadFromStack(true,500,false);
        if CurrentReadSize > 0 then
        begin
          CountReadSize := CountReadSize + CurrentReadSize ;
        end
        else
        begin
          if CheckSendMsgTimeOut then
          begin
            AddLog('消息接收超时,主动断开连接!');
            DisConnectToServer;
          end
          else
          begin
            if CheckSendMsg then
            begin
              SendMsgToServer;
            end
            else
            begin
              GetHeartMessage;
            end;
          end;
          Continue ;
        end;
      end;
      //AddLog(IntToStr(CountReadSize));
      CountReadSize := CountReadSize -  RcvMsgFromSvr;
      //AddLog(IntToStr(CountReadSize)+'结束');
      if CheckSendMsgTimeOut then
      begin
        DisConnectToServer;
      end;
      if CheckSendMsg then
      begin
        SendMsgToServer;
      end;
    except
      on e :exception do
      begin
        ExceptionManager(E.message);
      end;
      on e:TDjException do
      begin
      end;
    end;
  end;
end;

procedure TClentThread.SendMsgToServer;
var
  HsMsg : PHsMessage ;
begin
  HsMsg := MsgList.RemoveSend ;
  if Assigned(HsMsg) then
  begin
    if TMsgType(HsMsg.m_nMessageId) <> UD_MSG_HEART then
      AddLog('发送消息  '+GetMsgName(HsMsg.m_nMessageId));
    CurrentSendMsg.PMessage := HsMsg ;
    CurrentSendMsg.KeyID := SendMsgCount + 1 ;
    idTcpClient.WriteBuffer(HsMsg^,sizeof(HsMsg^));
    CurrentSendMsg.KeyTime := GetTickCount ;
    CurrentSendMsg.Status := MessageSending ;    
  end;
end;

function TClentThread.CreateHeartMessage: PHsMessage;
var
  HsMessage:PHsMessage;
begin
  Result := nil ;
  HsMessage := MsgList.RemovePool ;
  if not Assigned(HsMessage) then exit ;
  HsMessage.m_nHeader := HS_MESSAGE_HEADER ;
  HsMessage.m_nMessageId := 50037 ;
  HsMessage.m_nChannel := 0 ;
  HsMessage.m_nLength := 0 ;
  fillchar(HsMessage.m_pMessage[0], sizeof(HsMessage.m_pMessage),#0);
  Result := HsMessage;
  //move(HsMessage,Result^,sizeof(HsMessage));
end;


procedure TClentThread.GetHeartMessage;
begin
  //MsgList.AddSend(CreateHeartMessage);
end;

function TClentThread.RcvMsgFromSvr: integer;
var
  HsMsgOut:PHsMessage;
  HsMsg:THSMessage ;
begin
  idTcpClient.ReadBuffer(HsMsg,SizeOf(HsMsg));
  Result := sizeof(HsMsg);
  if TMsgType(HsMsg.m_nMessageId) <> UD_MSG_HEART then
  begin
    inc(MsgCount);
    HsMsgOut := MsgList.RemovePool ;
    Move(Hsmsg,HsMsgOut^,sizeof(HsMsg));
    MsgList.AddData(HsMsgOut);
    AddLog('收到消息 '+GetMsgName(HsMsg.m_nMessageId));
    PostMessage(MainHwd,WM_ReceiveMessage,0,MsgCount);
  end
  else
  begin
    EndSendMsg;
  end;
end;

procedure TClentThread.EndSendMsg;
var
  HsMsg:PHsMessage;
begin
  CurrentSendMsg.Status := MessageFinish ;
  HsMsg := CurrentSendMsg.PMessage;
  MsgList.AddPool(HsMsg);
  CurrentSendMsg.PMessage := nil ;
end;

procedure TClentThread.ExceptionManager(AExceptionMessage: string);
var
  HsMsg : PHsMessage ;
  i:integer;
begin
  HsMsg :=MsgList.RemovePool ;
  i := GetMsgIdStr('D_MSG_ERROR') ;
  HsMsg^ := AssembleMessage_Down_ErrorExp(0,i,E_THREADTOSERVER,AExceptionMessage);
  MsgList.AddData(HsMsg);
  SendMessage(MainHwd,WM_ReceiveMessage,0,0);
end;

procedure TClentThread.AddLog(Log: string);
begin
  AddLogToListB(Log,'与通讯',LogError);
end;

{ TMsgList }

procedure TMsgList.AddData(HsMsg: PHsMessage);
begin
  MsgDataList.Add(HsMsg);
end;

procedure TMsgList.AddPool(HsMsg: PHsMessage);
begin
  MsgPoolList.Add(HsMsg);
end;

procedure TMsgList.AddSend(HsMsg: PHsMessage);
begin
  MsgSendList.Add(HsMsg);
end;

constructor TMsgList.Create;
var
  i:integer;
  HsMsg:PHsMessage;
begin
  inherited ;
  MsgDataList := TThreadList.Create;
  MsgPoolList := TThreadList.Create;
  MsgSendList := TThreadList.Create;
  for i:=0 to 10 do
  begin
    New(HsMsg);
    FillChar(HsMsg^,sizeof(HsMsg),#0);
    AddPool(HsMsg);
  end;
end;

destructor TMsgList.Destroy;
begin
  MsgDataList.Free;
  MsgPoolList.Free;
  MsgSendList.Free ;
  inherited;
end;

function TMsgList.GetDataCount: integer;
begin
  Result := MsgDataList.LockList.Count ;
  MsgDataList.UnlockList;
end;

function TMsgList.GetPoolCount: integer;
begin
  Result := MsgPoolList.LockList.Count ;
  MsgPoolList.UnlockList;
end;

function TMsgList.GetSendCount: integer;
begin
  Result := MsgSendList.LockList.Count ;
  MsgSendList.UnlockList;
end;

function TMsgList.RemoveData: PHsMessage;
var
  List:TList ;
  HsMsg:PHsMessage;
begin
  List := MsgDataList.LockList;
  if List.Count > 0 then
  begin
    HsMsg := List.Items[0];
    List.Delete(0);
  end
  else
  begin
    HsMsg := nil ;
  end;
  Result := HsMsg ;
  MsgDataList.UnlockList;
end;

function TMsgList.RemovePool: PHsMessage;
var
  List:TList ;
  HsMsg:PHsMessage;
begin
  List := MsgPoolList.LockList;
  if List.Count > 0 then
  begin
    HsMsg := List.Items[0];
    List.Delete(0);
  end
  else
  begin
    new(HsMsg) ;
  end;
  Result := HsMsg ;
  MsgPoolList.UnlockList;
end;

function TMsgList.RemoveSend: PHsMessage;
var
  List:TList ;
  HsMsg:PHsMessage;
begin
  List := MsgSendList.LockList;
  if List.Count > 0 then
  begin
    HsMsg := List.Items[0];
    List.Delete(0);
  end
  else
  begin
    HsMsg := nil ;
  end;
  Result := HsMsg ;
  MsgSendList.UnlockList;
end;

end.