delphi帮助套接字文件发送 [英] delphi help with sockets file send

问题描述

我该如何解决此代码，不确定是否可以在线程内使用消息循环

how can i fix this code, not sure if can i use message loops inside threads

program pClient;

{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils,
  Classes,
  SimpleTcp;

var
  Stream: TMemoryStream;

procedure ReadFile(nSize: Dword; Socket: TTcpSocket);
var
  Buffer: array[0..4096] of Char;
  Read, CurrRead, BuffSize: Dword;
begin
  BuffSize := SizeOf(Buffer);
  Stream.Clear;
  Stream.SetSize(nSize);
  Read := 0;
  while (Read < nSize) and (Socket.Active) do
  begin
    if (nSize - Read) >= BuffSize then
      CurrRead := BuffSize
    else
      CurrRead := (nSize - Read);
    Socket.Read(Buffer, CurrRead);
    Stream.Write(Buffer, CurrRead);
    Read := Read + CurrRead;
  end;
  Stream.Position := 0;
end;

procedure ProcessData(Socket: TTcpSocket);
var
  Data: string;
  FileSize: Dword;
begin
  while Socket.Active do
  begin
    Socket.ReadLn(Data);
    if Length(Data) > 0 then
    begin
      if Pos(''HELLO'', Data) > 0 then
      begin
        WriteLn(''1 PROC'');
        Delete(Data, 1, Pos(''|'', Data));
        FileSize := StrToInt(Data);
        Stream := TMemoryStream.Create;
        ReadFile(FileSize, Socket);
        Stream.SaveToFile(''REC.PNG'');
        Stream.Free;
        WriteLn(''2 PROC'');
      end;
    end;
    Sleep(5);
  end;
end;

procedure Client(Thread: TThreadProc);
var
  TcpClient: TTcpClient;
begin
  TcpClient := TTcpClient.Create(''localhost'', 1500);
  if TcpClient.Active then
  begin
    TcpClient.WriteLn(''HELLO'');
    ProcessData(TcpClient);
  end;
end;

var
  Msg: TMsg;

begin
  StartThread(@Client);
  while GetMessage(Msg, 0, 0, 0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end.

program pServer;

{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils,
  Classes,
  SimpleTcp;

var
  Stream: TMemoryStream;

procedure SendFile(Socket: TTcpSocket);
var
  Buffer: array[0..4096] of Char;
  Read, CurrRead, BuffSize: Dword;
begin
  BuffSize := SizeOf(Buffer);
  Read := 0;
  while (Read < Stream.Size) and Socket.Active do
  begin
    if (Stream.Size - Read) >= BuffSize then
      CurrRead := BuffSize
    else
      CurrRead := (Stream.Size - Read);
    Stream.Read(Buffer, CurrRead);
    Socket.Write(Buffer, CurrRead);
    Read := Read + CurrRead;
  end;
end;

procedure ProcessData(Socket: TTcpSocket);
var
  Data: string;
begin
  while Socket.Active do
  begin
    Socket.ReadLn(Data);
    if Length(Data) > 0 then
    begin
      if Pos(''HELLO'', Data) > 0 then
      begin
        WriteLn(''1 PROC'');
        Stream := TMemoryStream.Create;
        Stream.LoadFromFile(''IMG.PNG'');
        Socket.WriteLn(''HELLO|'' + IntToStr(Stream.Size));
        SendFile(Socket);
        Stream.Free;
        WriteLn(''2 PROC'');
      end;
    end;
    Sleep(5);
  end;
end;

procedure Server(Thread: TThreadProc);
var
  TcpServer: TTcpServer;
  TcpSocket: TTcpSocket;
begin
  TcpServer := TTcpServer.Create(1500);
  TcpSocket := TcpServer.Accept;
  if TcpSocket.Active then
  begin
    ProcessData(TcpSocket);
  end;
end;

var
  Msg: TMsg;

begin
  StartThread(@Server);
  while GetMessage(Msg, 0, 0, 0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end.

推荐答案

APPTYPE CONSOLE} 用途 视窗， SysUtils， 班级 SimpleTcp; 变种 流:TMemoryStream; 过程ReadFile(nSize:Dword;套接字:TTcpSocket); 变种 缓冲区:字符数组[0..4096]； 读取，CurrRead，BuffSize:Dword； 开始 BuffSize:= SizeOf(缓冲区); Stream.Clear; Stream.SetSize(nSize); 读:= 0; 而(Read< nSize)和(Socket.Active)做 开始 如果(nSize-读取)> = BuffSize然后 CurrRead:= BuffSize 别的 CurrRead:=(nSize-读取); Socket.Read(Buffer，CurrRead); Stream.Write(Buffer，CurrRead); 读:=读+ CurrRead; 结尾; Stream.Position:= 0; 结尾; 程序ProcessData(Socket:TTcpSocket); 变种 数据:字符串； FileSize:Dword； 开始 而Socket.Active做 开始 Socket.ReadLn(Data); 如果Length(Data)>然后0 开始 如果Pos(``HELLO''，Data)>然后0 开始 WriteLn(''1 PROC''); Delete(Data，1，Pos(''|''，Data)); FileSize:= StrToInt(Data); 流:= TMemoryStream.Create; ReadFile(FileSize，Socket); Stream.SaveToFile(''REC.PNG''); 流免费 WriteLn(''2 PROC''); 结尾; 结尾; 睡眠(5); 结尾; 结尾; 程序Client(Thread:TThreadProc); 变种 TcpClient:TTcpClient； 开始 TcpClient:= TTcpClient.Create(``本地主机''，1500); 如果TcpClient.Active然后 开始 TcpClient.WriteLn(``HELLO''); ProcessData(TcpClient); 结尾; 结尾; 变种 讯息:TMsg; 开始 StartThread(@Client); 而GetMessage(Msg，0，0，0)做 开始 TranslateMessage(Msg); DispatchMessage(Msg); 结尾; 结束.

APPTYPE CONSOLE} uses Windows, SysUtils, Classes, SimpleTcp; var Stream: TMemoryStream; procedure ReadFile(nSize: Dword; Socket: TTcpSocket); var Buffer: array[0..4096] of Char; Read, CurrRead, BuffSize: Dword; begin BuffSize := SizeOf(Buffer); Stream.Clear; Stream.SetSize(nSize); Read := 0; while (Read < nSize) and (Socket.Active) do begin if (nSize - Read) >= BuffSize then CurrRead := BuffSize else CurrRead := (nSize - Read); Socket.Read(Buffer, CurrRead); Stream.Write(Buffer, CurrRead); Read := Read + CurrRead; end; Stream.Position := 0; end; procedure ProcessData(Socket: TTcpSocket); var Data: string; FileSize: Dword; begin while Socket.Active do begin Socket.ReadLn(Data); if Length(Data) > 0 then begin if Pos(''HELLO'', Data) > 0 then begin WriteLn(''1 PROC''); Delete(Data, 1, Pos(''|'', Data)); FileSize := StrToInt(Data); Stream := TMemoryStream.Create; ReadFile(FileSize, Socket); Stream.SaveToFile(''REC.PNG''); Stream.Free; WriteLn(''2 PROC''); end; end; Sleep(5); end; end; procedure Client(Thread: TThreadProc); var TcpClient: TTcpClient; begin TcpClient := TTcpClient.Create(''localhost'', 1500); if TcpClient.Active then begin TcpClient.WriteLn(''HELLO''); ProcessData(TcpClient); end; end; var Msg: TMsg; begin StartThread(@Client); while GetMessage(Msg, 0, 0, 0) do begin TranslateMessage(Msg); DispatchMessage(Msg); end; end.

program pServer;

{

APPTYPE CONSOLE} uses Windows, SysUtils, Classes, SimpleTcp; var Stream: TMemoryStream; procedure SendFile(Socket: TTcpSocket); var Buffer: array[0..4096] of Char; Read, CurrRead, BuffSize: Dword; begin BuffSize := SizeOf(Buffer); Read := 0; while (Read < Stream.Size) and Socket.Active do begin if (Stream.Size - Read) >= BuffSize then CurrRead := BuffSize else CurrRead := (Stream.Size - Read); Stream.Read(Buffer, CurrRead); Socket.Write(Buffer, CurrRead); Read := Read + CurrRead; end; end; procedure ProcessData(Socket: TTcpSocket); var Data: string; begin while Socket.Active do begin Socket.ReadLn(Data); if Length(Data) > 0 then begin if Pos(''HELLO'', Data) > 0 then begin WriteLn(''1 PROC''); Stream := TMemoryStream.Create; Stream.LoadFromFile(''IMG.PNG''); Socket.WriteLn(''HELLO|'' + IntToStr(Stream.Size)); SendFile(Socket); Stream.Free; WriteLn(''2 PROC''); end; end; Sleep(5); end; end; procedure Server(Thread: TThreadProc); var TcpServer: TTcpServer; TcpSocket: TTcpSocket; begin TcpServer := TTcpServer.Create(1500); TcpSocket := TcpServer.Accept; if TcpSocket.Active then begin ProcessData(TcpSocket); end; end; var Msg: TMsg; begin StartThread(@Server); while GetMessage(Msg, 0, 0, 0) do begin TranslateMessage(Msg); DispatchMessage(Msg); end; end.

APPTYPE CONSOLE} uses Windows, SysUtils, Classes, SimpleTcp; var Stream: TMemoryStream; procedure SendFile(Socket: TTcpSocket); var Buffer: array[0..4096] of Char; Read, CurrRead, BuffSize: Dword; begin BuffSize := SizeOf(Buffer); Read := 0; while (Read < Stream.Size) and Socket.Active do begin if (Stream.Size - Read) >= BuffSize then CurrRead := BuffSize else CurrRead := (Stream.Size - Read); Stream.Read(Buffer, CurrRead); Socket.Write(Buffer, CurrRead); Read := Read + CurrRead; end; end; procedure ProcessData(Socket: TTcpSocket); var Data: string; begin while Socket.Active do begin Socket.ReadLn(Data); if Length(Data) > 0 then begin if Pos(''HELLO'', Data) > 0 then begin WriteLn(''1 PROC''); Stream := TMemoryStream.Create; Stream.LoadFromFile(''IMG.PNG''); Socket.WriteLn(''HELLO|'' + IntToStr(Stream.Size)); SendFile(Socket); Stream.Free; WriteLn(''2 PROC''); end; end; Sleep(5); end; end; procedure Server(Thread: TThreadProc); var TcpServer: TTcpServer; TcpSocket: TTcpSocket; begin TcpServer := TTcpServer.Create(1500); TcpSocket := TcpServer.Accept; if TcpSocket.Active then begin ProcessData(TcpSocket); end; end; var Msg: TMsg; begin StartThread(@Server); while GetMessage(Msg, 0, 0, 0) do begin TranslateMessage(Msg); DispatchMessage(Msg); end; end.

请告诉我们您的问题是什么.

please tell us what is your problem.

这篇关于delphi帮助套接字文件发送的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！