Delphi 목마 파일 전송 코드 구현 실례

unit ServerFrm;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ComCtrls, StdCtrls, ExtCtrls,WinSock;

type
 TfrmMain = class(TForm)
  Panel1: TPanel;
  Label1: TLabel;
  edtPort: TEdit;
  Panel2: TPanel;
  stabar: TStatusBar;
  SaveDialog: TSaveDialog;
  btnListen: TButton;
  btnReceive: TButton;
  btnStop: TButton;
  btnExit: TButton;
  procedure FormCreate(Sender: TObject);
  procedure btnExitClick(Sender: TObject);
  procedure FormClose(Sender: TObject; var Action: TCloseAction);
  procedure btnListenClick(Sender: TObject);
  procedure btnReceiveClick(Sender: TObject);
  procedure btnStopClick(Sender: TObject);
 private
  { Private declarations }
 public
  { Public declarations }
  StopTrans:Boolean; //        
  InTrans:Boolean; //        
  Server:TSocket; //       socket  
  //         
  procedure RecvFile(FileName:String);
 end;

var
 frmMain: TfrmMain;

const
 BlockLen=1024*4;

implementation

{$R *.dfm}

procedure tfrmmain.RecvFile(FileName:String);
var
 Ftrans:file of Byte;
 Recelen:Integer;
 Blockbuf:array[0..BlockLen-1] of Byte;
 RecvSocket:TSocket;
 ra:Sockaddr_in;
 ra_len:integer;
begin
 ra_len:=sizeof(ra);
 Recvsocket:=accept(server,@ra,@ra_len);
 assignFile(Ftrans,filename);
 rewrite(ftrans);
 stoptrans:=false;
 intrans:=true;
 recelen:=recv(recvsocket,Blockbuf,BlockLen,0);
 while (recelen>0) and (not StopTrans) do
 begin
  BlockWrite(Ftrans,Blockbuf[0],BlockLen);
  application.ProcessMessages;
  recelen:=recv(recvsocket,Blockbuf,Blocklen,0);
  if stoptrans then
  begin
   CloseFile(Ftrans);
   CloseSocket(RecvSocket);
   InTrans:=False;
   MessageBox(Handle,'    !','  ',MB_OK);
   EXIT;
  END;
 END;
 //    ,   SOCKET
 CloseFile(Ftrans);
 Closesocket(recvsocket);
 InTrans:=False;
 if (Recelen=SOCKET_ERROR) then
  messagebox(handle,'      !','  ',MB_OK)
 ELSE
  MESSAGEBOX(HANDLE,'         1,           !','  ',MB_OK);

end; 

procedure TfrmMain.FormCreate(Sender: TObject);
var
 aWSAData:TWSAData;
begin
 if WSAStartup($0101,aWSAData)<>0 then
  raise Exception.Create('    WinSock     ');
 messageBox(Handle,aWSAdata.szDescription ,'WinSock       ',mb_ok);

end;

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
 Close;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 if InTrans then
  if MessageBox(handle,'      ,   ？','  ',MB_YESNO)=IDNO then
   abort;

 IF SERVER<>INVALID_SOCKET THEN
   CLOSESOCKET(SERVER);
  //  winsock           
 if WSACleanup<>0 then
  messagebox(handle,'  Winsock       ！','  ',MB_OK)
 ELSE
  messagebox(handle,'  Winsock       ！','  ',MB_OK);

end;

procedure TfrmMain.btnListenClick(Sender: TObject);
var
 ca:SOCKADDR_IN;
begin
 //      SOCKET
 Server:=Socket(PF_INET,SOCK_STREAM,IPPROTO_IP);
 IF server=invalid_socket then
 begin
  stabar.SimpleText :='    SOCKET  1';
  exit;
 end;
 //      SOCKET
 ca.sin_family :=PF_INET;
 CA.sin_port :=htons(strtoint(trim(edtPort.Text )));
 ca.sin_addr.S_addr :=INADDR_ANY;
 if bind(server,ca,sizeof(ca))=socket_error then
 begin
  stabar.SimpleText :='  socket  ,       ';
  closeSocket(server);
  exit;
 end
 else
  stabar.SimpleText :='     socket  !';

 //    
 listen(server,5);
 btnlisten.Enabled :=False;
 btnstop.Enabled :=true;

end;

procedure TfrmMain.btnReceiveClick(Sender: TObject);
begin
 if (server=INVALID_SOCKET) THEN
 BEGIN
  MESSAGEBOX(HANDLE,'       ,      !','  ',MB_OK);
  EXIT;
 END;
 IF SaveDialog.Execute THEN
  RECVFILE(SaveDialog.FileName );
  
end;

procedure TfrmMain.btnStopClick(Sender: TObject);
begin
 STOPTRANS:=TRUE;
 IF SERVER<>INVALID_SOCKET THEN cLOSESOCKET(SERVER);
 //      
 server:=INVALID_SOCKET;
 bTNSTOP.Enabled :=fALSE;
 BTNlISTEN.Enabled :=TRUE;
end;

end.

unit ClientFrm;

interface

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

