?? sock.pas
字號:
begin
if FListen then
raise
ESockException.Create('SocketType - Can''t Assign Socket Type While Listening');
if FConnected then
raise
ESockException.Create('SocketType - Can''t Assign Socket Type While Connected');
FSocketType := Value;
end
end;
function TSock.GetRemoteHost: string;
begin
// Convert FRecvAddrIn To A String IP Address
Result := INet_NToA(FRecvAddrIn.SIn_Addr);
end;
procedure TSock.DoInfo(SocketInfo: TSocketInfo; Msg: string);
begin
if Assigned(FOnInfo) then
FOnInfo(Self, SocketInfo, Msg);
end;
procedure TSock.SetBitmap;
begin
// Determine The Design-Time Bitmap To Use
if FSocketType = stDatagram then
FPicture := FBmp_UDP
else if FListen then
FPicture := FBmp_Listen
else
FPicture := FBmp_TCP;
Invalidate;
end;
//*** Constructor/Destructor ***************************************************
constructor TSock.Create(AOwner: TComponent);
begin
m_receiveForm := TForm.Create(nil);
inherited Create(m_receiveForm);
m_lock := TBCCritSec.Create;
Parent := TWinControl(m_receiveForm);
// <<--- added by blacktrip, wild cast but
// prevent crashes !!!
if WinSock.WSAStartup($0101, WSAData) <> 0 then
raise ESockException.Create('WSAStartup - Could Not Initialize WinSock');
IPCache := TStringList.Create;
IPCache.Clear;
if (csDesigning in ComponentState) then
begin
// Get Bitmaps For Design-Time Image
FBmp_TCP := TBitmap.Create;
FBmp_UDP := TBitmap.Create;
FBmp_Listen := TBitmap.Create;
FBmp_TCP.Handle := LoadBitmap(hInstance, 'TCP');
FBmp_UDP.Handle := LoadBitmap(hInstance, 'UDP');
FBmp_Listen.Handle := LoadBitmap(hInstance, 'LISTEN');
FPicture := FBmp_TCP;
Width := FPicture.Width;
Height := FPicture.Height;
SetZOrder(True);
end
else
begin
Width := 0;
Height := 0;
SetZOrder(False);
Visible := False;
end;
FHostName := '';
FPortName := '';
FLocalPortName := '-1';
FSocket := INVALID_SOCKET;
FLineBreak := lbSmart;
FLastChar := #0;
FInBuffer := '';
FOutBuffer := '';
FListen := False;
FBlocking := False;
FAutoAccept := False;
FConnected := False;
FStream := TSockStream.Create(Self);
FFreeOnClose := False;
end;
// This Constructor Assumes NewSocket Is A Valid Socket Handle
constructor TSock.CreateWithSocket(AOwner: TComponent; NewSocket: TSocket);
begin
Create(AOwner);
FSocket := NewSocket;
SetBlocking(TSock(AOwner).Blocking);
FBlockTime := TSock(AOwner).BlockingTimeout;
FOnRead := TSock(AOwner).OnRead;
FOnWrite := TSock(AOwner).OnWrite;
FOnDisconnect := TSock(AOwner).OnDisconnect;
FOnInfo := TSock(AOwner).OnInfo;
FConnected := True;
FLineBreak := TSock(AOwner).LineBreak;
FRecvAddrIn := TSock(AOwner).RecvAddrIn;
FFreeOnClose := not FBlocking;
end;
destructor TSock.Destroy;
begin
if FListen or FConnected then
Close;
if (csDesigning in ComponentState) then
begin
FBmp_TCP.Free;
FBmp_UDP.Free;
FBmp_Listen.Free;
end;
FStream.Free;
IPCache.Free;
WinSock.WSACleanup;
inherited Destroy;
end;
procedure TSock.Loaded;
begin
if not (csDesigning in ComponentState) then
begin
// If Component Has Been Loaded At Run-Time And Listen Then Start Listening
SetBlocking(FBlocking);
if FListen then
begin
FListen := False;
SetListen(True);
end;
end;
end;
//*** Event Handling ***********************************************************
procedure TSock.WMSock(var Message: TMessage);
var
Event: Word;
Error: Word;
Res: Integer;
AcSck: TSocket;
Addr: TSockAddrIn;
AddrL: Integer;
CSock: TSock;
Spawn: TSockThread;
begin
m_lock.Lock;
inherited;
// Message Handling For Non-Blocking Sockets
Event := WinSock.WSAGetSelectEvent(Message.LParam);
Error := WinSock.WSAGetSelectError(Message.LParam);
if (Error > WSABASEERR) then
DoInfo(SiError, 'Error #' + IntToStr(Error) + ' (' + ErrToStr(Error) + ')');
if (Error <= WSABASEERR) or (Event = FD_CLOSE) then
// Messages Mean Different Things Depending On Whether You're Listening Or Not
case Event of
FD_ACCEPT:
begin
// Incoming Socket
if FAutoAccept and Assigned(FOnAutoAccept) then
begin
// If AutoAccept Is Set To True And OnAutoAccept Is Set...
// Create A New Socket Based On The Accepted One And Begin
// AutoAccept As If It Were A Thread... The AutoAccept
// Routine Is Responsible For Destroying The New Socket
// Component.
AddrL := SizeOf(Addr);
FillChar(Addr, SizeOf(Addr), #0);
{$IFDEF VER93}
AcSck := WinSock.Accept(FSocket, Addr, AddrL);
{$ELSE}
{$IFDEF WIN32}
AcSck := WinSock.Accept(FSocket, @Addr, @AddrL);
{$ELSE}
AcSck := WinSock.Accept(FSocket, Addr, AddrL);
{$ENDIF}
{$ENDIF}
FRecvAddrIn := Addr;
CSock := TSock.CreateWithSocket(Self, AcSck);
CSock.PortName := FPortName;
CSock.LocalPortName := FLocalPortName;
CSock.HostName := INet_NToA(Addr.SIn_Addr);
if FBlocking then
begin
Spawn := TSockThread.Create(True);
Spawn.RunThread(Self, CSock);
end
else
FOnAutoAccept(Self, CSock);
end
else if Assigned(FOnAccept) then
FOnAccept(Self);
end;
FD_CONNECT:
begin
FConnected := True;
DoInfo(SiConnect, 'Non-Blocking Socket Connected');
if Assigned(FOnConnect) then
FOnConnect(Self);
end;
FD_CLOSE:
begin
if Assigned(FOnDisconnect) then
FOnDisconnect(Self);
Close;
end;
FD_READ:
begin
if FSocketType = stStream then
begin
Res := WinSock.Recv(FSocket, FCharBuf, SizeOf(FCharBuf), 0);
if Res > 0 then
FInBuffer := FInBuffer + Copy(FCharBuf, 1, Res);
DoInfo(SiReceive, 'Non-Blocking Incoming Data');
if Assigned(FOnRead) then
begin
FOnRead(Self, Length(FInBuffer));
end;
end
else if Assigned(FOnRead) then
FOnRead(Self, Length(FInBuffer));
end;
FD_WRITE:
begin
if FOutBuffer <> '' then
Send('');
DoInfo(SiSend, 'Non-Blocking Outgoing Data');
if Assigned(FOnWrite) then
FOnWrite(Self);
end;
end;
Message.Result := 0;
m_lock.UnLock;
end;
procedure TSock.WMPaint(var Message: TWMPaint);
begin
inherited;
if (csDesigning in ComponentState) then
Canvas.Draw(0, 0, FPicture);
Message.Result := 0;
end;
procedure TSock.WMSize(var Message: TWMSize);
begin
inherited;
if (csDesigning in ComponentState) then
begin
if Width <> FPicture.Width then
Width := FPicture.Width;
if Height <> FPicture.Height then
Height := FPicture.Height;
end;
Message.Result := 0;
end;
//*** Support Methods **********************************************************
function TSock.Open: Boolean;
var
Res: Integer;
ST: Integer;
LAddrIn: TSockAddrIn;
//optval: integer;
begin
if FSocket = INVALID_SOCKET then
begin
if FSocketType = stStream then
ST := SOCK_STREAM
else
ST := SOCK_DGRAM;
// Create The Socket
FSocket := WinSock.Socket(AF_INET, ST, IPPROTO_IP);
SetBlocking(FBlocking);
// Set local options
LAddrIn.SIn_Family := AF_INET;
if FLocalPortName = '-1' then
LAddrIn.SIn_Port := PortLookup(FPortName)
// Default behaviour for backward compatibility
else
LAddrIn.SIn_Port := PortLookup(FLocalPortName);
LAddrIn.SIn_Addr.S_Addr := HToNL(INADDR_ANY);
// No HostLookup(...) Because INADDR_ANY Is A Windows Constant
// Set Up The Remote Address And Port
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := PortLookup(FPortName);
FSockAddrIn.SIn_Addr := HostLookup(FHostName);
if FSocketType = stStream then
begin
// Stream Sockets Require A Connect
Res := WinSock.Bind(FSocket, LAddrIn, SizeOf(LAddrIn)) +
WinSock.Connect(FSocket, FSockAddrIn, SizeOf(TSockAddrIn));
if FBlocking then
begin
if Res = 0 then
begin
FConnected := True;
DoInfo(SiConnect, 'Blocking Socket Connected');
if Assigned(FOnConnect) then
FOnConnect(Self);
end
else
begin
DoInfo(SiClose, 'Blocking Socket Can''t Connect');
Close;
end;
end;
end
else
begin
//Datagram Sockets are connectionless, so they don't get connected.
//It is possible to call WinSock.Connect, but it would produce extra overhead
//as it only sets the default destination.
Res := WinSock.Bind(FSocket, LAddrIn, SizeOf(LAddrIn));
if Res = 0 then
begin
FConnected := True;
DoInfo(SiConnect, 'Datagram Socket Connected');
if Assigned(FOnConnect) then
FOnConnect(Self);
end
else
begin
DoInfo(SiClose, 'Datagram Socket Can''t Connect');
Close;
end;
end;
end;
Result := FConnected;
end;
function TSock.Close: Boolean;
begin
Result := (WinSock.CloseSocket(FSocket) = 0);
FSocket := INVALID_SOCKET;
FConnected := False;
if not FListen then
DoInfo(SiClose, 'Socket Closed');
FListen := False;
if FFreeOnClose then
Free;
end;
function TSock.Send(Value: string): Boolean;
var
Remain: Integer;
begin
Result := True;
if FSocket = INVALID_SOCKET then
raise ESockException.Create('Send - Socket Not Connected');
if FListen then
raise ESockException.Create('Send - Cannot Send On A Listener Socket');
if FSocketType = stStream then
begin
FOutBuffer := FOutBuffer + Value;
if FOutBuffer = '' then
Exit;
if FBlocking then
begin
Remain := Length(FOutBuffer);
// While Any Content Remains Or No Errors Have Happened, Then Loop
while Remain > 0 do
begin
Remain := WinSock.Send(FSocket, FOutBuffer[1], Length(FOutBuffer), 0);
if (Remain = SOCKET_ERROR) and (WinSock.WSAGetLastError <>
WSAEINPROGRESS) then
begin
DoInfo(SiError, 'Socket Error On Send');
raise ESockException.Create('Send - Socket Error');
end
else
begin
if Remain > 0 then
Delete(FOutBuffer, 1, Remain);
Remain := Length(FOutBuffer);
DoInfo(SiSend, 'Blocking Outgoing Data');
end;
end;
FOutBuffer := '';
end
else
begin
// Do Not Loop For A Non-Blocking Socket
DoInfo(SiSend, 'Non-Blocking Outgoing Data');
Remain := WinSock.Send(FSocket, FOutBuffer[1], Length(FOutBuffer), 0);
if Remain > 0 then
Delete(FOutBuffer, 1, Remain);
end;
end
else
SendDatagram(Value, FHostName);
end;
function TSock.SendLine(Value: string): Boolean;
var
Break: string;
begin
case FLineBreak of
lbCR: Break := #13;
lbLF: Break := #10;
else
Break := #13#10;
end;
Result := Send(Value + Break);
end;
function TSock.Receive: string;
begin
Result := ReceiveCount(-1);
end;
function TSock.ReceiveCount(Count: Integer): string;
var
Res: Integer;
FDSet: PFDSet;
TV: PTimeVal;
Err: Integer;
HostN: string;
Cnt: Integer;
begin
if (FSocket = INVALID_SOCKET) and (FInBuffer = '') then
raise ESockException.Create('Receive - Socket Not Connected');
if FListen then
raise
ESockException.Create('Receive - Cannot Receive On A Listener Socket');
Cnt := Count;
if (Cnt = -1) or (Cnt > SizeOf(FCharBuf)) then
Cnt := SizeOf(FCharBuf);
if FSocketType = stStream then
begin
if FBlocking then
begin
FDSet := New(PFDSet);
FDSet^.FD_Count := 1;
FDSet^.FD_Array[0] := FSocket;
if FBlockTime >= 0 then
begin
TV := New(PTimeVal);
TV^.tv_sec := FBlockTime;
end
else
TV := nil;
// Used To Loop While We're Connected And Anything Is In The Input Queue
if FConnected and (WinSock.Select(FSocket, FDSet, nil, nil, TV) > 0) then
begin
DoInfo(SiReceive, 'Blocking Incoming Data');
Res := WinSock.Recv(FSocket, FCharBuf, Cnt, 0);
if (Res = SOCKET_ERROR) then
begin
Err := WSAGetLastError;
Result := '';
FInBuffer := '';
Dispose(FDSet);
Dispose(TV);
DoInfo(SiError, 'Socket Error On Receive');
if (not (Err - WSABASEERR in [WSAEINTR - WSABASEERR, WSAEINPROGRESS -
WSABASEERR, WSAEOPNOTSUPP - WSABASEERR, WSAEWOULDBLOCK - WSABASEERR,
WSAEMSGSIZE - WSABASEERR])) then
begin
DoInfo(siClose, 'Socket Disconnected On Error On Receive');
Close;
if Assigned(FOnDisconnect) then
FOnDisconnect(Self);
end;
raise ESockException.Create('Receive - Socket Error ' +
ErrToStr(Err));
end
else
begin
if Res > 0 then
FInBuffer := FInBuffer + Copy(FCharBuf, 1, Res)
else if Res = 0 then
begin
DoInfo(siClose, 'Socket Disconnected On Receive');
Close;
if Assigned(FOnDisconnect) then
FOnDisconnect(Self);
end;
end;
end;
Result := FInBuffer;
FInBuffer := '';
Dispose(FDSet);
Dispose(TV);
end
else
begin
if ((Count <> -1) and (Length(FInBuffer) > Count)) then
begin
Result := Copy(FInBuffer, 1, Count);
Delete(FInBuffer, 1, Count);
end
else
begin
Result := FInBuffer;
FInBuffer := '';
end;
end;
end
else
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -