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 4/11

Salut Steve Batson !
---------- WSocket.Pas part 2/5 --------------
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TWSocket.LoadDll(FileName : PChar) : Boolean;
begin
    Result       := TRUE;
    GSocketCount := GSocketCount + 1;
    if GSocketCount = 1 then begin
        DllHandle := 9999;
        if WSAStartup($101, initdata)  0 then
            raise ESocketException.CreateFmt('%s: incorrect version', 
[FileName
]);
    end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWSocket.AssignDefaultValue;
begin
    FillChar(sin, 0, Sizeof(sin));
    sin.sin_family  := AF_INET;
    FAddrFormat     := PF_INET;
    FPortAssigned   := FALSE;
    FAddrAssigned   := FALSE;
    FProtoAssigned  := TRUE;
    FProto          := IPPROTO_TCP;
    FHSocket        := 0;
    FState          := Closed;
    FStateWaited    := InvalidState;
    bMoreFlag       := FALSE;
    nMoreCnt        := 0;
    nMoreMax        := 24;
    bWrite          := FALSE;
    bAllSent        := TRUE;
    ReadLineFlag    := FALSE;
    ReadLineCount   := 0;
    FPaused         := FALSE;
    FReadCount      := 0;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TWSocket.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    FBufList := TList.Create;
    Width    := 32;
    Height   := 32;
    AssignDefaultValue;
    if csDesigning in ComponentState then
        Invalidate
    else if LoadDll(WINSOCKET) then
        Invalidate;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TWSocket.Destroy;
var
    nItem : Integer;
begin
    if FState  Closed then
        Close;
    GSocketCount := GSocketCount - 1;
    if GSocketCount = 0 then begin
        if WSACleanup < 0 then
            SocketError('Destructor (WSACleanup)');
    end;
    for nItem := 0 to FBufList.Count - 1 do
        TBuffer(FBufList.Items[nItem]).Free;
    FBufList.Free;
    inherited Destroy;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWSocket.Dup(NewHSocket : TSocket);
var
    iStatus : Integer;
begin
    if (NewHSocket = 0) or (NewHSocket = INVALID_SOCKET) then begin
        Application.MessageBox('Dup called with invalid handle',
                               'WINSOCK ERROR',
                               mb_OKCancel + mb_DefButton1);
        exit;
    end;
    if FState  Closed then begin
        iStatus := CloseSocket(FHSocket);
        if iStatus  0 then
            SocketError('Dup (closesocket)');
        ChangeState(Closed);
    end;
    FHsocket := NewHSocket;
    iStatus := WSAASyncSelect(FHSocket, Handle, WM_ASYNCSELECT,
                                 FD_READ or FD_WRITE or FD_CLOSE or 
FD_CONNECT)
;
    if iStatus  0 then
        SocketError('WSAAsyncSelect');
    ChangeState(Connected);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{
procedure TWSocket.CreateWaitForm;
begin
    if FWaitForm = nil then begin
        Application.CreateForm(TSocketWaitForm, FWaitForm);
        FWaitForm.Timer.Enabled := FALSE;
        FWaitForm.Enabled       := TRUE;
    end;
end;
}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Wait for a given event.                                                   }
{ Return TRUE if the event has occured or FALSE if any error or user abort  }
function TWSocket.Wait(Timeout : integer; State : TSocketState) : boolean;
begin
    Result := FALSE;
    if FState  State then begin
        FStateWaited := State;
        if FWait  nil then begin
            FWait.Caption := IntToStr(Timeout);
            FWait.Visible := TRUE;
            FWait.StartModal;
            FWait.Visible := FALSE;
        end
        else begin
            Application.MessageBox('TWSocket.Wait: no wait object',
                                   'WINSOCK ERROR',
                                   mb_OKCancel + mb_DefButton1);
        end;
        Result := (FState = State);
        FStateWaited := InvalidState;
    end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWSocket.ReadLineStart;
begin
    if not ReadLineFlag then begin
        ReadLineBuffer := '';
        ReadLineCount  := 0;
        ReadLineFlag   := TRUE;
    end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWSocket.ReadLine(Timeout : integer; var Buffer : String);
begin
{    CreateWaitForm; }
    ReadLineStart;
    ReadLineReceive;
    if ReadLineFlag then begin
{
        FWaitForm.TimerPanel.Caption := IntToStr(Timeout);
        FWaitForm.ShowModal;
}
        FWait.Caption := IntToStr(Timeout);
        FWait.Visible := TRUE;
        FWait.StartModal;
        FWait.Visible := FALSE;
    end;
    Buffer := ReadLineBuffer;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWSocket.ReadLineReceive;
var
    Status    : Integer;
    Ch        : Char;
    bMore     : Boolean;
    LastError : Integer;
    lCount    : LongInt;
begin
    bMore := True;
    while bMore do begin
        Status := -2;
        if FState = Connected then begin
            if IoctlSocket(FHSocket, FIONREAD, lCount) = SOCKET_ERROR then
                SocketError('ioctlSocket')
            else if lCount > 0 then
                Status := Recv(FHSocket, Ch, 1, 0);
        end;
        if Status = 1 then begin
            FReadCount                    := FReadCount + 1;
            if (Ch  #10) and (Ch  #13) then begin
                ReadLineCount                 := ReadLineCount + 1;
                ReadLineBuffer[ReadLineCount] := Ch;
                ReadLineBuffer[0]             := chr(ReadLineCount);
            end;
            if Ch = #10 then begin
                bMore         := FALSE;
                ReadLineFlag  := FALSE;
{
                if FWaitForm  nil then
                    FWaitForm.Close;
}
                if FWait  nil then
                    FWait.Stop;
            end;
        end
        else if Status = 0 then begin
            { Connection closed }
            bMore         := FALSE;
            ReadLineFlag  := FALSE;
{
            if FWaitForm  nil then
                FWaitForm.Close;
}
            if FWait  nil then
                FWait.Stop;
            Close;
        end
        else if Status = SOCKET_ERROR then begin
            LastError := WSAGetLastError;
            if LastError  WSAEWOULDBLOCK then begin
                bMore := FALSE;
                SocketError('ReadLine');
            end;
        end
        else
            bMore := FALSE;
    end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWSocket.ChangeState(NewState : TSocketState);
var
    OldState : TSocketState;
begin
    OldState := FState;
    FState   := NewState;
    if Assigned(FChangeState) then
        FChangeState(self, OldState, NewState);
    if FStateWaited = NewState then begin
        FWait.Stop;
{        FWaitForm.Close; }
    end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWSocket.TWMPaint(var msg: TWMPaint);
var
  icon: HIcon;
  dc: HDC;
begin
  if csDesigning in ComponentState then
  begin
    icon   := LoadIcon(HInstance,MAKEINTRESOURCE('TSOCKET'));
    dc     := GetDC(Handle);
    Width  := 32;
    Height := 32;
    DrawIcon(dc,0,0,icon);
    ReleaseDC(Handle,dc);
    FreeResource(icon);
  end;
  ValidateRect(Handle,nil);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TWSocket.Receive(Buffer : Pointer; BufferSize: integer) : integer;
begin
    Result := Recv(FHSocket, Buffer^, BufferSize, 0);
    if Result < 0 then
        FLastError := WSAGetLastError
    else
        FReadCount := FReadCount + Result;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
------------- End of WSocket.Pas Part 2/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™.