ClientFrm.pas
上传用户:psxgmh
上传日期:2013-04-08
资源大小:15112k
文件大小:5k
源码类别:

Delphi/CppBuilder

开发平台:

Delphi

  1. unit ClientFrm;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5.   StdCtrls, Buttons, ComCtrls, WinSock, ExtCtrls;
  6. type
  7.   TFrmMain = class(TForm)
  8.     progressBar: TProgressBar;
  9.     Statusbar: TStatusBar;
  10.     Panel1: TPanel;
  11.     Label1: TLabel;
  12.     Label2: TLabel;
  13.     btnSend: TBitBtn;
  14.     btnStop: TBitBtn;
  15.     btnExit: TBitBtn;
  16.     edtIP: TEdit;
  17.     edtPort: TEdit;
  18.     OpenDFile: TOpenDialog;
  19.     btnConnect: TBitBtn;
  20.     procedure btnExitClick(Sender: TObject);
  21.     procedure FormCreate(Sender: TObject);
  22.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  23.     procedure btnSendClick(Sender: TObject);
  24.     procedure btnStopClick(Sender: TObject);
  25.     procedure btnConnectClick(Sender: TObject);
  26.   private
  27.     Client: TSocket;
  28.     { Private declarations }
  29.   public
  30.     { Public declarations }
  31.     StopTrans: Boolean; //是否停止传送的开发
  32.     InTrans: Boolean; //表示是否正在传送文件
  33.     //传送文件的过程
  34.     procedure TransFile(filename: string);
  35.   end;
  36. const BlockLen = 1024 * 4; //每次发送的最大数据量
  37. var
  38.   FrmMain: TFrmMain;
  39. implementation
  40. {$R *.DFM}
  41. //窗体创建时,启动winSock动态链接库
  42. procedure TFrmMain.FormCreate(Sender: TObject);
  43. var
  44.   aWSAData: TWSAData;
  45. begin
  46.   if WSAStartup($0101, aWSAData) <> 0 then
  47.     raise Exception.Create('不能启动winsock动态链接库!');
  48.   MessageBox(Handle, aWSAData.szDescription, 'WinSock 态链接库版本', MB_OK);
  49. end;
  50. //关闭窗口
  51. procedure TFrmMain.btnExitClick(Sender: TObject);
  52. begin
  53.   Close;
  54. end;
  55. //当窗体关闭时,检测是否正在传文件
  56. procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
  57. var tim: Tdatetime;
  58. begin
  59.   if InTrans then
  60.     if MessageBox(Handle, '正在传输文件,停止吗?', '提示', MB_YESNO) = IDNO then
  61.       abort;
  62. //释放Winsock动态链接库所创建的资源
  63.   if WSACleanup <> 0 then
  64.     MessageBox(Handle, '清除WinSock动态链接库错误!', '提示', MB_OK)
  65.   else
  66.     MessageBox(Handle, '清除WinSock动态链接库成功!', '提示', MB_OK);
  67.   closesocket(Client);
  68. end;
  69. //连接服务器
  70. procedure TFrmMain.btnConnectClick(Sender: TObject);
  71. var
  72.   ca: SOCKADDR_IN;
  73.   hostaddr: u_long;
  74. begin
  75.   //创建客户端的Socket
  76.   Client := Socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
  77.   if Client = INVALID_SOCKET then
  78.   begin
  79.     StatusBar.SimpleText := '为连接远程服务器端创建Socket错误!';
  80.     Exit;
  81.   end;
  82.   ca.sin_family := PF_INET;
  83.   ca.sin_port := htons(StrToInt(Trim(edtPort.Text)));
  84.   hostaddr := inet_addr(PChar(Trim(edtIP.Text)));
  85.   //判断IP地址是否合法
  86.   if (hostaddr = -1) then
  87.   begin
  88.     StatusBar.SimpleText := ' 主机IP地址 :' + Trim(edtIP.Text) + ' 错误!';
  89.     Exit;
  90.   end
  91.   else
  92.     ca.sin_addr.S_addr := hostaddr;
  93.   //连接服务器
  94.   if connect(Client, ca, sizeof(ca)) <> 0 then
  95.   begin
  96.     StatusBar.SimpleText := '连接服务器端Socket错误!';
  97.     Exit;
  98.   end
  99.   else
  100.     StatusBar.SimpleText := '连接远程Socket成功!';
  101. end;
  102. //传送文件的过程
  103. procedure TFrmMain.TransFile(filename: string);
  104. var
  105.   Ftrans: file of Byte;
  106.   Flen: Integer;
  107.   BlockNum, RemainLen: Integer;
  108.   BlockBuf: array[0..BlockLen - 1] of Byte;
  109.   i: Integer;
  110.   SendLen: Integer;
  111. begin
  112.   AssignFile(Ftrans, filename);
  113.   Reset(Ftrans);
  114.   Flen := FileSize(Ftrans);
  115.   BlockNum := Flen div BlockLen;
  116.   ProgressBar.Max := 1 + BlockNum;
  117.   RemainLen := Flen mod BlockLen;
  118.   StopTrans := False;
  119.   InTrans := True;
  120.   SendLen := 1;
  121.   for i := 0 to BlockNum - 1 do
  122.   begin
  123.     if (StopTrans) or (SendLen <= 0) then Break;
  124.     BlockRead(Ftrans, BlockBuf[0], BlockLen);
  125.     SendLen := send(Client, BlockBuf, BlockLen, 0);
  126.     ProgressBar.Position := i;
  127.     Application.ProcessMessages;
  128.   end;
  129.   if StopTrans then
  130.   begin
  131.     CloseFile(Ftrans);
  132.     InTrans := False;
  133.     StatusBar.SimpleText := '';
  134.     MessageBox(Handle, '停止传输!', '提示', MB_OK);
  135.     ProgressBar.Position := 0;
  136.     Exit;
  137.   end;
  138.   if (SendLen <= 0) then
  139.   begin
  140.     CloseFile(Ftrans);
  141.     InTrans := False;
  142.     StatusBar.SimpleText := '';
  143.     MessageBox(Handle, '传输异常终止!', '提示', MB_OK);
  144.     ProgressBar.Position := 0;
  145.     Exit;
  146.   end;
  147.   if RemainLen > 0 then
  148.   begin
  149.     BlockRead(Ftrans, BlockBuf[0], RemainLen);
  150.     SendLen := send(Client, BlockBuf, RemainLen, 0);
  151.     if (SendLen <= 0) then
  152.     begin
  153.       CloseFile(Ftrans);
  154.       InTrans := False;
  155.       StatusBar.SimpleText := '';
  156.       MessageBox(Handle, '传输异常终止!', '提示', MB_OK);
  157.       ProgressBar.Position := 0;
  158.       Exit;
  159.     end;
  160.   end;
  161.   ProgressBar.Position := ProgressBar.Max;
  162.   CloseFile(Ftrans);
  163.   InTrans := False;
  164.   StatusBar.SimpleText := '';
  165.   MessageBox(Handle, '传输完成!', '提示', MB_OK);
  166.   ProgressBar.Position := 0;
  167. end;
  168. //执行传送文件
  169. procedure TFrmMain.btnSendClick(Sender: TObject);
  170. begin
  171.   if (OpenDfile.Execute) and (FileExists(OpenDfile.FileName)) then
  172.     TransFile(OpenDfile.FileName);
  173. end;
  174. //停止传送
  175. procedure TFrmMain.btnStopClick(Sender: TObject);
  176. begin
  177.   StopTrans := True;
  178. end;
  179. end.