idhl7.pas

photo.163.com 相册下载器 多线程下载

    end;
end;


{==========================================================
  Server Connection Maintainance
 ==========================================================}

procedure TIdHL7.EnforceWaitReplyTimeout;
begin
  Stop;
  Start;
end;

function TIdHL7.Going: Boolean;
var
  LStatus: TIdHL7Status;
begin
  assert(assigned(self));
  LStatus := GetStatus;
  Result := (LStatus <> IsStopped) and (LStatus <> IsUnusable);
end;

procedure TIdHL7.WaitForConnection(AMaxLength: Integer);
var
  LStopWaiting: TDateTime;
begin
  LStopWaiting := Now + (AMaxLength * ((1 / (24 * 60)) / (60 * 1000)));
  while not Connected and (LStopWaiting > now) do
    sleep(50);
end;

procedure TIdHL7.CheckSynchronousSendResult(AResult: TSendResponse; AMsg: String);
begin
  case AResult of
    srNone:
      raise EHL7CommunicationError.Create(Name, 'Internal error in IdHL7.pas: SynchronousSend returned srNone'); {do not localize}
    srError:
      raise EHL7CommunicationError.Create(Name, AMsg);
    srNoConnection:
      raise EHL7CommunicationError.Create(Name, 'Not connected'); {do not localize}
    srSent:
      // cause this should only be returned asynchronously
      raise EHL7CommunicationError.Create(Name, 'Internal error in IdHL7.pas: SynchronousSend returned srSent');  {do not localize}
    srOK:; // all ok
    srTimeout:
      raise EHL7CommunicationError.Create(Name, 'No response from remote system'); {do not localize}
    else
      raise EHL7CommunicationError.Create(Name, 'Internal error in IdHL7.pas: SynchronousSend returned an unknown value ' + IntToStr(Ord(AResult))); {do not localize}
    end;
end;

procedure TIdHL7.CheckServerParameters;
begin
  assert(assigned(self));
  if (FCommunicationMode = cmAsynchronous) or not FIsListener then
    begin
    FConnectionLimit := 1;
    end;

  if (FPort < 1) then // though we have already ensured that this cannot happen
    begin
    raise EHL7CommunicationError.Create(Name, Format(RSHL7InvalidPort, [FPort]));
    end;
end;

procedure TIdHL7.StartServer;
begin
  assert(assigned(self));
  CheckServerParameters;
  FServer := TIdTCPServer.Create(NIL);
  try
    FServer.DefaultPort := FPort;
    Fserver.OnConnect := ServerConnect;
    FServer.OnExecute := ServerExecute;
    FServer.OnDisconnect := ServerDisconnect;
    FServer.Active := True;
    InternalSetStatus(IsNotConnected, RSHL7StatusNotConnected);
  except
    on e:
    Exception do
      begin
      InternalSetStatus(IsStopped, Format(RSHL7StatusFailedToStart, [e.message]));
      FreeAndNil(FServer);
      raise;
      end;
    end;
end;

procedure TIdHL7.StopServer;
begin
  assert(assigned(self));
  try
    FServer.Active := False;
    FreeAndNil(FServer);
    InternalSetStatus(IsStopped, RSHL7StatusStopped);
  except
    on e:
    Exception do
      begin
      // somewhat arbitrary decision: if for some reason we fail to shutdown,
      // we will stubbornly refuse to work again.
      InternalSetStatus(IsUnusable, Format(RSHL7StatusFailedToStop, [e.message]));
      FServer := NIL;
      raise
      end;
    end;
end;

procedure TIdHL7.ServerConnect(AContext: TIdContext);
var
  LNotify : Boolean;
  LConnCount : integer;
  LValid : Boolean;
begin
  assert(assigned(self));
  assert(assigned(AContext));
  assert(assigned(FLock));
  FLock.Enter;
  try
    LNotify := FConnCount = 0;
    inc(FConnCount);
    LConnCount := FConnCount;
    // it would be better to stop getting here in the case of an invalid connection
    // cause here we drop it - nasty for the client. To be investigated later
    LValid := FConnCount <= FConnectionLimit;
    if (FConnCount = 1) and (FCommunicationMode <> cmAsynchronous) and not IsListener then
      begin
      FServerConn := AContext.Connection;
      end;
    if LNotify then
      begin
      InternalSetStatus(IsConnected, RSHL7StatusConnected);
      end;
  finally
    FLock.Leave;
    end;
  if LValid then
    begin
    if LNotify and assigned(FOnConnect) then
      begin
      FOnConnect(self);
      end;
    if assigned(FOnConnCountChange) and (FConnectionLimit <> 1) then
      begin
      FOnConnCountChange(Self, LConnCount);
      end;
    end
  else
    begin
    // Thread exceeds connection limit
    AContext.Connection.Disconnect;
    end;
end;

procedure TIdHL7.ServerDisconnect(AContext: TIdContext);
var
  LNotify: Boolean;
  LConnCount : integer;
begin
  assert(assigned(self));
  assert(assigned(AContext));
  assert(assigned(FLock));
  FLock.Enter;
  try
    dec(FConnCount);
    LNotify := FConnCount = 0;
    LConnCount := FConnCount;
    if AContext.Connection = FServerConn then
      begin
      FServerConn := NIL;
      end;
    if LNotify then
      begin
      InternalSetStatus(IsNotConnected, RSHL7StatusNotConnected);
      end;
  finally
    FLock.Leave;
    end;
  if assigned(FOnConnCountChange)  and (FConnectionLimit <> 1) then
    begin
    FOnConnCountChange(Self, LConnCount);
    end;
  if LNotify and assigned(FOnDisconnect) then
    begin
    FOnDisconnect(self);
    end;