type
 TfrmMain = class(TForm)
  opendfile: TOpenDialog;
  Label1: TLabel;
  edtIP: TEdit;
  Label2: TLabel;
  edtPort: TEdit;
  StatusBar: TStatusBar;
  btnConnect: TButton;
  btnSend: TButton;
  btnStop: TButton;
  btnExit: TButton;
  ProgressBar: TProgressBar;
  procedure FormCreate(Sender: TObject);
  procedure btnExitClick(Sender: TObject);
  procedure FormClose(Sender: TObject; var Action: TCloseAction);
  procedure btnConnectClick(Sender: TObject);
  procedure btnSendClick(Sender: TObject);
  procedure btnStopClick(Sender: TObject);
 private
  { Private declarations }
   Client:TSocket;
 public
  { Public declarations }
  StopTrans:Boolean; //         
  InTrans:Boolean;  //          
  procedure TransFile(FileName:String); //       
 end;

 const BlockLen=1024*4; //          

var frmMain: TfrmMain;

implementation{$R *.dfm}

procedure TfrmMain.TransFile(FileName:String); //       
var
 Ftrans:file of Byte;
 Flen:integer;
 BlockNum,RemainLen:integer;
 BlockBuf:array[0..BlockLen-1] of Byte;
 i:integer;
 SendLen:Integer;
begin
 assignFile(Ftrans,filename);
 reset(Ftrans);
 Flen:=FileSize(Ftrans);
 BlockNum:=Flen div BlockLen;
 progressBar.Max :=1+BlockNum;
 RemainLen:=Flen mod BlockLen;
 StopTrans:=False;
 InTrans:=True;
 SendLen:=1;
 for i:=0 to BlockNum-1 do
 begin
  if (StopTrans) or (SendLen<=0) then Break;
  BlockRead(Ftrans,Blockbuf[0],BlockLen);
  SendLen:=Send(Client,Blockbuf,BlockLen,0);
  ProgressBar.Position :=i;
  Application.processMessages;
 end;
 if StopTrans then
 begin
  CloseFile(Ftrans);
  InTrans:=False;
  StatusBar.SimpleText :='';
  MessageBox(Handle,'    !','  ',mb_ok);
  progressbar.Position :=0;
  exit;
 end;
 if (SendLen<=0) then
 begin
  CloseFile(Ftrans);
  InTrans:=False;
  StatusBar.SimpleText :='';
  messagebox(handle,'      !','  ',MB_OK);
  progressBar.Position :=0;
  exit;
 end;
 if remainLen>0 then
 begin
  BlockRead(Ftrans,BlockBuf[0],RemainLen);
  SendLen:=send(client,BlockBuf,Remainlen,0);
  if (sendLen<=0) then
  begin
   closeFile(Ftrans);
   InTrans:=False;
   StatusBar.SimpleText :='';
   messagebox(handle,'      !','  ',mb_ok);
   progressBar.Position :=0;
   exit;
  end;
 end;
 progressBar.Position :=ProgressBar.Max ;
 CloseFile(Ftrans);
 InTrans:=False;
 StatusBar.SimpleText :='';
 messagebox(handle,'    !','  ',mb_ok);
 progressbar.Position :=0;

end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
 aWSAData:TWSAData;
begin
 if WSAStartup($0101,aWSAData)<>0 then
  raise Exception.Create('    WinSock     ');
 messageBox(Handle,aWSAdata.szDescription ,'WinSock       ',mb_ok);

end;

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
 Close;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 if InTrans then
  if MessageBox(handle,'      ,   ？','  ',MB_YESNO)=IDNO then
   abort;
  //  winsock           
  if WSACleanup<>0 then
   messagebox(handle,'  Winsock       ！','  ',MB_OK)
  ELSE
   messagebox(handle,'  Winsock       ！','  ',MB_OK);
  CloseSocket(Client);
end;

procedure TfrmMain.btnConnectClick(Sender: TObject);
var
 ca:SOCKADDR_IN;
 hostaddr:u_long;
begin
 Client:=Socket(PF_INET,SOCK_STREAM,IPPROTO_IP);
 IF CLIENT=INVALID_SOCKET THEN
 BEGIN
  StatusBar.SimpleText :='           COSKET  !';
  exit;
 end;
 ca.sin_family :=PF_INET;
 CA.sin_port :=HTONS(STRTOINT(TRIM(EDTpORT.Text )));
 HOSTADDR:=INET_ADDR(PCHAR(TRIM(EDTIP.Text )));
 //  IP    
 if (hostaddr= -1) then
 begin
  StatusBar.SimpleText :='  IP  ：'+trim(edtip.Text )+'  ';
  exit;
 end
 else
  ca.sin_addr.S_addr :=hostaddr;
 //     
 if connect(Client,ca,sizeof(ca))<>0 then
 begin
  StatusBar.SimpleText :='      SOCKET  !';
  exit;
 end
 else
  StatusBar.SimpleText :='    SOCKET  !';

end;

procedure TfrmMain.btnSendClick(Sender: TObject);
begin
 if (opendfile.Execute ) and (FileExists(opendfile.FileName )) then
  transFile(opendfile.FileName );
end;

procedure TfrmMain.btnStopClick(Sender: TObject);
begin
 Stoptrans:=True;
end;

end.