1

此代码基于使用 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;
4

0 回答 0