end;

procedure TIdHL7.ServerExecute(AContext: TIdContext);
var
  s : String;
begin
  assert(assigned(self));
  assert(assigned(AContext));

  try
    // 1. prompt the network for content.
    AContext.Connection.IOHandler.ReadLn(MSG_START); // throw this content away
    if assigned(AContext.Connection.IOHandler) then
      begin
      s := AContext.Connection.IOHandler.ReadLn(MSG_END);
      if length(s) > 0 then
        begin
        HandleIncoming(s, AContext.Connection);
        end;
      end;
  except
    try
      // well, there was some network error. We aren't sure what it
      // was, and it doesn't matter for this layer. we're just going
      // to make sure that we start again.
      // to review: what happens to the error messages?
      AContext.Connection.Disconnect;
    except
    end;
  end;
end;

procedure TIdHL7.DropServerConnection;
begin
  assert(assigned(self));
  assert(assigned(FLock));
  FLock.Enter;
  try
    if assigned(FServerConn) then
      FServerConn.Disconnect;
  finally
    FLock.Leave;
    end;
end;


{==========================================================
  Client Connection Maintainance
 ==========================================================}

procedure TIdHL7.CheckClientParameters;
begin
  assert(assigned(self));
  if (FPort < 1) then
    begin
    raise EHL7CommunicationError.Create(Name, Format(RSHL7InvalidPort, [FPort]));
    end;
end;

procedure TIdHL7.StartClient;
begin
  assert(assigned(self));
  CheckClientParameters;
  FClientThread := TIdHL7ClientThread.Create(self);
  InternalSetStatus(isConnecting, RSHL7StatusConnecting);
end;

procedure TIdHL7.StopClient;
var
  LFinished: Boolean;
  LWaitStop: Cardinal;
begin
  assert(assigned(self));
  assert(assigned(FLock));
  FLock.Enter;
  try
    FClientThread.Terminate;
    FClientThread.FClient.Disconnect;
    FClientThread.FCloseEvent.SetEvent;
  finally
    FLock.Leave;
    end;
  LWaitStop := Ticks + 5000;
  repeat
    LFinished := (GetStatus = IsStopped);
    if not LFinished then
      begin
      sleep(10);
      end;
  until LFinished or (Ticks > LWaitStop);
  if GetStatus <> IsStopped then
    begin
    // for some reason the client failed to shutdown. We will stubbornly refuse to work again
    InternalSetStatus(IsUnusable, Format(RSHL7StatusFailedToStop, [RSHL7ClientThreadNotStopped]));
    end;
end;


procedure TIdHL7.DropClientConnection;
begin
  assert(assigned(self));
  assert(assigned(FLock));
  FLock.Enter;
  try
    if assigned(FClientThread) and assigned(FClientThread.FClient) then
      begin
      FClientThread.FClient.Disconnect;
      end
    else
      begin
      // This may happen validly because both ends are trying to drop the connection simultaineously
      end;
  finally
    FLock.Leave;
    end;
end;

{ TIdHL7ClientThread }

constructor TIdHL7ClientThread.Create(aOwner: TIdHL7);
begin
  assert(assigned(AOwner));
  FOwner := aOwner;
  FCloseEvent := TIdLocalEvent.Create(True, False);
  inherited Create(False);
  FreeOnTerminate := True;
end;

destructor TIdHL7ClientThread.Destroy;
begin
  assert(assigned(self));
  assert(assigned(FOwner));
  assert(assigned(FOwner.FLock));
  FreeAndNil(FCloseEvent);
  try
    FOwner.FLock.Enter;
    try
      FOwner.FClientThread := NIL;
      FOwner.InternalSetStatus(isStopped, RSHL7StatusStopped);
    finally
      FOwner.FLock.Leave;
      end;
  except
    // it's really vaguely possible that the owner
    // may be dead before we are. If that is the case, we blow up here.
    // who cares.
    end;
  inherited;
end;

procedure TIdHL7ClientThread.PollStack;
var
  LBuffer: String;
begin
  assert(assigned(self));
  LBuffer := '';
  repeat
    // we don't send here - we just poll the stack for content
    // if the application wants to terminate us at this point,
    // then it will disconnect the socket and we will get thrown
    // out
    // we really don't care at all whether the disconnect was clean or ugly

    // but we do need to suppress exceptions that come from
    // indy otherwise the client thread will terminate

    try
      FClient.IOHandler.ReadLn(MSG_START); // we toss this content
      if assigned(FClient.IOHandler) then
        begin
        LBuffer := FClient.IOHandler.ReadLn(MSG_END);
        if LBuffer <> '' then
          begin
          FOwner.HandleIncoming(LBuffer, FClient);
          end;
        end;
    except
      try
        // well, there was some network error. We aren't sure what it
        // was, and it doesn't matter for this layer. we're just going
        // to make sure that we start again.
        // to review: what happens to the error messages?
        FClient.Disconnect;
      except
        end;
      end;
  until Terminated or not FClient.Connected;
end;

procedure TIdHL7ClientThread.Execute;
var
  LRecTime: TDateTime;
begin
  assert(assigned(self));
  try
    FClient := TIdTCPClient.Create(NIL);
    try
      FClient.Host := FOwner.FAddress;
      FClient.Port := FOwner.FPort;
      repeat
        // try to connect. Try indefinitely but wait Owner.FReconnectDelay
        // between attempts. Problems: how long does Connect take?
        repeat
          FOwner.InternalSetStatus(IsConnecting, rsHL7StatusConnecting);
          try
            FClient.Connect;
          except
            on e:
            Exception do
              begin