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)
|