所有人。我有一个Mr Remy Lebeau给我的示例代码。这是关于印地服务器的..。但是,这段代码不能在我的Delphi环境中工作。我的delphi版本是2010,而Indy版本通知了10.5.5
我的delphi不能识别TIdThreadSafeObjectList, TIdContextThreadList
type
TMonitorContext = class(TIdServerContext)
public
Screenshots: TIdThreadSafeObjectList;
ScreenshotEvent: THandle;
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
destructor Destroy; override;
end;
TScreenshotInfo = class
public
ClientIP: string;
ClientPort: TIdPort;
Data: TMemoryStream;
constructor Create;
destructor Destroy; override;
end;
constructor TMonitorContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList);
begin
inherited;
Screenshots := TIdThreadSafeObjectList.Create;
Screenshots.OwnsObjects := True;
ScreenshotEvent := CreateEvent(null, True, False, nil);
end;
destructor TMonitorContext.Destroy;
begin
Screenshots.Free;
CloseHandle(ScreenshotEvent);
inherited;
end;
constructor TScreenshotInfo.Create;
begin
inherited;
Data := TMemoryStream.Create;
end;
destructor TScreenshotInfo.Destroy;
begin
Data.Free;
inherited;
end;
{one side----idTCPServerRecv is to receive screenshot streams from clients}
procedure TIndyServerForm.IdTCPServer_RecvExecute(AContext: TIdContext);
var
recv_stream: TMemoryStream;
monitors, queue: TList;
i: Integer;
screenshot: TScreenshotInfo;
monitor: TMonitorContext;
begin
recv_stream := TMemoryStream.Create;
try
if not ReceiveStream(AContext, recv_stream) then
begin
ROutMsg := AContext.Binding.PeerIP + ' -> receiving failed: ' + IntToStr(recv_Stream.Size) + ' byte';
Exit;
end;
if recv_Stream.Size < 1024 then
begin
recv_Stream.Position := 0;
ROutMsg := AContext.Binding.PeerIP + ' -> captionString received(' +
IntToStr(recv_Stream.Size) + ' byte) : "' + StringFromStream(recv_Stream) + '"';
end
else
begin
ROutMsg := AContext.Binding.PeerIP + ' -> screenshot received: ' + KBStr(recv_Stream.Size) + ' KB';
monitors := IdTCPServer_Send.Contexts.LockList;
try
// alternatively, only queue the screenshot to particular monitors
// that are actually interested in this client...
for i := 0 to monitors.Count-1 do
begin
monitor := TMonitorContext(monitors[i]);
screenshot := TScreenshotInfo.Create;
try
recv_Stream.Position := 0;
screenshot.Data.CopyFrom(recv_stream, 0);
screenshot.Data.Position := 0;
queue := monitor.Screenshots.LockList;
try
queue.Add(screenshot);
SetEvent(monitor.ScreenshotEvent);
finally
monitor.Screenshots.UnlockList;
end;
except
screenshot.Free;
end;
end;
finally
IdTCPServer_Send.Contexts.UnlockList;
end;
end;
finally
recv_stream.Free;
end;
end;
{another side----idTCPServerSend is to send screenshot streams to monitors}
procedure TIndyServerForm.FormCreate(Sender: TObject);
begin
IdTCPServer_Send.ContextClass := TMonitorContext;
end;
procedure TIndyServerForm.IdTCPServer_SendExecute(AContext: TIdContext);
var
monitor: TMonitorContext;
queue: TList;
i: Integer;
screenshot: TScreenshotInfo;
begin
monitor := TMonitorContext(AContext);
if WaitForSingleObject(monitor.ScreenshotEvent, 1000) <> WAIT_OBJECT_0 then Exit;
screenshot := nil;
try
queue := monitor.Screenshots.LockList;
try
if queue.Count > 0 then
begin
screenshot := TScreenshotInfo(queue[0]);
queue.Delete(0);
end;
if queue.Count = 0 then
ResetEvent(monitor.ScreenshotEvent);
finally
monitor.Screenshots.UnlockList;
end;
if screenshot = nil then Exit;
// you should send screenshot.ClientIP and screenshot.ClientPort to
// this monitor so it knows which client the screenshot came from...
if not SendStream(AContext, screenshot.Data) then
begin
SOutMsg := AContext.Binding.PeerIP + ' -> sending failed -> ' + KBStr(screenshot.Data.Size) + ' KB';
Exit;
end;
SOutMsg := AContext.Binding.PeerIP + ' -> sending successful-> ' + KBStr(screenshot.Data.Size) + ' KB';
finally
screenshot.Free;
end;
end;我该怎么办?请帮帮我。
发布于 2015-11-24 02:59:55
我已经找到了一种不用升级Indy版本的方法。
解决方案如下..
unit UnitServer;
interface
uses
... ... ...
{$IF Declared(TIdContextThreadList) }
// TIdContextThreadList exists
{$ELSE}
type TIdContextThreadList = TThreadList;
{$IFEND}
{$IF Declared(TIdThreadSafeObjectList) }
// TIdThreadSafeObjectList exists
{$ELSE}
type TIdThreadSafeObjectList = TThreadList;
{$IFEND}
type
TMonitorContext = class(TIdServerContext)
public
Screenshots: TIdThreadSafeObjectList;
ScreenshotEvent: THandle;
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
... ... ...
... ... ...像上面一样修改,并运行项目,,,它工作得很好,没有任何问题…
真的谢谢你们,每个给我提建议的人。我要感谢Remy Lebeau先生,他给了我重要的指导。
https://stackoverflow.com/questions/33869180
复制相似问题