ClientFrm.pas
上传用户:psxgmh
上传日期:2013-04-08
资源大小:15112k
文件大小:5k
- unit ClientFrm;
- interface
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, Buttons, ComCtrls, WinSock, ExtCtrls;
- type
- TFrmMain = class(TForm)
- progressBar: TProgressBar;
- Statusbar: TStatusBar;
- Panel1: TPanel;
- Label1: TLabel;
- Label2: TLabel;
- btnSend: TBitBtn;
- btnStop: TBitBtn;
- btnExit: TBitBtn;
- edtIP: TEdit;
- edtPort: TEdit;
- OpenDFile: TOpenDialog;
- btnConnect: TBitBtn;
- procedure btnExitClick(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure btnSendClick(Sender: TObject);
- procedure btnStopClick(Sender: TObject);
- procedure btnConnectClick(Sender: TObject);
- private
- Client: TSocket;
- { Private declarations }
- public
- { Public declarations }
- StopTrans: Boolean; //是否停止传送的开发
- InTrans: Boolean; //表示是否正在传送文件
- //传送文件的过程
- procedure TransFile(filename: string);
- end;
- const BlockLen = 1024 * 4; //每次发送的最大数据量
- var
- FrmMain: TFrmMain;
- implementation
- {$R *.DFM}
- //窗体创建时,启动winSock动态链接库
- 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);
- var tim: Tdatetime;
- 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
- //创建客户端的Socket
- Client := Socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
- if Client = INVALID_SOCKET then
- begin
- StatusBar.SimpleText := '为连接远程服务器端创建Socket错误!';
- 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.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.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.