clientfrm.pas

《Delphi 7经典问题解析》源代码 第一到七章 基础篇源程序 应用篇源程序

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.