PDA

View Full Version : کمک برای تکمیل کردن برنامه ارسال و دریافت فایل در شبکه Send File Socket



saeidsg
سه شنبه 01 فروردین 1391, 23:15 عصر
سورس برنامه ها هست ارسال و دریافت به خوبی کارمی کنه ولی اگر هم زمان اگر چند فایل ارسال بشود نمی توانم کنترل کنم خواهش می کنم کمک کنید با تشکر


unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ScktComp, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
Edit1: TEdit;
Edit2: TEdit;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
ClientSocket1: TClientSocket;
ClientSocket2: TClientSocket;
Edit3: TEdit;
Label3: TLabel;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket2Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
Streamsize: TFileStream;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// Written by Me ColdFuzion
// Program Purpose : To Sendfiles to the recieving file program
// All i ask is whoever uses my code gives me a little credit my e-mail is ColdFuzion@hushmail.com (ColdFuzion@hushmail.com)
// Reason for using 2 sockets is because its meant to be more like a messenger client where one socket is used for communication and so on.. while the other is soley used for sending files
procedure TForm1.Button1Click(Sender: TObject);
begin
ClientSocket1.Address := Edit3.Text;
ClientSocket1.Open; // Open rather than active so it can bypass firewalls
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add('Connected to ' +Socket.RemoteHost); // Shows the address of the server you connect to
end;
procedure TForm1.ClientSocket2Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add('Sending File ' +Edit1.Text +' .........')
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if ClientSocket1.Active = True then
begin
OpenDialog1.Filter := 'All Files (*.*)'; // you can add more choices by adding | and followed by description and (*.extension)
OpenDialog1.FilterIndex := 1; // Here you follow which index number from above you want
if OpenDialog1.Execute then
begin
Edit1.Text := ExtractFileName(OpenDialog1.FileName); // To send as filename after
ClientSocket1.Socket.SendText('FILE!'+Edit1.Text);
sleep(800); // Need to sleep so the other end has time to process the commands
Streamsize := TFileStream.Create(OpenDialog1.FileName, fmopenread); // Stream created just to Calculate size
Edit2.Text := inttostr(Streamsize.Size);
Sleep(800);
ClientSocket1.Socket.SendText('SIZE!'+Edit2.Text); // Sends filesize through primary socket
Streamsize.Position := 0;
Streamsize.Free;
sleep(800);
ClientSocket2.Address := Edit3.Text;
ClientSocket2.Open; // ready to send file on second socket
if ClientSocket2.Socket.SendStream(TFileStream.Create (OpenDialog1.FileName, fmopenRead)) then memo1.Lines.Add('File Sent');
// above creates a stream and sends as a stream its in a if line because this is the only way it will automatically check the byte order and send the whole stream
end;
end
else
MessageDlg('Error: You are not connected', mtError, [MbOK],0); // Error Check above code won't work until the socket is connected
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Text := '';
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var IncommingText, StrippedData, CommandName: string;
begin
IncommingText := socket.ReceiveText; // Put all incoming data into this string
StrippedData := copy(IncommingText,6,length(IncommingText) ); // letters 6 to end is the actual data being sent
CommandName := copy(IncommingText,0,5); // letters 0 to 5 is the fixed letter space for the command name
if CommandName = 'DONE!' then // Expected command Done! note : This is case sensitive so match has to be the same case
begin
Memo1.Lines.Add('File ' +Edit1.Text +' ' +Edit2.Text +' was Recieved Successfully');
ClientSocket2.Active := False; // Turns off the file sending socket as file confirmation has been sent from the other end
Edit1.Text := '';
Edit2.Text :='';
end;
end;
end.




================================================== ===============


unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp, ComCtrls, idglobal, ExtCtrls, ShellAPI;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Label1: TLabel;
ServerSocket1: TServerSocket;
ServerSocket2: TServerSocket;
GroupBox1: TGroupBox;
Edit1: TEdit;
Edit2: TEdit;
Label2: TLabel;
Label3: TLabel;
ProgressBar1: TProgressBar;
Timer1: TTimer;
StatusBar1: TStatusBar;
procedure Button1Click(Sender: TObject);
procedure ServerSocket1Accept(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket2Accept(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket2ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
IncommingStream: TFileStream;
TimeTaken: integer;
public
{ Public declarations }
end;
var
Form1: TForm1;
iCount : Integer;
implementation
{$R *.dfm}
// Written by me ColdFuzion
// All i ask is i be given some credit for coding this my e-mail is ColdFuzion@hushmail.com (ColdFuzion@hushmail.com)
// Program Usage: To recieve Files sent by the client
procedure TForm1.Button1Click(Sender: TObject);
begin
iCount := 0;
ServerSocket1.Open;
Memo1.Lines.Add('Server Listening on '+inttostr(ServerSocket1.Port) );
end;
procedure TForm1.ServerSocket1Accept(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add('Client connected From '+Socket.RemoteHost)
// Adds the clients host as it connects
end;
procedure TForm1.ServerSocket2Accept(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add('Incoming File Transfer');
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
IncommingText, StrippedData, CommandName: string;
begin
IncommingText := socket.ReceiveText;
StrippedData := copy(IncommingText,6,length(IncommingText) );
CommandName := copy(IncommingText,0,5);

if CommandName = 'FILE!' then begin
IncommingStream := TFileStream.Create(StrippedData, fmCREATE or fmOPENWRITE and fmsharedenywrite); // Once File name is recieved the stream to recieve
Edit1.Text := StrippedData; // The file is created
ServerSocket2.Open;
end else
if CommandName = 'SIZE!' then begin
Edit2.Text := StrippedData;
ProgressBar1.Max := StrToInt(StrippedData);
ProgressBar1.Min := 0;
Memo1.lines.Add('Recieving File '+Edit1.Text +' of size '+Edit2.Text);
end;
if iCount = 5 then iCount := 0;
Inc(iCount);
end;
procedure TForm1.ServerSocket2ClientRead(Sender: TObject;
// This is the secondary socket it is the most important part of the program
Socket: TCustomWinSocket);
// It processes the incomming file stream
var Buffer: array [0..9999] of Char;
IncommingLen, RecievedLen: integer;
Filepath: string;
begin
Buffer := '';
Timer1.Enabled := True;
IncommingLen := socket.ReceiveLength;
// If the size of any incomming data is the size of 0 then the process begins
Filepath := ExtractFilePath(Edit1.Text)+Edit1.Text;
// Sets a String Filepath for the actual directory with the filename so that the shellexecute can run this after
while IncommingLen > 0 do
// Must make sure the process ends
begin
RecievedLen := socket.ReceiveBuf(Buffer, Sizeof(Buffer));
// Changes the size of RecievedLen by the amount of incoming data recieved
if RecievedLen <= 0 then
// Small part of the code where once the buffer reaches 0 the code will exit
Break
else
IncommingStream.Write(Buffer, RecievedLen);
// Writes the Incoming data into a new stream by the filename and size which is recieved
ProgressBar1.StepBy(RecievedLen);
// through the primary socket Also this line increases the progess indicator bar
if IncommingStream.Size >= strtoint(Edit2.Text) then
// Onces the stream size begins to reach the size which was sent before sending the file then this
begin
// procedure will start
IncommingStream.Free;
// Free's the stream
memo1.Lines.Add('File '+Edit1.Text +' Recieved Successfuly');
memo1.Lines.Add('Time Taken to Recieve File ' +IntToStr(TimeTaken)+' seconds');
ServerSocket1.Socket.Connections[0].SendText('DONE!');
Edit1.Text := '';
// From here it starts setting the variables back
Edit2.Text := '';
ProgressBar1.Position := 0;
Timer1.Enabled := False;
TimeTaken := 0;
{ if Messagedlg('Would you Like to open the recieved file?', mtConfirmation, [MbYes,MbNo],0) = MrYes then // Simply asks the user if he wants to open the file if yes will execute if no break
begin
ShellExecute(Form1.Handle, 'open', pchar(Filepath),nil, nil, SW_NORMAL); // A shellapi was added to uses to beable to execute this line
end;}
Break; // This line basically executes any file using the extension from the windows ini files.
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Text := '';
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
inc(TimeTaken,1);
// Counts number of seconds starts once the filestream begins
end;
end.