alekcvp, спасибо, согласен насчет Length особенно.
А вообще, у меня с Indy был в принимаемых данных какой-то мусор. Перевел эксперименты на Synapse - гораздо лучше!
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
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;
