起航

最早学的语言是Fortune,后来学了Basic和C++。

最早使用的编程语言是Fortune,经典的作品。

然后市面上有了VB,当时还是3.0,没有书。不过有些编程计算的基础。感觉用起来很方便。

当然还有更专业的并且好用的,Delphi,从1.0开始,主要是数据库。

不过马上又要转了。

 

博客园帮我解决了不少问题,所以在这里开始记录一些软件编程的心得体会。

 

看看这个怎么用法。非常专业的为软件工程师开发的博客,可以插入代码,并且还是按照语言环境的格式。用起来非常舒服。

 

插入TBAseSocket声明代码

type

{ TBaseSocket }

  TSocketProtocol = Word;
  TServerSocketBlockMode = (bmBlocking, bmNonBlocking, bmThreadBlocking);
  TSocketBlockMode = bmBlocking..bmNonBlocking;
  TSocketType = (stStream, stDgram, stRaw, stRdm, stSeqPacket);
  TSocketNotifyEvent = procedure (Sender: TObject) of object;
  TSocketDataEvent = procedure (Sender: TObject; Buf: pchar; var DataLen: Integer) of object;
  TSocketErrorEvent = procedure (Sender: TObject; SocketError: Integer) of object;
  ESocketError = class(Exception);

  TBaseSocket = class(TComponent)
  private
    FActive: Boolean;
    FBlockMode: TSocketBlockMode;
    FBytesReceived: Cardinal;
    FBytesSent: Cardinal;
    FDomain: TSocketDomain;
    FProtocol: TSocketProtocol;
    FSocket: TSocket;
    FSockType: TSocketType;
    FOnCreateHandle: TSocketNotifyEvent;
    FOnDestroyHandle: TSocketNotifyEvent;
    FOnError: TSocketErrorEvent;
    FOnReceive: TSocketDataEvent;
    FOnSend: TSocketDataEvent;

    procedure SetActive(Value: Boolean);
    procedure SetBlockMode(Value: TSocketBlockMode);
    procedure SetDomain(Value: TSocketDomain);
    procedure SetProtocol(Value: TSocketProtocol);
    procedure SetSockType(Value: TSocketType);

  protected
    procedure DoCreateHandle; dynamic;
    procedure DoDestroyHandle; dynamic;
    procedure DoHandleError; dynamic;
    procedure DoReceive(Buf: pchar; var DataLen: Integer); virtual;
    procedure DoSend(Buf: pchar; var DataLen: Integer); virtual;
    function ErrorCheck(rc: Integer): Integer; virtual;
    procedure Loaded; override;
    procedure SetBytesReceived(Value: Cardinal);
    procedure SetBytesSent(Value: Cardinal);

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Open; virtual;
    procedure Close; virtual;
    function MapDomain(sd: TSocketDomain): Integer;
    function MapSockType(st: TSocketType): Integer;
    function PeekBuf(var Buf; BufSize: Integer): Integer;
    function ReceiveBuf(var Buf; BufSize: Integer; Flags: Integer = 0): Integer;
    function Receiveln(const eol: string = CRLF): string;
    function Select(ReadReady, WriteReady, ExceptFlag: PBoolean; TimeOut: Integer = 0): Boolean;
    function SendBuf(var Buf; BufSize: Integer; Flags: Integer = 0): Integer;
    function Sendln(s: string; const eol: string = CRLF): Integer;
    function SendStream(AStream: TStream): Integer;
    function WaitForData(TimeOut: Integer = 0): Boolean;

    property Active: Boolean read FActive write SetActive default False;
    property BlockMode: TSocketBlockMode read FBlockMode write SetBlockMode default bmBlocking;
    property BytesReceived: Cardinal read FBytesReceived;
    property BytesSent: Cardinal read FBytesSent;
    property Domain: TSocketDomain read FDomain write SetDomain default pfUnspec;
    property Handle: TSocket read FSocket;
    property Protocol: TSocketProtocol read FProtocol write SetProtocol;
    property SockType: TSocketType read FSockType write SetSockType default stStream;
    property OnCreateHandle: TSocketNotifyEvent read FOnCreateHandle write FOnCreateHandle;
    property OnDestroyHandle: TSocketNotifyEvent read FOnDestroyHandle write FOnDestroyHandle;
    property OnError: TSocketErrorEvent read FOnError write FOnError;
    property OnReceive: TSocketDataEvent read FOnReceive write FOnReceive;
    property OnSend: TSocketDataEvent read FOnSend write FOnSend;
  end;
{ TBaseSocket }

constructor TBaseSocket.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActive  := False;
  FBlockMode := bmBlocking;
  FBytesReceived := 0;
  FBytesSent := 0;
  FDomain := pfUnspec;
  FProtocol := IPPROTO_IP;
  FSocket := INVALID_SOCKET;
  FSockType := stStream;
  FOnCreateHandle := nil;
  FOnDestroyHandle := nil;
  FOnError := nil;
  FOnReceive := nil;
  FOnSend := nil;
{$IFDEF MSWINDOWS}
  RPR;
{$ENDIF}
{$IFDEF LINUX}
  RCS;
{$ENDIF}
end;

