Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Delphi Новый топик    Ответить
Топик располагается на нескольких страницах: Ctrl  назад   1 [2]      все
 Re: Как к Pascal Script прикрутить TIdUDPClient из Indy  [new]
alekcvp
Member

Откуда:
Сообщений: 2071
AleksVoronezh,

    while (AData[i] <> 0) do
      begin
      s := s+chr(AData[i]);
      i := i+1;
      end;

Предлагаю ещё sleep(100); в тело цикла вставить для эффективности...
+
SetLength(s, Length(AData));
while (AData[i] <> 0) do
begin
  s[i + 1] := Chr(AData[i]);
  Inc(i);
end;
SetLength(s, i)


P.S: Что будет, если в AData никогда не встретится 0?

Сообщение было отредактировано: 22 май 20, 14:17
22 май 20, 14:17    [22137717]     Ответить | Цитировать Сообщить модератору
 Re: Как к Pascal Script прикрутить TIdUDPClient из Indy  [new]
AleksVoronezh
Member

Откуда:
Сообщений: 331
alekcvp, спасибо, согласен насчет Length особенно.

А вообще, у меня с Indy был в принимаемых данных какой-то мусор. Перевел эксперименты на Synapse - гораздо лучше!

type
  TUDPThread = class( TThread )
  private
    function  GetLog: String;
    procedure OnStatus(Sender: TObject; Reason: THookSocketReason; const Value: string);
  protected
    m_Log : TStringList;
    m_pSocket : TUDPBlockSocket;

    Port_To_Bind: String;

  public
    constructor Create; virtual;
    destructor  Destroy; override;
    property Log : String read GetLog;
  end;

  TUDPServer = class( TUDPThread )
  protected
    Function_Name_To_Return_UDP_Data: String;
    procedure Execute; override;
  end;

    TUDPClient = class( TUDPThread )
  protected
    procedure Execute; override;
  end;

{ TUDPThread }


constructor TUDPThread.Create;
begin
  inherited Create( false );
  FreeOnTerminate := false;
  m_Log := TStringList.Create;
  m_pSocket := TUDPBlockSocket.Create;
  //m_pSocket.OnStatus := @OnStatus;
end;

destructor TUDPThread.Destroy;
begin
  FreeAndNil( m_pSocket );
  FreeAndNil( m_Log );
  inherited;
end;

function TUDPThread.GetLog: String;
begin
  Result := m_Log.Text;
end;


procedure TUDPThread.OnStatus(Sender: TObject; Reason: THookSocketReason;
  const Value: string);
var
  sReason : String;
begin
  case Reason of
    HR_ResolvingBegin : sReason := 'HR_ResolvingBegin';
    HR_ResolvingEnd : sReason := 'HR_ResolvingEnd';
    HR_SocketCreate : sReason := 'HR_SocketCreate';
    HR_SocketClose : sReason := 'HR_SocketClose';
    HR_Bind : sReason := 'HR_Bind';
    HR_Connect : sReason := 'HR_Connect';
    HR_CanRead : sReason := 'HR_CanRead';
    HR_CanWrite : sReason := 'HR_CanWrite';
    HR_Listen : sReason := 'HR_Listen';
    HR_Accept : sReason := 'HR_Accept';
    HR_ReadCount : sReason := 'HR_ReadCount';
    HR_WriteCount : sReason := 'HR_WriteCount';
    HR_Wait : sReason := 'HR_Wait';
    HR_Error : sReason := 'HR_Error';
  end;
  m_Log.Add( sReason + ': ' + Value );
end;

{ TUDPServer }

procedure TUDPServer.Execute;
var
  sResult : String;
begin
  m_pSocket.Bind( cAnyHost, Port_To_Bind );
  if ( m_pSocket.LastError = 0 ) then
  repeat
    sResult := m_pSocket.RecvPacket( -1 );
    m_Log.Add( sResult );

    Form3.Call_PS_Function(Function_Name_To_Return_UDP_Data,sResult,Form3.Edit1.Text,''); // Здесь вызов функции внутри скрипта по ее имени, Call_PS_Function работает через PSScript1.GetProcMethod(Function_Name)
  until terminated or ( sResult = 'exit' );
end;

{ TUDPClient }

procedure TUDPClient.Execute;
var
  ii : Integer;
begin
  m_pSocket.Connect( cLocalhost, Port_To_Bind );
  for ii := 0 to 3 do
  begin
    m_pSocket.SendString( IntToStr( ii ) );
    Sleep( 100 );
  end;
  m_pSocket.SendString( 'exit' );

end;






Function PS_UDP_Server_Create(UDP_Server_Name: string; Function_Name_To_Return_UDP_Data: string; IP_To_Bind: String; Port_To_Bind: String): Pointer;


Var

  pServer : TUDPServer;
begin

 pServer := TUDPServer.Create;
 pServer.Port_To_Bind:=Port_To_Bind;

 pServer.Function_Name_To_Return_UDP_Data:=Function_Name_To_Return_UDP_Data;


End;
22 май 20, 23:28    [22138000]     Ответить | Цитировать Сообщить модератору
Топик располагается на нескольких страницах: Ctrl  назад   1 [2]      все
Все форумы / Delphi Ответить