Показать сообщение отдельно
  #4  
Старый 26.05.2011, 09:38
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

один из вариантов:
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp;

type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    ClientSocket1: TClientSocket;
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
    FPipeRead: THandle;
    FPipeWrite: THandle;
    FDataLen: DWORD;
    FDataRead: DWORD;
    FFileStream: TFileStream;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  CreatePipe(FPipeRead, FPipeWrite, nil, $8000);
  FDataLen:=0;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseHandle(FPipeWrite);
  CloseHandle(FPipeRead);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ClientSocket1.Open;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo1.Lines.Add('Client Connect');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  FileStream: TFileStream;
  len: DWORD;
begin
  FileStream:=TFileStream.Create(Edit1.Text, fmOpenRead);
  try
    len:=FileStream.Size;
    ClientSocket1.Socket.SendBuf(len, SizeOf(len));
    ClientSocket1.Socket.SendStream(FileStream);
  except
    FileStream.Free;
  end;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  Len: Integer;
  Buffer: PChar;
  dummy: Cardinal;
begin
  Len:=Socket.ReceiveLength;
  Buffer:=GetMemory(Len);
  try
    Len:=Socket.ReceiveBuf(Buffer^, Len);
    WriteFile(FPipeWrite, Buffer^, Len, dummy, nil);
  finally
    FreeMemory(Buffer);
  end;
  while True do
  begin
    Len:=GetFileSize(FPipeRead, nil);
    if Len=0 then Break;
    if FDataLen=0 then
    begin
      if Len<SizeOf(DWORD) then Break;
      ReadFile(FPipeRead, FDataLen, SizeOf(DWORD), dummy, nil);
      FDataRead:=0;
      FFileStream:=TFileStream.Create(Edit2.Text, fmCreate);
    end else
    begin
      Buffer:=GetMemory(Len);
      try
        ReadFile(FPipeRead, Buffer^, Len, dummy, nil);
        FFileStream.Write(Buffer^, Len);
        Inc(FDataRead, Len);
        if FDataRead=FDataLen then
        begin
          FFileStream.Free;
          FDataLen:=0;
          Memo1.Lines.Add('Ok');
        end;
      finally
        FreeMemory(Buffer);
      end;
    end;
  end;
end;

end.

!!!Проверки и очистки ресурсов при дисконнекте нет!!!
Вложения
Тип файла: rar CloseSchool.rar (160.2 Кбайт, 409 просмотров)
__________________
Пишу программы за еду.
__________________
Ответить с цитированием