corelab.mydac.mysqlviotcp.pas

CrLab UniDAC 1.0 include sources

{$IFNDEF UNIDACPRO}

{$I MyDac.inc}

unit CoreLab.MyDac.MySqlVioTcp;
{$ENDIF}

interface

uses
  System.Text, System.Net, System.Net.Sockets, System.Threading,
  Classes, 
  {$IFNDEF UNIDACPRO}MySqlVio{$ELSE}MySqlVioUni{$ENDIF};

type
  TMySqlTcpClient = class(TcpClient)
  public
    constructor Create;
    function Handle: IntPtr;
  end;

  TMySqlVioTcp = class(TMySqlVio)
  protected
    Ftcp: TMySqlTcpClient;
    Fstream: NetworkStream;
    Fhostname: string;
    Fport: integer;
    Ftimeout: integer;

    function GetTimeout: integer; override;
    procedure SetTimeout(Value: integer); override;

    function ReadNoWait(var{performance opt} buffer: TBytes; offset, count: integer): integer; override;
    function WriteNoWait(const{performance opt} buffer: TBytes; offset, count: integer): integer; override;
    
  public
    constructor Create(const hostname: string; const port: integer);

    procedure Connect; override;
    procedure Close; override;
    function Read(var{performance opt} buffer: TBytes; offset, count: integer): integer; override;
    function Write(const{performance opt} buffer: TBytes; offset, count: integer): integer; override;

  end;

implementation

uses
  SysUtils,
  Windows, Math;

function IsIpAddress(const hostname: string): boolean;
var
  i: integer;
  ch: char;
begin
  Result := hostname = '';
  if not Result then
    Exit;

  for i := 1 to Length(hostname) do begin
    ch := hostname[i];
    if ((ch < '0') or (ch > '9')) and (ch <> '.') then begin
      Result := False;
      Exit;
    end;
  end;
end;

{ TMySqlTcpClient }

constructor TMySqlTcpClient.Create;
begin
  inherited;
  GC.SuppressFinalize(Client);
end;

function TMySqlTcpClient.Handle: IntPtr;
begin
  Assert(Client <> nil);
  Result := Client.Handle;
end;

{ TMySqlVioTcp }

constructor TMySqlVioTcp.Create(const hostname: string; const port: integer);
begin
  inherited Create;
  Fhostname := hostname;
  Fport := port;
end;

function TMySqlVioTcp.GetTimeout: integer;
begin
  Result := Ftimeout;
end;

procedure TMySqlVioTcp.SetTimeout(Value: integer);
begin
  if Value > MaxInt div 1000 then
    Value := MaxInt div 1000;

  if timeout <> Value then begin
    if FTcp <> nil then
      FTcp.ReceiveTimeout := value * 1000;
    Ftimeout := value;
  end;
end;

procedure TMySqlVioTcp.Connect;
var
  ip: IPAddress;
begin
  inherited;

  Ftcp := TMySqlTcpClient.Create;
  Ftcp.ReceiveTimeout := Ftimeout * 1000;

  Ftcp.NoDelay := True;
  if IsIpAddress(Fhostname) then begin
    ip := IPAddress.Parse(Fhostname);
    Ftcp.Connect(ip, Fport);
  end
  else
    Ftcp.Connect(Fhostname, Fport);
  Fstream := Ftcp.GetStream;
  GC.SuppressFinalize(Fstream);
end;

procedure TMySqlVioTcp.Close;
begin
  if Fstream <> nil then begin
    Fstream.Close;
    Fstream.Free;
    Fstream := nil;
  end;

  if FTcp <> nil then begin
    Ftcp.Close;
    Ftcp.Free;
    Ftcp := nil;
  end;
end;

function TMySqlVioTcp.ReadNoWait(var{performance opt} buffer: TBytes; offset, count: integer): integer;
const
  MaxRecvSize: integer = 131072;
begin
  try
    Result := Fstream.Read(buffer, offset, Math.Min(MaxRecvSize, count));
  except
    Result := 0;
  end;
end;

function TMySqlVioTcp.WriteNoWait(const{performance opt} buffer: TBytes; offset, count: integer): integer;
begin
  try
    Fstream.Write(buffer, offset, count);
    Result := count;
  except
    Result := 0;
  end;
end;

function TMySqlVioTcp.Read(var{performance opt} buffer: TBytes; offset, count: integer): integer;
begin
  if Fstream = nil then
    Result := 0
  else
    Result := inherited Read(buffer, offset, count);
end;

function TMySqlVioTcp.Write(const{performance opt} buffer: TBytes; offset, count: integer): integer;
begin
  if Fstream = nil then
    Result := 0
  else
    Result := inherited Write(buffer, offset, count);
end;

end.