TIP: Click on subject to list as thread! ANSI
echo: delphi
to: STEVE BATSON
from: FRANCOIS PIETTE
date: 1996-08-21 20:47:00
subject: Winsock & Delphi 2 sources part 5/11

Salut Steve Batson !
-------------WSocket.Pas part 3/5 -------------
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function SearchChar(Data : PChar; Len : Integer; Ch : Char) : PChar;
begin
    while Len > 0 do begin
        Len := Len - 1;
        if Data^ = Ch then begin
            Result := Data;
            exit;
        end;
        Data := Data + 1;
    end;
    Result := nil;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWSocket.TryToSend;
var
    oBuffer   : TBuffer;
    Len       : Integer;
    Count     : Integer;
    Data      : Pointer;
    LastError : Integer;
    p         : PChar;
    bMore     : Boolean;
begin
    if (FBufList.Count = 0) or                       { Nothing to send     *}
       (bMoreFlag and (nMoreCnt >= nMoreMax)) then   { Waiting more signal *}
        exit;
    bMore := TRUE;
    while bMore do begin
        oBuffer := FBufList.First;
        Data    := oBuffer.Peek(Len);
        if Len <= 0 then begin
            { Buffer is empty }
            if FBufList.Count <= 1 then begin
                { Every thing has been sent }
                bAllSent := TRUE;
                bMore    := FALSE;
            end
            else begin
                oBuffer.Free;
                FBufList.Delete(1);
                FBufList.Pack;
            end;
        end
        else begin
            if bMoreFlag then begin
                p := SearchChar(Data, Len, #10);
                if Assigned(p) then begin
                    len := p - PChar(Data) + 1;
                    nMoreCnt := nMoreCnt + 1;
                    if nMoreCnt >= nMoreMax then
                        bMore := FALSE;
                end;
            end;
            Count := WinSock.Send(FHSocket, Data^, Len, 0);
            if Count = 0 then
                bMore := FALSE  { Closed by remote }
            else if count = SOCKET_ERROR then begin
                LastError := WSAGetLastError;
                if (LastError = WSAECONNRESET) or (LastError = WSAENOTSOCK)
                then begin
                    Close;
                end
                else if LastError  WSAEWOULDBLOCK then begin
                    Application.MessageBox('TryToSend failed',
                                           'WINSOCK ERROR',
                                           mb_OKCancel + mb_DefButton1);
                end;
                bMore := FALSE;
            end
            else begin
                oBuffer.Remove(Count);
                if Count < Len then begin
                    { Could not write as much as we wanted. Stop sending }
                    bWrite := FALSE;
                    bMore  := FALSE;
                end;
            end;
        end;
    end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Return -1 if error, else return number of byte written                    }
function TWSocket.Send(Data : Pointer; Len : Integer) : integer;
var
    oBuffer  : TBuffer;
    cWritten : Integer;
    bMore    : Boolean;
begin
    if FState  Connected then begin
        Application.MessageBox('Send: Socket not connected',
                               'WINSOCK ERROR',
                               mb_OKCancel + mb_DefButton1);
        Result := -1;
        exit;
    end;
    if Len <= 0 then begin
        Result := 0;
        exit;
    end;
    bAllSent := FALSE;
    if FBufList.Count = 0 then begin
        oBuffer := TBuffer.Create;
        FBufList.Add(oBuffer);
    end
    else
        oBuffer := FBufList.Last;
    bMore := TRUE;
    while bMore do begin
        cWritten := oBuffer.Write(Data, Len);
        if cWritten >= Len then
            bMore := FALSE
        else begin
            Len := Len - cWritten;
            if Len < 0 then
                bMore := FALSE
            else begin
                oBuffer := TBuffer.Create;
                FBufList.Add(oBuffer);
            end;
        end;
    end;
    TryToSend;
    Result := Len;
    if bAllSent then begin
        { We post a message to fire the FD_WRITE message wich in turn will }
        { fire the OnDataSent event. We cannot fire the event ourself      }
        { because the event handler will eventually call send again.       }
        { Sending the message prevent recursive call and stack overflow.   }
        { The PostMessage function posts (places) a message in a window's  }
        { message queue and then returns without waiting for the           }
        { corresponding window to process the message. The message will be }
        { seen and routed by Delphi a litle later, when we will be out of  }
        { the send function.                                               }
        PostMessage(Handle,
                    WM_ASYNCSELECT,
                    FHSocket,
                    MakeLong(FD_WRITE, 0));
    end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Return -1 if error, else return number of byte written                    }
