usocketpub.pas

delphi中的SOCKET使用的简单程序

unit uSocketPub;

interface

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

const
  SocketPort      = 6711;   //使用的网络端口配置

  //前缀是vc的动词表由客户端发出；前缀是vs的动词由服务器端发出。
  vcRequest       = 1001;   //请求发送文件
  vsAgree         = 1002;   //同意请求
  vsRefuse        = 1003;   //拒绝请求

  vcFileInfo      = 1004;   //要保存文件的信息
  vsFileInfoOK    = 1005;   //正确收到保存文件的信息

  vcFirstBuf      = 1006;   //发送第一个包
  vsFirstBufOK    = 1007;   //正确收到第一个包
  vcCommonBuf     = 1008;   //发送中间的包
  vsCommonBufOK   = 1009;   //正确收到中间的包
  vcLastBuf       = 1010;   //发送最后一个包
  vsLastBufOK     = 1011;   //正确收到最后一个包
  vcComplete      = 1012;   //完成

  vcNone          = 8001;{ 无效的动词 }
  vsNone          = 8002;{ 无效的动词 }
  vcIDError       = 8003;
  vsIDError       = 8003;

  vcCancel        = 9001;{ 取消操作 }
  vsEchoCancel    = 9002;{ 响应取消 }
  vcFail          = 9003;{ 操作失败 }
  vsEchoFail      = 9004;{ 响应失败 }
  vsFail          = 9005;{ 操作失败 }

  DataLen = 1024;               //数据包的最大尺寸是1K字节  如果设成4K的话，有可能引起错误
  LeadLen = 20;                 //引导包的固定尺寸是10字节  包括16个字节的身份识别代码和4个字节动词代码
  SendLen = LeadLen + DataLen;  //发送包或接收包的最大尺寸是 (1024 + 20) 字节  }

type
  TDataBuf = array [0..DataLen - 1] of Char; //数据包缓存
  TLeadBuf = array [0..LeadLen - 1] of Char; //引导包缓存
  TSendBuf = array [0..SendLen - 1] of Char; //发送包或接收包缓存
  TFileOfChar = file of Char;                //字符文件，用于接收方保存文件

  TSocketData = record           //用于保存与当前Socket相关的信息
    FileName:   string;          //源文件名
    FS:         TFileStream;     //文件流
    FSEnabled:  Boolean;         //文件流状态
    FileSize:   Integer;         //文件尺寸
    LeftSize:   Integer;         //剩余尺寸
    ProgressBar:TProgressBar;    //进度条

    SavePath:  string;           //文件保存路径
    F:         TFileOfChar;      //文件
    FEnabled:  Boolean;          //文件状态
  end;
  PSocketData = ^TSocketData;   //类型指针，类型为TSocketData类型

  TSocketVerb = Integer;        //动词类型

//新建Socket的相关数据，返回指针
function  NewSocketData: PSocketData;

//重置相关数据
procedure ResetSocketData(var P:PSocketData);

//根据Socket相关的信息建立文件信息的数据包
procedure MakeFileInfoBuf(P:PSocketData;var SendBuf:TSendBuf;var SendSize:Integer);

//分解数据包，得到将文件的信息，存入向相关的Socket的数据中
procedure ExtractFileInfo(DataBuf: TDataBuf; var P: PSocketData);

//将得到的包分解成为引导包和数据包
procedure ExtractBuf(Buf: TSendBuf; BufSize: Integer;var LBuf: TLeadBuf; var DBuf: TDataBuf);

//服务端分解引导包得到引导包中包含的动词
function  ServerExtractVerb(LBuf: TLeadBuf): TSocketVerb;

//客户端分解引导包得到引导包中包含的动词
function  ClientExtractVerb(LBuf: TLeadBuf): TSocketVerb;

//根据指定的动词初始化需要发送的包
procedure MakeVerbBuf(AVerb: TSocketVerb; var Buf: TSendBuf;var SendSize: Integer);

//将数据包写入要发送的包中
procedure MakeSendBuf(DataBuf: TDataBuf; Count: Integer;var SendBuf: TSendBuf; var SendSize: Integer);

implementation

const
  IDString='GLGFJWZDISMYTRAN';              //引导包中的身份识别串，16个字符

function  NewSocketData: PSocketData;
var
  P: PSocketData;
