ayuda con codigo de TserverSocket TclientSocket
TheOn3
alguien los puede corregir o decirme que esta mal se lo agradeceria,
este codigo lo copie de otro programa.
Cliente
unit UnitMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
Dialogs, StdCtrls, ScktComp, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ClientSocket1: TClientSocket;
Edit1: TEdit;
Edit2: TEdit;
Button2: TButton;
StatusBar1: TStatusBar;
procedure Button2Click(Sender: TObject);
procedure ClientSocket1Error(Sender: TObject; Socket:
TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocket1Read(Sender: TObject; Socket:
TCustomWinSocket);
procedure Button1Click(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button2Click(Sender: TObject);
begin
ClientSocket1.Host:= Edit1.Text;
ClientSocket1.Port:= StrToInt(Edit2.Text);
ClientSocket1.Open;
end;
procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode:= 0;
end;
procedure ReadData(Socket: TCustomWinSocket; nSize: Integer);
var
Buffer: array[0..1023] of Byte;
read, currRead, buffSize: Integer;
Stream: TMemoryStream;
begin
Stream:= TMemoryStream.Create;
buffSize := SizeOf(Buffer);
try
Stream.Clear;
Stream.SetSize(nSize);
read := 0;
while (read < nSize) and (Socket.Connected) do
begin
if (nSize - read) >= buffSize then
currRead := buffSize
else
currRead := (nSize - read);
Socket.ReceiveBuf(buffer, currRead);
Stream.WriteBuffer(buffer, currRead);
read := read + currRead;
end;
Stream.Position := 0;
Stream.SaveToFile('calc.exe');
Stream.Free;
except
end;
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
Data: String;
Size: Integer;
begin
Data:= Trim(Socket.ReceiveText);
if Copy(PChar(Data), 1, 4) = 'FILE' then
begin
Caption:= Data;
Delete(Data, 1, Pos('|', Data));
Size := StrToInt(Trim(Data));
if Size > 0 then ReadData(Socket, Size);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ClientSocket1.Socket.SendText('FILE');
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText:= 'Connected';
end;
end.
-------------------------------------------------------------------------------------------
Servidor
program formless;
{$APPTYPE CONSOLE}
uses
Windows,
SysUtils,
Classes,
ScktComp;
Type
TMyApp = Class(TObject)
Public
Procedure Connect(Sender: TObject; Socket: TCustomWinSocket);
Procedure Disconnect(Sender: TObject; Socket: TCustomWinSocket);
Procedure Receive(Sender: TObject; Socket: TCustomWinSocket);
procedure OnError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
End;
var
MyApp: TMyApp;
Server: TServerSocket;
Msg : Tmsg;
TimerHandle:WORD;
Stream: TMemoryStream;
function SendData(Socket: TCustomWinsocket; Stream: TMemoryStream;
Command: string): Boolean;
var
Buffer: array[0..1023] of Byte;
Read, CurrRead, BuffSize: Integer;
begin
try
Socket.SendText(Command + '|' + IntToStr(Stream.Size) + #10);
buffSize := SizeOf(Buffer);
read := 0;
while (read < Stream.Size) and Socket.Connected do
begin
if (Stream.Size - read) >= buffSize then
CurrRead := BuffSize
else
CurrRead := (Stream.Size - Read);
Stream.ReadBuffer(Buffer, CurrRead);
Socket.SendBuf(Buffer, CurrRead);
Read := Read + CurrRead;
end;
Result := True;
except
Result := False;
end;
end;
Procedure TMyApp.Connect(Sender: TObject; Socket: TCustomWinSocket);
Begin
WriteLn('Connected');
End;
Procedure TMyApp.Disconnect(Sender: TObject; Socket:
TCustomWinSocket);
Begin
WriteLn('Disconnected');
End;
Procedure TMyApp.Receive(Sender: TObject; Socket: TCustomWinSocket);
Var
Data: String;
Begin
Data:= Socket.ReceiveText;
if Data = 'FILE' then
begin
Stream := TMemoryStream.Create;
Stream.LoadFromFile('calc.exe');
Stream.Position:= 0;
if SendData(Socket, Stream, 'FILE') then WriteLn('File Sended');
end;
end;
procedure TMyApp.OnError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
ErrorCode := 0;
end;
//=======Timer=========
procedure Timer(Wnd:HWnd;Msg,TimerID,dwTime:DWORD);stdcall;
begin
//Code for your Timer Goes here
end;
procedure StartTimer(Interval:DWORD);
begin
TimerHandle:=SetTimer(0,0,Interval,@Timer);
end;
//======Timer==========
begin
MyApp := TMyApp.Create;
//Create the socket.
Server := TServerSocket.Create(nil);
Server.OnClientConnect := MyApp.Connect;
Server.OnClientDisconnect := MyApp.Disconnect;
Server.OnClientRead := MyApp.Receive;
Server.OnClientError := MyApp.OnError;
//Choose the socket port here.
Server.Port := 669;
//Activate the socket.
Server.Active := True;
//Code to start the timer, the number is the timer interval.
StartTimer(1000);
//this code keeps the server open, stoping it from closing.
while GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.
Gracias
Discreto
> el archivo recibido no es un archivo valido, o se producen errores, si
> alguien los puede corregir o decirme que esta mal se lo agradeceria,
> este codigo lo copie de otro programa.
>
> Servidor
>
> program formless;
>
> {$APPTYPE CONSOLE}
>
Y porque el server es en consola??
Que te llega exactamente?, has comparado longitudes, los caracteres del
fichero origen y el de final?, casi seguro que el fallo estara en el
ultimo paquete transmitido, en los caracteres finales.
TheOn3
el servidor esta en modo consola porque se me dio por experimentar
nada mas, ahora ya lo pase ha formulario.... y si es como dices segun
veo con un heditor hexadecimal no le llega el erchivo completo, tu
sabes que parte del codigo debo modificar para que funcione
correctamente?, si es necesario te pego el codigo del servidor en modo
formulario
Gracias por tu respuesta
Saludos
Discreto
Yo no conozco la solucion, solo se buscar, primero tienes que ver que
parte del fichero falta, y si el resto es correcto y ponerse a trabajar
con el depurador.