function TWSocket.SendStr(Str : String) : integer;
begin
   Result := Send(@Str[1], Length(Str));
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWSocket.WMASyncSelect(var msg: TMessage);
var
    Check  : Word;
    lCount : LongInt;
    bMore  : Boolean;
begin
    if FPaused then
        exit;
    Check := msg.lParamLo and FD_CONNECT;
    if Check  0 then begin
        ChangeState(Connected);
        if Assigned(FSessionConnected) then
            FSessionConnected(Self, msg.lParamHi);
        if (msg.lParamHi  0) and (FState  Closed) then
            Close;
    end;
    Check := msg.lParamLo and FD_READ;
    if Check  0 then begin
        bMore := TRUE;
        while bMore do begin
            if ReadLineFlag then
                ReadLineReceive
            else if Assigned(FDataAvailable) then
                FDataAvailable(Self, msg.lParamHi);
            {* Check if we have something new arrived, if yes, process it *}
            if IoctlSocket(FHSocket, FIONREAD, lCount) = SOCKET_ERROR then 
begi
n
                FLastError := WSAGetLastError;
                bMore      := FALSE;
            end
            else if lCount = 0 then
                bMore := FALSE;
        end;
    end;
    Check := msg.lParamLo and FD_WRITE;
    if Check  0 then begin
        TryToSend;
        if bAllSent and Assigned(FDataSent) then
            FDataSent(Self, msg.lParamHi);
    end;
    Check := msg.lParamLo and FD_ACCEPT;
    if Check  0 then begin
        if Assigned(FSessionAvailable) then
            FSessionAvailable(Self, msg.lParamHi);
    end;
    Check := msg.lParamLo and FD_CLOSE;
    if Check  0 then begin
        {* Check if we have something arrived, if yes, process it *}
        if IoctlSocket(FHSocket, FIONREAD, lCount)  SOCKET_ERROR then begin
            if lCount > 0 then begin
                if ReadLineFlag then
                    ReadLineReceive
                else if Assigned(FDataAvailable) then
                    FDataAvailable(Self, msg.lParamHi);
            end;
        end;
        if Assigned(FSessionClosed) then
            FSessionClosed(Self, msg.lParamHi);
        if FState  Closed then
            Close;
    end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWSocket.SetProto(Proto : String);
var
    szProto : array [0..31] of char;
    Ppe     : Pprotoent;
begin
    FProtoAssigned := TRUE;
    Proto := Trim(Proto);
    if IsDigit(Proto[1]) then
        FProto := atoi(Proto)
    else begin
        StrPCopy(szProto, Proto);
        ppe := GetProtoByName(szProto);
        if Ppe = nil then
            FProtoAssigned := FALSE
        else
            FProto := ppe^.p_proto;
    end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TWSocket.GetProto : String;
var
    Ppe : Pprotoent;
begin
    if not FProtoAssigned then
        Result := '' {'not assigned'}
    else begin
        ppe := GetProtoByNumber(FProto);
        if Ppe = nil then
            Result := 'not found'
        else begin
            SetLength(Result, StrLen(ppe^.p_name));
            StrCopy(@Result[1], ppe^.p_name);
        end;
    end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
----------- End of WSocket.Pas part 3/5 --------------
Amiti‚s,
{-Francois Piette-}
--- SvFido 1.32
---------------
* Origin: OverByte BBS (Embourg-Belgium) 32-41-651395 V-FAST (2:293/2202)

SOURCE: echomail via exec-pc

Email questions or comments to sysop@ipingthereforeiam.com
All parts of this website painstakingly hand-crafted in the U.S.A.!
IPTIA BBS/MUD/Terminal/Game Server List, © 2025 IPTIA Consulting™.