begin
  New(P);
  with P^ do
  begin
    FileName := '';
    SavePath := '';
    FileSize := 0;
    LeftSize := 0;
    FSEnabled:= False;
    FEnabled := False;
  end;
  Result := P;
end;

procedure ResetSocketData(var P: PSocketData);
begin
  with P^ do
  try
    FileName := '';
    SavePath := '';
    if FSEnabled then
    try
      FS.Free;
    except
    end;
    FSEnabled := False;
    if FEnabled then
    try
      CloseFile(F);
    except
    end;
    FEnabled:=False;
    FileSize := 0;
    LeftSize := 0;
  except
  end;
end;

procedure MakeFileInfoBuf(P:PSocketData;var SendBuf:TSendBuf;var SendSize:Integer);
var
  S: string;
  X, Len: Integer;
begin
  MakeVerbBuf(vcFileInfo, SendBuf, SendSize);
  S:=P^.FileName+'|'+IntToStr(P^.FileSize)+'|';
  Len := Length(S);
  for X := 1 to Len do
    SendBuf[LeadLen+X-1] := S[X];
  SendSize:=LeadLen+Len;
end;

procedure ExtractFileInfo(DataBuf: TDataBuf; var P: PSocketData);
var
  S, ASrcFileName, AFileSize: string;
  ASize: Integer;
begin
  S := DataBuf;
  try
    ASrcFileName:=Copy(S,1,Pos('|',S)-1);
    Delete(S,1,Pos('|',S));
    AFileSize:=Copy(S,1,Pos('|',S)- 1);
    ASize := StrToInt(AFileSize);
    //P^.FileName:=ASrcFileName;  不需要了，接收方用日期时间来标志文件名
    P^.FileSize := ASize;
  except
  end;
end;

procedure ExtractBuf(Buf: TSendBuf; BufSize: Integer;
var LBuf: TLeadBuf; var DBuf: TDataBuf);
var
  X: Integer;
begin
  for X := 0 to LeadLen - 1 do
    LBuf[X] := Buf[X];
  for X := LeadLen to BufSize - 1 do
    DBuf[X - LeadLen] := Buf[X];
end;

function  ServerExtractVerb(LBuf: TLeadBuf): TSocketVerb;
var
  HeadS: string[16];
  VerbS: string[4];
  X: Integer;
  AVerb: TSocketVerb;
begin
  HeadS := '';
  for X := 0 to 15 do
    HeadS := HeadS + LBuf[X];
  VerbS := '';
  for X := 16 to LeadLen - 1 do
    VerbS := VerbS + LBuf[X];
  if HeadS = IDString then  //身份识别串合法时才检查动词
  try
    AVerb := StrToInt(VerbS);
  except
    AVerb := vcNone;     //解析动词失败，则认为是无效动词
  end else
    AVerb := vcIDError;  //身份非法则认为是无效动词
  Result := AVerb;
end;

function  ClientExtractVerb(LBuf: TLeadBuf): TSocketVerb;
var
  HeadS: string[16];
  VerbS: string[4];
  X: Integer;
  AVerb: TSocketVerb;
begin
  HeadS := '';
  for X := 0 to 15 do
    HeadS := HeadS + LBuf[X];
  VerbS := '';
  for X := 16 to LeadLen - 1 do
    VerbS := VerbS + LBuf[X];
  if HeadS = IDString then  //身份识别串合法时才检查动词
  try
    AVerb := StrToInt(VerbS);
  except
    AVerb := vsNone;        //解析动词失败，则认为是无效动词
  end else
    AVerb := vsIDError;     //身份非法则认为是无效动词
  Result := AVerb;
end;

procedure MakeVerbBuf(AVerb: TSocketVerb; var Buf: TSendBuf; var SendSize: Integer);
var
  S: string;
  X: Integer;
begin
  S := '';
  S := IDString + IntToStr(AVerb);
  if Length(S) = LeadLen then
  begin
    for X := 1 to LeadLen do
      Buf[X - 1] := S[X];
  end;
  SendSize := LeadLen;
end;

procedure MakeSendBuf(DataBuf: TDataBuf; Count: Integer;
var SendBuf: TSendBuf; var SendSize: Integer);
var
  X: Integer;
begin
  for X := 0 to Count - 1 do
    SendBuf[LeadLen + X] := DataBuf[X];
  SendSize := LeadLen + Count;
end;

end.