destructor TBaseSocket.Destroy;
begin
  Close;
  inherited Destroy;
end;

procedure TBaseSocket.Open;
{$IFDEF MSWINDOWS}
var
  NonBlock: Integer;
{$ENDIF}
begin
  if not FActive then
  begin
    FSocket := ErrorCheck(socket(Integer(Xlat_Domain[FDomain]), Integer(Xlat_SocketType[FSockType]), FProtocol));
    FActive := FSocket <> INVALID_SOCKET;
    if FActive then
    begin
      if FBlockMode = bmNonBlocking then
      begin
  {$IFDEF MSWINDOWS}
        NonBlock := 1;
        ErrorCheck(ioctlsocket(FSocket, FIONBIO, NonBlock));
  {$ENDIF}
  {$IFDEF LINUX}
        ErrorCheck(fcntl(FSocket, F_SETFL, O_NONBLOCK));
  {$ENDIF}
      end;
      FBytesReceived := 0;
      FBytesSent := 0;
      DoCreateHandle;
    end;
  end;
end;

procedure TBaseSocket.Close;
begin
  if FActive then
  begin



{$IFDEF LINUX}
    ErrorCheck(Libc.__close(FSocket));
{$ENDIF}
    FSocket := INVALID_SOCKET;
    FActive := False;
    DoDestroyHandle;
  end;
end;

function TBaseSocket.MapDomain(sd: TSocketDomain): Integer;
begin
  Result := Integer(Xlat_Domain[sd]);
end;

function TBaseSocket.MapSockType(st: TSocketType): Integer;
begin
  Result := Integer(Xlat_SocketType[st]);
end;

function TBaseSocket.PeekBuf(var Buf; BufSize: Integer): Integer;
begin
  Result := ErrorCheck(recv(FSocket, buf, bufsize, MSG_PEEK));
end;

function TBaseSocket.ReceiveBuf(var Buf; BufSize: Integer; Flags: Integer): Integer;
begin
  Result := ErrorCheck(recv(FSocket, Buf, BufSize, Flags));
  if Result <> SOCKET_ERROR then
    DoReceive(pchar(@Buf), Result);
end;

function TBaseSocket.Receiveln(const eol: string): string;
var
  len: Integer;
  buf: array[0..511] of char;
  eolptr: pchar;
begin
  Result := '';
  eolptr := nil;
  repeat
    len := PeekBuf(buf, sizeof(buf) - 1);
    if len > 0 then
    begin
      buf[len] := #0;
      eolptr := strpos(buf, pchar(eol));
      if eolptr <> nil then
        len := eolptr - buf + length(eol);
      ReceiveBuf(buf, len);
      if eolptr <> nil then
        len := len - length(eol);
      buf[len] := #0;
      Result := Result + buf;
    end;
  until (len < 1) or (eolptr <> nil);
end;

function TBaseSocket.Select(ReadReady, WriteReady, ExceptFlag: PBoolean; TimeOut: Integer): Boolean;
var
  ReadFds: TFDset;
  ReadFdsptr: PFDset;
  WriteFds: TFDset;
  WriteFdsptr: PFDset;
  ExceptFds: TFDset;
  ExceptFdsptr: PFDset;
  tv: timeval;
  Timeptr: PTimeval;
begin
  Result := False;
  if Active then
  begin
    if Assigned(ReadReady) then
    begin
      ReadFdsptr := @ReadFds;
      FD_ZERO(ReadFds);
      FD_SET(FSocket, ReadFds);
    end
    else
      ReadFdsptr := nil;
    if Assigned(WriteReady) then
    begin
      WriteFdsptr := @WriteFds;
      FD_ZERO(WriteFds);
      FD_SET(FSocket, WriteFds);
    end
    else
      WriteFdsptr := nil;
    if Assigned(ExceptFlag) then
    begin
      ExceptFdsptr := @ExceptFds;
      FD_ZERO(ExceptFds);
      FD_SET(FSocket, ExceptFds);
    end
    else
      ExceptFdsptr := nil;
    if TimeOut >= 0 then
    begin
      tv.tv_sec := TimeOut div 1000;
      tv.tv_usec :=  1000 * (TimeOut mod 1000);
      Timeptr := @tv;
    end
    else
      Timeptr := nil;
    Try
{$IFDEF MSWINDOWS}
      Result := ErrorCheck(WinSock.select(FSocket + 1, ReadFdsptr, WriteFdsptr, ExceptFdsptr, Timeptr)) > 0;
{$ENDIF}
{$IFDEF LINUX}
      Result := ErrorCheck(Libc.select(FSocket + 1, ReadFdsptr, WriteFdsptr, ExceptFdsptr, Timeptr)) > 0;
{$ENDIF}
    except
      Result := False;
    end;
    if Assigned(ReadReady) then
      ReadReady^ := FD_ISSET(FSocket, ReadFds);
    if Assigned(WriteReady) then
      WriteReady^ := FD_ISSET(FSocket, WriteFds);
    if Assigned(ExceptFlag) then
      ExceptFlag^ := FD_ISSET(FSocket, ExceptFds);
  end;
