Хочу чтоб когда у меня отправился файл на сервер сервер прислал сообщение клинту что все ок дошло можно делать дисконект. Отправка файла работает отлично а вот с остальным сложности возникли. Вот клиент
| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient;
type
TForm1 = class(TForm)
IdTCPClient1: TIdTCPClient;
OpenDialog1: TOpenDialog;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
private
procedure SendFile(user, fn: string);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
IF OpenDialog1.Execute Then
SendFile('User1', OpenDialog1.FileName);
end;
procedure TForm1.SendFile(user, fn: string);
Var
S:string;
begin
try
IdTCPClient1.Connect;
IdTCPClient1.IOHandler.WriteLn(user);
IdTCPClient1.IOHandler.WriteFile(fn, true);
// ShowMessage(IdTCPClient1.IOHandler.ReadLn);
IdTCPClient1.Disconnect;
except
ShowMessage('Не удалось отправить данные. Проверьте имя пользователя и пароль.');
end;
end;
end.
|
Вот сервер
| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer,IdContext,
StdCtrls, IdUserAccounts;
const
MAX_BUF_SIZE = $4095;
type
TMyConnection=Class
Public
FStream: TFileStream;
FileName:String;
Buffer: Array [0..MAX_BUF_SIZE] OF Char;
End;
TConnectionMng=Class
Public
Count:Integer;
Connections:Array OF TMyConnection;
Function Add:TMyConnection;
Procedure Delete(index:Integer);
End;
TForm1 = class(TForm)
IdTCPServer1: TIdTCPServer;
Memo1: TMemo;
Button1: TButton;
procedure IdTCPServer1Execute(AContext: TIdContext);
procedure Button1Click(Sender: TObject);
procedure IdTCPServer1Disconnect(AContext: TIdContext);
procedure FormCreate(Sender: TObject);
procedure IdTCPServer1Connect(AContext: TIdContext);
procedure IdUserManager1AfterAuthentication(Sender: TObject;
const AUsername: string; var VPassword: string; var VUserHandle: Cardinal;
var VUserAccess: Integer);
private
{ Private declarations }
public
ConnectionMng:TConnectionMng;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
IdTCPServer1.Active:= true;
Memo1.Lines.Add('Start');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ConnectionMng:=TConnectionMng.Create;
end;
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
begin
Memo1.Lines.Add('Client online IP'+AContext.Binding.PeerIP);
end;
procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
begin
Memo1.Lines.Add('Down');
end;
Procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
s: string;
Begin
s:=AContext.Connection.IOHandler.ReadLn;
IF (s='User1') Then
begin
ConnectionMng.Add;
AContext.Connection.IOHandler.ReadStream(ConnectionMng.Connections[ConnectionMng.Count-1].FStream, -1, true);
ConnectionMng.Delete(ConnectionMng.Count-1);
Memo1.Lines.Add('Finish');
end;
Begin
AContext.Connection.Disconnect;
End;
End;
procedure TForm1.IdUserManager1AfterAuthentication(Sender: TObject;
const AUsername: string; var VPassword: string; var VUserHandle: Cardinal;
var VUserAccess: Integer);
begin
end;
{ TConnectionMng }
function TConnectionMng.Add: TMyConnection;
Var
I:Integer;
Begin
Inc(Count);
SetLength(Connections,Count);
Result:=TMyConnection.Create;
Connections[Count-1]:=Result;
I:=0;
Result.FileName:=IntToStr(I)+'.avi';
While FileExists(Result.FileName) Do
Begin
Inc(I);
Result.FileName:=IntToStr(I)+'.avi';
End;
Result.FStream:= TFileStream.Create(Result.FileName, fmCreate)
End;
procedure TConnectionMng.Delete(index: Integer);
begin
Connections[Index].FStream.Free;
IF (Count<0) or (Count<=Index) Then Exit;
Connections[Index]:=Connections[Count-1];
Dec(Count);
SetLength(Connections,Count);
end;
end.
|
|
)