Click here to Skip to main content
Rate this: bad
good
Please Sign up or sign in to vote.
See more: Delphi socket
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.
Posted 28-Nov-10 15:41pm
Comments
HimanshuJoshi at 29-Nov-10 14:42pm
   
Please specify what is the problem you are facing.

1 solution

Rate this: bad
good
Please Sign up or sign in to vote.

Solution 1

please tell us what is your problem.
  Permalink  
Comments
Richard MacCutchan at 6-Dec-11 15:26pm
   
Did you notice this question is more than a year old? There is little point in responding to such posts.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

  Print Answers RSS
0 OriginalGriff 406
1 /\jmot 180
2 Suraj Sahoo | Coding Passion 170
3 Afzaal Ahmad Zeeshan 159
4 BillWoodruff 154
0 OriginalGriff 8,344
1 Sergey Alexandrovich Kryukov 7,407
2 DamithSL 5,634
3 Maciej Los 5,024
4 Manas Bhardwaj 4,986


Advertise | Privacy | Mobile
Web02 | 2.8.1411023.1 | Last Updated 6 Dec 2011
Copyright © CodeProject, 1999-2014
All Rights Reserved. Terms of Service
Layout: fixed | fluid

CodeProject, 503-250 Ferrand Drive Toronto Ontario, M3C 3G8 Canada +1 416-849-8900 x 100