end;

function TBaseSocket.SendBuf(var Buf; BufSize: Integer; Flags: Integer): Integer;
begin
  DoSend(pchar(@Buf), BufSize);
  Result := ErrorCheck(Send(FSocket, Buf, BufSize, Flags));
  if Result <> SOCKET_ERROR then
    inc(FBytesSent, Result);
end;

function TBaseSocket.Sendln(s: string; const eol: string): Integer;
begin
  s := s + eol;
  Result := SendBuf(pchar(s)^, length(s), 0);
end;

function TBaseSocket.SendStream(AStream: TStream): Integer;
var
  BufLen: Integer;
  Buffer: array[0..511] of Byte;
begin
  Result := 0;
  if Assigned(AStream) then
  begin
    repeat
      BufLen := AStream.Read(Buffer, SizeOf(Buffer));
    until (BufLen = 0) or (SendBuf(Buffer, BufLen) = SOCKET_ERROR);
  end;
end;

function TBaseSocket.WaitForData(TimeOut: Integer): Boolean;
var
  ReadReady, ExceptFlag: Boolean;
  c: Char;
begin
  Result := False;
  // Select also returns True when connection is broken.
  if Select(@ReadReady, nil, @ExceptFlag, TimeOut) then
    Result := ReadReady and not ExceptFlag and
      (PeekBuf(c, sizeof(c)) = 1);
end;

procedure TBaseSocket.DoHandleError;
var
  SocketError: Integer;
begin
{$IFDEF MSWINDOWS}
  SocketError := WSAGetLastError;
{$ENDIF}
{$IFDEF LINUX}
  SocketError := errno;
{$ENDIF}
  if Assigned(FOnError) then
    OnError(Self, SocketError);
end;

procedure TBaseSocket.DoCreateHandle;
begin
  if FActive and Assigned(FOnCreateHandle) then
    OnCreateHandle(self);
end;

procedure TBaseSocket.DoDestroyHandle;
begin
  if Assigned(FOnDestroyHandle) then
    OnDestroyHandle(self);
end;

procedure TBaseSocket.DoReceive(Buf: pchar; var DataLen: Integer);
begin
  if Assigned(FOnReceive) then
    OnReceive(Self, Buf, DataLen);
  inc(FBytesReceived, DataLen);
end;

procedure TBaseSocket.DoSend(Buf: pchar; var DataLen: Integer);
begin
  if Assigned(FOnSend) then
    OnSend(Self, Buf, DataLen);
end;

function TBaseSocket.ErrorCheck(rc: Integer): Integer;
begin
  Result := rc;
  if rc = SOCKET_ERROR then
    DoHandleError;
end;

procedure TBaseSocket.Loaded;
begin
  inherited Loaded;
  if FActive and not (csDesigning in ComponentState) then
  begin
    FActive := False;
    Open;
  end;
end;

procedure TBaseSocket.SetBytesReceived(Value: Cardinal);
begin
  FBytesReceived := Value;
end;

procedure TBaseSocket.SetBytesSent(Value: Cardinal);
begin
  FBytesSent := Value
end;

procedure TBaseSocket.SetActive(Value: Boolean);
begin
  if Value <> FActive then
  begin
    if not (csLoading in ComponentState) and not (csDesigning in ComponentState) then
      if Value then Open
      else Close
    else FActive := Value;
  end;
end;

procedure TBaseSocket.SetDomain(Value: TSocketDomain);
begin
  if Value <> FDomain then
  begin
    if not (csLoading in ComponentState) and not (csDesigning in ComponentState) then
      Close;
    FDomain := Value;
  end;
end;

procedure TBaseSocket.SetSockType(Value: TSocketType);
begin
  if Value <> FSockType then
  begin
    if not (csDesigning in ComponentState) and not (csLoading in ComponentState) then
      Close;
    FSockType := Value;
  end;
end;

procedure TBaseSocket.SetProtocol(Value: TSocketProtocol);
begin
  if Value <> FProtocol then
  begin
    if not (csDesigning in ComponentState) and not (csLoading in ComponentState) then
      Close;
    FProtocol := Value;
  end;
end;

procedure TBaseSocket.SetBlockMode(Value: TSocketBlockMode);
begin
  if Value <> FBlockMode then
  begin
    if not (csDesigning in ComponentState) and not (csLoading in ComponentState) then
      Close;
    FBlockMode := Value;
  end;
end;

 

posted on 2015-08-31 16:35  Tiny Ant  阅读(210)  评论(0)    收藏  举报

导航