此代码基于使用 indy10 和 delphi xe 或 delphi 2010 的源代码伪造的演示应用程序。我尝试添加一些改进，但现在客户端在与服务器交换数据时挂断了
> procedure TServerMainForm.**IdTCPServerExecute(AContext:
> TIdContext);** var LBuffer: TBytes;
>
> LSize: LongInt;
>
> CMD_CLASS: Integer; line: String;
>
> aMs: TMemoryStream;
>
> aINDYCMD: TGenericRecord<TINDYCMD>; aMyRecord:
> TGenericRecord<TMyRecord>;
>
> begin
>
> aINDYCMD := TGenericRecord<TINDYCMD>.Create; aMyRecord :=
> TGenericRecord<TMyRecord>.Create;
>
> AIndyRecord_TS := TINDYCMDThreadSafeRecord.Create; // NEW THREAD
> SAVE RECORDE.. IF I NEED VCL ACCESS !!! aMyRecord_TS :=
> TMyRECORDThreadSafeRecord.CReate;
>
>
>
> AContext.Connection.IOHandler.ReadTimeout := 90000;
>
> // 'server execute start'
>
> if (ReceiveBuffer(AContext, LBuffer) = False) then begin
> TIdNotify.NotifyMethod(ShowCannotGetDataErrorMessage);
> Exit; end else begin
> TIdNotify.NotifyMethod(ShowDataReceivedMessage);
>
> aINDYCMD.value := aINDYCMD.ByteArrayToMyRecord(LBuffer);
>
> AIndyRecord_TS.lock;
>
> AIndyRecord_TS.value := aINDYCMD.value;
>
> // TIdNotify.NotifyMethod(RecordReceived_TMyRecord); BUGGY CODE I GUESS
> // TIdNotify.NotifyMethod(RecordReceived_TINDY_CMD);
> AIndyRecord_TS.unlock;
>
> end;
>
> aINDYCMD.value := aINDYCMD.ByteArrayToMyRecord(LBuffer);
>
>
> CMD_CLASS := aINDYCMD.value.CMD_CLASS;
>
> // MainStatusBar.SimpleText := ' CMD_CLASS -> ' +
> INtToStr(aINDYCMD.value.CMD_CLASS);
>
> case CMD_CLASS of
> 0:
> begin
> /// receive a simple string from client
> line := AContext.Connection.IOHandler.ReadLn();
> // Memo1.Lines.Add('');
> // Memo1.Lines.Add('CLIENT STRING -> ' + line);
> // Memo1.Lines.Add('');
> end;
>
> 1:
> begin
> ///
> // Memo1.Lines.Add('');
> // Memo1.Lines.Add('SEND RECORD BACK TO CLIENT#1');
> // Memo1.Lines.Add('');
>
> AIndyRecord_TS.lock;
> AIndyRecord_TS.value.CMD_TIMESTAMP := now;
> AIndyRecord_TS.value.CMD_VALUE := ' TEST SEND BACK SERVER TIME -> ' +
> dateToStr(now) + '/' + TimeToStr(now);
> AIndyRecord_TS.value.CMD_CLASS := 100;
> aINDYCMD.value := AIndyRecord_TS.value;
> AIndyRecord_TS.unlock;
>
> LBuffer := aINDYCMD.MyRecordToByteArray(aINDYCMD.value);
>
> if (SendBuffer(AContext, LBuffer) = False) then
> begin
> TIdNotify.NotifyMethod(ShowCannotSendDataErrorMessage);
> end
> else
> begin
> TIdNotify.NotifyMethod(ShowDataSendMessage);
> end;
> end;
> 2:
> begin
> // Memo1.Lines.Add('');
> // Memo1.Lines.Add('SEND RECORD BACK TO CLIENT#2');
> // Memo1.Lines.Add('');
> aMyRecord_TS.value.Details := ' complex server response ......';
> aMyRecord_TS.value.FileName := 'TEXT TEST TEXT TEST';
> aMyRecord_TS.value.FileDate := now;
> aMyRecord_TS.value.Recordsize := Random(100);
> aMyRecord_TS.value.FileSize := 1234567890;
>
> aMyRecord.value := aMyRecord.value;
>
> LBuffer := aMyRecord.MyRecordToByteArray(aMyRecord.value);
>
> if (SendBuffer(AContext, LBuffer) = False) then
> begin
> TIdNotify.NotifyMethod(ShowCannotSendDataErrorMessage);
> end
> else
> begin
> TIdNotify.NotifyMethod(ShowDataSendMessage);
> end;
>
> end;
>
> 3:
> begin
> ///
> // Memo1.Lines.Add('record received, paint random record !');
>
> abmp.Height := 300;
> abmp.Width := 300;
>
> DrawRandomBitMap(abmp);
>
> ServerImage.Picture.Bitmap.Assign(abmp);
>
> end;
> 4:
> begin
> ///
> // Memo1.Lines.Add('send stream back !');
> ///
> aMs := TMemoryStream.Create;
> abmp.SaveToStream(aMs);
>
> if (SendStream(AContext, TStream(aMs)) = False) then
> begin
> TIdNotify.NotifyMethod(ShowCannotSendStreamDataErrorMessage);
> Exit;
> end;
>
> aMs.Free;
>
> end;
>
> else
> // end;
>
> LEDShape.brush.Color := clgreen;
>
> // Memo1.Lines.Add('server execute done');
>
> aINDYCMD.Free; aMyRecord.Free;
>
> AIndyRecord_TS.Free; aMyRecord_TS.Free;
>
> end;
>
> procedure TServerMainForm.DrawRandomBitMap(aBitMap: TBitMap); var i,
> j: Integer; rx1, rx2: Integer; ry1, ry2: Integer; w, h: Integer;
>
> begin w := aBitMap.Width; h := aBitMap.Height;
>
> abmp.Canvas.FloodFill(0, 0, clwhite, fsSurface);
>
> for i := 1 to 30 do begin
>
> randomize;
>
> rx1 := Random(w - 1);
> rx2 := Random(w - 1);
>
> ry1 := Random(h - 1);
> ry2 := Random(h - 1);
>
> aBitMap.Canvas.Pen.Color := RandomColor;
>
> aBitMap.Canvas.MoveTo(rx1, ry1);
>
> aBitMap.Canvas.LineTo(rx2, ry2);
>
> end;
>
> end;
procedure TServerMainForm.RecordReceived_TINDY_CMD;
begin
Memo1.Lines.Add('------------------< RECORD VALUES >-------------');
Memo1.Lines.Add(' CMD_Value -> ' + AIndyRecord_TS.value.CMD_VALUE);
Memo1.Lines.Add(' CMD_CLASS -> ' + INtToStr(AIndyRecord_TS.value.CMD_CLASS));
Memo1.Lines.Add(' CMD_CLASS -> ' +
dateToStr(AIndyRecord_TS.value.CMD_TIMESTAMP));
Memo1.Lines.Add('--------------------< END >----------------------')
end;
procedure TServerMainForm.RecordReceived_TMyRecord;
begin
Memo1.Lines.Add('--------------------< RECORD VALUES >----------------');
// Memo1.Lines.Add('Details ' + aMyRecord.value.Details);
// Memo1.Lines.Add('FileName = ' + aMyRecord.value.FileName);
// Memo1.Lines.Add('FileSize = ' + INtToStr(aMyRecord.value.FileSize));
// Memo1.Lines.Add('RecordSize = ' + INtToStr(aMyRecord.value.Recordsize));
Memo1.Lines.Add('--------------------< END >------------------------')
end;
///
/// ...
///
procedure TServerMainForm.ServerActiveCheckBoxClick(Sender: TObject);
begin
IdTCPServer.Active := ServerActiveCheckBox.Checked;
if IdTCPServer.Active then
LEDShape.brush.Color := clgreen
else
LEDShape.brush.Color := clred;
end;
///
/// not yet implemented ....
///
procedure TServerMainForm.ServerBindingsButtonClick(Sender: TObject);
var
SocketHandle: TIDSocketHandles;
begin
// binding set to 127.0.0.1 :: 50000
IdTCPServer.Active := False;
IdTCPServer.Bindings.Add.IPVersion := Id_IPv4;
// else, throw socket error # 98 , address already in use ...
IdTCPServer.Bindings.Add.IP := IPEdit.text; // '127.0.0.1';
IdTCPServer.Bindings.Add.Port := StrToInt(PortEdit.text); // 5000;
// customization
ServerActiveCheckBox.Checked := true;
IdTCPServer.Active := ServerActiveCheckBox.Checked;
//
MainStatusBar.SimpleText := 'server running on port ' + PortEdit.text +
' host ip ->' + IPEdit.text;
end;
///
/// get all available IP's
///
procedure TServerMainForm.PopolateIPLIstButtonClick(Sender: TObject);
var
MYIdStack: TIdStack;
begin
/// methode #1 , working with INDY IDIPWatch
IdIPWatch.Active := true;
MainStatusBar.SimpleText := IdIPWatch.LocalIP + '...' + IdIPWatch.CurrentIP;
/// meathode #2 , see ....
with IPListCheckListBox do
begin
Clear;
Items := GStack.LocalAddresses;
If IPListCheckListBox.Items.Strings[0] <> '127.0.0.1' then
Items.Insert(0, '127.0.0.1');
Checked[0] := true;
end;
end;
procedure TServerMainForm.ShowDataReceivedMessage;
begin
Memo1.Lines.Add('Data received' + TimeToStr(now));
end;
procedure TServerMainForm.ShowDataSendMessage;
begin
Memo1.Lines.Add('Data send' + TimeToStr(now));
end;
procedure TServerMainForm.ShowCannotGetDataErrorMessage;
begin
Memo1.Lines.Add('Cannot get data from client, Unknown error occured' +
TimeToStr(now));
end;
procedure TServerMainForm.ShowCannotSendDataErrorMessage;
begin
Memo1.Lines.Add('Cannot send data to client, Unknown error occured' +
TimeToStr(now));
end;
procedure TServerMainForm.ShowCannotSendStreamDataErrorMessage;
begin
Memo1.Lines.Add('Cannot send STREAM data to client, Unknown error occured' +
TimeToStr(now));
end;
procedure TServerMainForm.IdTCPServerException(AContext: TIdContext;
AException: Exception);
begin
with AContext.Connection.IOHandler do
begin
writeln('server.exception' + TimeToStr(now));
end;
end;
end.
相关客户端代码也相对于源伪造上的原始版本进行了更改，请参见此处的客户端内容
/// selct a command from a CMD List box, today only trial code
procedure TIndyClientMainForm.ClientExecuteButtonClick(Sender: TObject);
var
aINDYCMD: TGenericRecord<TINDYCMD>;
aINDYCMD_temp: TINDYCMD;
aMyRecord: TGenericRecord<TMyRecord>;
aMyRecord_temp: TMyRecord;
CmdIndex: Integer;
line: String;
LBuffer: TBytes;
aMemStream: TMemoryStream;
begin
/// very simple record type to send to the server
aINDYCMD := TGenericRecord<TINDYCMD>.Create;
aMyRecord := TGenericRecord<TMyRecord>.Create;
CmdIndex := CommandComboBox.ItemIndex;
// Memo1.Lines.Add('start client execute : ' + IntToStr(CmdIndex));
MakeINDYCommand(aINDYCMD_temp, CmdIndex);
aINDYCMD.Value := aINDYCMD_temp;
MakeMyRecord(aMyRecord_temp);
aMyRecord.Value := aMyRecord_temp;
/// start communication client server .....
LBuffer := aINDYCMD.MyRecordToByteArray(aINDYCMD.Value);
if (SendBuffer(MyIdTCPClient, LBuffer) = false) then
begin
TIdNotify.NotifyMethod(ShowCannotSendDataErrorMessage);
end
else
begin
TIdNotify.NotifyMethod(ShowDataSendMessage);
end;
case CmdIndex of
0:
/// send a string tp the server
begin
/// 'send text ;
MyIdTCPClient.IOHandler.WriteLn(SendTextEdit.Text);
TIdNotify.NotifyMethod(ShowDataSendMessage);
end;
1:
/// send INDY CMD and get INDY CMD from the server
begin
///
///
if ( NOT ReceiveBuffer(MyIdTCPClient, LBuffer)) then
begin
// 'Cannot receive record/buffer from server.'
TIdNotify.NotifyMethod(ShowCannotGetDataErrorMessage);
end
else
begin
aINDYCMD.Value := aINDYCMD.ByteArrayToMyRecord(LBuffer);
// ShowCMDRecord('ServerResponse', aINDYCMD.Value);
TIdNotify.NotifyMethod(ShowDataReceivedMessage);
end;
end;
2:
/// send INDY RECORD GET CLIENTSVR RECORD from server
begin
///
///
if (NOT ReceiveBuffer(MyIdTCPClient, LBuffer)) then
begin
// 'Cannot receive record/buffer from server.'
TIdNotify.NotifyMethod(ShowCannotGetDataErrorMessage);
end
else
begin
aMyRecord.Value := aMyRecord.ByteArrayToMyRecord(LBuffer);
TIdNotify.NotifyMethod(ShowDataReceivedMessage);
// ShowDataRecord('ServerResponse', aMyRecord.Value);
end;
end;
3:
begin
/// do nothing !!!!!!!
end;
4:
/// get a file from the server
begin
/// * todo !!!!
///
///
///
aMemStream := TMemoryStream.Create;
if (ReceiveStream(MyIdTCPClient, TStream(aMemStream)) = false) then
begin
Memo1.Lines.Add
('Cannot get STREAM from server, Unknown error occured');
Exit;
end;
ClientImage.Picture.Bitmap.LoadFromStream(TStream(aMemStream));
aMemStream.Free;
end
else
///
end;
aINDYCMD.Free;
aMyRecord.Free;
end;
我不知道为什么客户端现在在将记录发送到服务器后挂断了？服务器说他可以发送记录实际上客户端已冻结
供参考的助手 indy 包装函数
///
/// ------------- HELPER FUNCTION FOR RECORD EXCHANGE ---------------------
///
function ReceiveBuffer(AClient: TIdTCPClient; var ABuffer: TBytes)
: Boolean; overload;
var
LSize: LongInt;
begin
Result := True;
try
LSize := AClient.IOHandler.ReadLongInt();
AClient.IOHandler.ReadBytes(ABuffer, LSize, False);
except
Result := False;
end;
end;
function SendBuffer(AClient: TIdTCPClient; ABuffer: TBytes): Boolean; overload;
begin
try
Result := True;
try
AClient.IOHandler.Write(LongInt(Length(ABuffer)));
AClient.IOHandler.WriteBufferOpen;
AClient.IOHandler.Write(ABuffer, Length(ABuffer));
AClient.IOHandler.WriteBufferFlush;
finally
AClient.IOHandler.WriteBufferClose;
end;
except
Result := False;
end;
end;
function SendBuffer(AContext: TIdContext; ABuffer: TBytes): Boolean; overload;
begin
try
Result := True;
try
AContext.Connection.IOHandler.Write(LongInt(Length(ABuffer)));
AContext.Connection.IOHandler.WriteBufferOpen;
AContext.Connection.IOHandler.Write(ABuffer, Length(ABuffer));
AContext.Connection.IOHandler.WriteBufferFlush;
finally
AContext.Connection.IOHandler.WriteBufferClose;
end;
except
Result := False;
end;
end;
function ReceiveBuffer(AContext: TIdContext; var ABuffer: TBytes)
: Boolean; overload;
var
LSize: LongInt;
begin
Result := True;
try
LSize := AContext.Connection.IOHandler.ReadLongInt();
AContext.Connection.IOHandler.ReadBytes(ABuffer, LSize, False);
except
Result := False;
end;
end;
///
/// --------------------- HELP FUNCTION FOR STREAM EXCHANGE --------------
///
function ReceiveStream(AContext: TIdContext; var AStream: TStream)
: Boolean; overload;
var
LSize: LongInt;
begin
Result := True;
try
LSize := AContext.Connection.IOHandler.ReadLongInt();
AContext.Connection.IOHandler.ReadStream(AStream, LSize, False);
except
Result := False;
end;
end;
function ReceiveStream(AClient: TIdTCPClient; var AStream: TStream)
: Boolean; overload;
var
LSize: LongInt;
begin
Result := True;
try
LSize := AClient.IOHandler.ReadLongInt();
AClient.IOHandler.ReadStream(AStream, LSize, False);
except
Result := False;
end;
end;
function SendStream(AContext: TIdContext; AStream: TStream): Boolean; overload;
var
StreamSize: LongInt;
begin
try
Result := True;
try
StreamSize := (AStream.Size);
// AStream.Seek(0, soFromBeginning);
AContext.Connection.IOHandler.Write(LongInt(StreamSize));
AContext.Connection.IOHandler.WriteBufferOpen;
AContext.Connection.IOHandler.Write(AStream, 0, False);
AContext.Connection.IOHandler.WriteBufferFlush;
finally
AContext.Connection.IOHandler.WriteBufferClose;
end;
except
Result := False;
end;
end;
function SendStream(AClient: TIdTCPClient; AStream: TStream): Boolean; overload;
var
StreamSize: LongInt;
begin
try
Result := True;
try
StreamSize := (AStream.Size);
// AStream.Seek(0, soFromBeginning);
// AClient.IOHandler.LargeStream := True;
// AClient.IOHandler.SendBufferSize := 32768;
AClient.IOHandler.Write(LongInt(StreamSize));
AClient.IOHandler.WriteBufferOpen;
AClient.IOHandler.Write(AStream, 0, False);
AClient.IOHandler.WriteBufferFlush;
finally
AClient.IOHandler.WriteBufferClose;
end;
except
Result := False;
end;
end;
///
/// --------------- HELPER FUNCTIONS FOR FILES EXCHANGE ----------------
///
function ClientSendFile(AClient: TIdTCPClient; Filename: String): Boolean;
begin
AClient.IOHandler.LargeStream := True; // fully support large streams
Result := True;
try
AClient.IOHandler.WriteFile(Filename); // send file stream data
except
Result := False;
end;
end;
function ClientReceiveFile(AClient: TIdTCPClient; Filename: String): Boolean;
begin
/// todo ......
end;
function ServerSendFile(AContext: TIdContext; Filename: String): Boolean;
begin
/// todo ......
end;
function ServerReceiveFile(AContext: TIdContext; ServerFilename: String;
var ClientFilename: String): Boolean;
var
// LSize: String;
AStream: TFileStream;
begin
try
Result := True;
AStream := TFileStream.Create(ServerFilename, fmCreate + fmShareDenyNone);
try
AContext.Connection.IOHandler.ReadStream(AStream);
finally
FreeAndNil(AStream);
end;
except
Result := False;
end;
end;
///
/// --------------- HELPER FUNCTION FOR RECORD EXCHANGE ------------------
/// (not using generic syntax features of DELPHI 2009 and better )
function MyRecordToByteArray(aRecord: TMyRecord): TBytes;
var
LSource: PAnsiChar;
begin
LSource := PAnsiChar(@aRecord);
SetLength(Result, SizeOf(TMyRecord));
Move(LSource[0], Result[0], SizeOf(TMyRecord));
end;
function ByteArrayToMyRecord(ABuffer: TBytes): TMyRecord;
var
LDest: PAnsiChar;
begin
LDest := PAnsiChar(@Result);
Move(ABuffer[0], LDest[0], SizeOf(TMyRecord));
end;
function TGenericRecord<TRecordType>.MyRecordToByteArray
(aRecord: TRecordType): TBytes;
var
LSource: PAnsiChar;
begin
LSource := PAnsiChar(@aRecord);
SetLength(Result, SizeOf(TRecordType));
Move(LSource[0], Result[0], SizeOf(TRecordType));
end;
function TGenericRecord<TRecordType>.ByteArrayToMyRecord(ABuffer: TBytes)
: TRecordType;
var
LDest: PAnsiChar;
begin
LDest := PAnsiChar(@Result);
Move(ABuffer[0], LDest[0], SizeOf(TRecordType));
end;