?? sock.pas
字號:
Result := ReceiveDatagram(HostN);
end;
function TSock.ReceiveLine: string;
var
CPos, CLen: LongInt;
Temp: string;
begin
CPos := 0;
Result := '';
if FSocketType = stStream then
begin
if (FBlocking and FConnected) then
begin
Temp := FInBuffer;
FInBuffer := '';
Temp := Temp + Receive;
FInBuffer := Temp;
end;
if (FLastChar = #13) and (FLineBreak = lbSmart) and (FInBuffer[1] = #10)
then
begin
Delete(FInBuffer, 1, 1);
FLastChar := #0;
end;
case FLineBreak of
lbCR: CPos := Pos(#13, FInBuffer);
lbLF: CPos := Pos(#10, FInBuffer);
lbCRLF: CPos := Pos(#13#10, FInBuffer);
lbSmart:
begin
CPos := Pos(#13, FInBuffer);
if (CPos = 0) or (Pos(#10, FInBuffer) < CPos) then
CPos := Pos(#10, FInBuffer);
if CPos > 0 then
FLastChar := FInBuffer[CPos]
else
FLastChar := #0;
end;
end;
if FLineBreak = lbCRLF then
CLen := 2
else
CLen := 1;
if (CPos > 0) or (not FConnected) then
begin
if CPos > 0 then
begin
Result := Copy(FInBuffer, 1, CPos - 1);
Delete(FInBuffer, 1, CPos + (CLen - 1));
end
else
begin
Result := FInBuffer;
FInBuffer := '';
end;
end;
end
else
Result := Receive;
end;
function TSock.SendDatagram(Value, HostName: string): Boolean;
begin
if FSocket = INVALID_SOCKET then
raise ESockException.Create('SendDatagram - Socket Not Connected');
if FSocketType = stStream then
raise
ESockException.Create('SendDatagram - Datagram Send Not Supported On Stream Sockets');
Result := True;
SetHostName(HostName);
if Value = '' then
Exit;
WinSock.SendTo(FSocket, Value[1], Length(Value), 0, FSockAddrIn,
SizeOf(TSockAddrIn));
end;
function TSock.ReceiveDatagram(var HostName: string): string;
var
Res: Integer;
FDSet: PFDSet;
TV: PTimeVal;
FLen: Integer;
begin
if FSocket = INVALID_SOCKET then
raise ESockException.Create('ReceiveDatagram - Socket Not Connected');
if FSocketType = stStream then
raise
ESockException.Create('ReceiveDatagram - Datagram Receive Not Supported On Stream Sockets');
FDSet := New(PFDSet);
FDSet^.FD_Count := 1;
FDSet^.FD_Array[0] := FSocket;
Result := '';
HostName := '';
if FBlockTime >= 0 then
begin
TV := New(PTimeVal);
TV^.tv_sec := FBlockTime;
end
else
TV := nil;
if WinSock.Select(FSocket, FDSet, nil, nil, TV) > 0 then
begin
FLen := Sizeof(FRecvAddrIn);
Res := WinSock.RecvFrom(FSocket, FCharBuf, SizeOf(FCharBuf), 0, FRecvAddrIn,
FLen);
if Res > 0 then
begin
Result := Copy(FCharBuf, 1, Res);
HostName := GetRemoteHost;
end
else
raise ESockException.Create('Socket Error while Receiving Datagram:' +
IntToStr(WSAGetLastError));
end;
Dispose(FDSet);
Dispose(TV);
end;
function TSock.Accept(var NewSock: TSock): Boolean;
var
AcSck: TSocket;
AddrL: Integer;
Addr: TSockAddrIn;
begin
// Accept Creates A New Instance Of A TSock Component And Returns It To The
// User Application. The User Is Responsible For Freeing The Component.
if not FListen then
raise ESockException.Create('Accept - Socket Not In Listening Mode');
if FBlocking then
DoInfo(SiAccept, 'Blocking Accept');
AddrL := SizeOf(Addr);
{$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;
if AcSck <> INVALID_SOCKET then
begin
NewSock := TSock.CreateWithSocket(Self, AcSck);
NewSock.PortName := FPortName;
NewSock.LocalPortName := FLocalPortName;
NewSock.HostName := INet_NToA(Addr.SIn_Addr);
Result := True;
DoInfo(SiAccept, 'Created New TSock Structure');
end
else
begin
Result := False;
DoInfo(SiAccept, 'Could Not Accept Connection');
end;
end;
function TSock.HostLookup(Value: string): TInAddr;
type
PLongInt = ^LongInt;
var
PHost: PHostEnt;
Res, I: Integer;
AllNumeric: Boolean;
begin
if Value = '' then
Exit;
DoInfo(SiLookUp, 'Lookup Of Host ' + Value);
FillChar(Result, SizeOf(TInAddr), #0);
AllNumeric := True;
for I := 1 to Length(Value) do
if not (Value[I] in ['0'..'9', '.']) then
begin
AllNumeric := False;
Break;
end;
if AllNumeric then
Result := TInAddr(WinSock.Inet_Addr(PChar(Value)))
// If It's Dot-Notation, Just Convert It From An IP Address
else
begin
Res := IPCache.IndexOf(Value);
if Res >= 0 then
// It's Cached... Don't Bother Doing A Lookup
Result.S_Addr := U_Long(IPCache.Objects[Res])
else
begin
// Isn't Cached, Have To Do A GetHostByName
if Value <> '' then
begin
PHost := WinSock.GetHostByName(PChar(Value));
if PHost <> nil then
begin
Result.S_Addr := LongInt(PLongInt(PHost^.H_Addr_List^)^);
IPCache.AddObject(Value, Pointer(Result.S_Addr));
end
else
begin
// If Assigned(FOnInfo) then // added by coder@dsplayer.de
// FOnInfo(self,siError,'Host Lookup - Could Not Find Host Entry');
//Raise ESockException.Create('Host Lookup - Could Not Find Host Entry');
end;
end
else
Result.S_Addr := HToNL(INADDR_ANY);
end;
end;
end;
function TSock.PortLookup(Value: string): U_Short;
var
PEnt: PServEnt;
Prot: string;
begin
DoInfo(SiLookUp, 'Lookup Of Port ' + Value);
if Pos(Value[1], '0123456789') > 0 then
// It's Numeric, Just Convert It To A Network Byte Order Integer
Result := HToNS(StrToInt(Value))
else
begin
// Otherwise, Perform A GetServByName Based On The Protocol
if FSocketType = stStream then
Prot := 'tcp'
else
Prot := 'udp';
PEnt := WinSock.GetServByName(PChar(Value), PChar(Prot));
if PEnt <> nil then
Result := PEnt^.S_Port
else
raise ESockException.Create('Port Lookup - Could Not Find Service Entry');
end;
end;
function TSock.StartListen: Boolean;
begin
SetListen(True);
Result := FListen;
end;
function TSock.StopListen: Boolean;
begin
Result := True;
SetListen(False);
end;
//*** Additional General-Purpose Support Functions *****************************
function WSDescription: string;
begin
Result := StrPas(WSAData.szDescription);
end;
function WSSystemStatus: string;
begin
Result := StrPas(WSAData.szSystemStatus);
end;
function GetLocalHostname: string;
var
CharHostname: array[0..255] of Char;
begin
Result := 'localhost';
if WinSock.GetHostname(CharHostname, SizeOf(CharHostname)) = 0 then
Result := CharHostname
else
raise
ESockException.Create('GetLocalHostname - Could Not Retrieve Hostname');
end;
function SocketInfoText(Value: TSocketInfo): string;
begin
Result := SocketInfoMsg[Value];
end;
function ErrToStr(Value: Integer): string;
begin
Result := 'UNKNOWN ERROR';
case Value of
WSABASEERR + 4: Result := 'WSAEINTR';
WSABASEERR + 9: Result := 'WSAEBADF';
WSABASEERR + 13: Result := 'WSAEACCES';
WSABASEERR + 14: Result := 'WSAEFAULT';
WSABASEERR + 22: Result := 'WSAEINVAL';
WSABASEERR + 24: Result := 'WSAEMFILE';
WSABASEERR + 35: Result := 'WSAEWOULDBLOCK';
WSABASEERR + 36: Result := 'WSAEINPROGRESS';
WSABASEERR + 37: Result := 'WSAEALREADY';
WSABASEERR + 38: Result := 'WSAENOTSOCK';
WSABASEERR + 39: Result := 'WSAEDESTADDRREQ';
WSABASEERR + 40: Result := 'WSAEMSGSIZE';
WSABASEERR + 41: Result := 'WSAEPROTOTYPE';
WSABASEERR + 42: Result := 'WSAENOPROTOOPT';
WSABASEERR + 43: Result := 'WSAEPROTONOSUPPORT';
WSABASEERR + 44: Result := 'WSAESOCKTNOSUPPORT';
WSABASEERR + 45: Result := 'WSAEOPNOTSUPP';
WSABASEERR + 46: Result := 'WSAEPFNOSUPPORT';
WSABASEERR + 47: Result := 'WSAEAFNOSUPPORT';
WSABASEERR + 48: Result := 'WSAEADDRINUSE';
WSABASEERR + 49: Result := 'WSAEADDRNOTAVAIL';
WSABASEERR + 50: Result := 'WSAENETDOWN';
WSABASEERR + 51: Result := 'WSAENETUNREACH';
WSABASEERR + 52: Result := 'WSAENETRESET';
WSABASEERR + 53: Result := 'WSAECONNABORTED';
WSABASEERR + 54: Result := 'WSAECONNRESET';
WSABASEERR + 55: Result := 'WSAENOBUFS';
WSABASEERR + 56: Result := 'WSAEISCONN';
WSABASEERR + 57: Result := 'WSAENOTCONN';
WSABASEERR + 58: Result := 'WSAESHUTDOWN';
WSABASEERR + 59: Result := 'WSAETOOMANYREFS';
WSABASEERR + 60: Result := 'WSAETIMEDOUT';
WSABASEERR + 61: Result := 'WSAECONNREFUSED';
WSABASEERR + 62: Result := 'WSAELOOP';
WSABASEERR + 63: Result := 'WSAENAMETOOLONG';
WSABASEERR + 64: Result := 'WSAEHOSTDOWN';
WSABASEERR + 65: Result := 'WSAEHOSTUNREACH';
WSABASEERR + 66: Result := 'WSAENOTEMPTY';
WSABASEERR + 67: Result := 'WSAEPROCLIM';
WSABASEERR + 68: Result := 'WSAEUSERS';
WSABASEERR + 69: Result := 'WSAEDQUOT';
WSABASEERR + 70: Result := 'WSAESTALE';
WSABASEERR + 71: Result := 'WSAEREMOTE';
WSABASEERR + 91: Result := 'WSASYSNOTREADY';
WSABASEERR + 92: Result := 'WSAVERNOTSUPPORTED';
WSABASEERR + 93: Result := 'WSANOTINITIALISED';
WSABASEERR + 101: Result := 'WSAEDISCON';
WSABASEERR + 1001: Result := 'WSAHOST_NOT_FOUND';
WSABASEERR + 1002: Result := 'WSATRY_AGAIN';
WSABASEERR + 1003: Result := 'WSANO_RECOVERY';
WSABASEERR + 1004: Result := 'WSANO_DATA';
end;
end;
// Base-64 Encoding Is The Process Of Taking An Input Stream And Converting
// Every 3 Bytes Into 4 Bytes, Each Of Which Whose ASCII Value Fits Within
// A 64-Bit Range. Base-64 Is Often Used For Encoding Binary Streams For
// Attaching To Email, But Is Perfect For Converting Binary To A Character
// Set That Can Be Used For URL-Encoding. The Base-64 Character Set Does Not
// Include Characters That URLs Use For Delimiting Such As '=', '&', Carriage
// Returns, Etc...
function Base64Encode(Value: string): string;
var
AIn: array[1..3] of Byte;
AOut: array[1..4] of Byte;
AWork: array[1..3] of Byte;
I: Integer;
O: LongInt;
begin
Result := '';
I := 1;
O := Length(Value);
case Length(Value) mod 3 of
1: Value := Value + #0 + #0;
2: Value := Value + #0;
end;
while I < Length(Value) do
begin
AIn[1] := Byte(Value[I]);
AIn[2] := Byte(Value[I + 1]);
AIn[3] := Byte(Value[I + 2]);
AOut[1] := Byte(AIn[1] shr 2);
AWork[1] := Byte(AIn[1] shl 4);
AWork[2] := Byte(AWork[1] and $30);
AWork[3] := Byte(AIn[2] shr 4);
AOut[2] := Byte(AWork[2] or AWork[3]);
AWork[1] := Byte(AIn[2] shl 2);
AWork[2] := Byte(AWork[1] and $3C);
AWork[3] := Byte(AIn[3] shr 6);
AOut[3] := Byte(AWork[2] or AWork[3]);
AOut[4] := Byte(AIn[3] and $3F);
Inc(I, 3);
Result := Result + Base64Table[AOut[1] + 1] + Base64Table[AOut[2] + 1] +
Base64Table[AOut[3] + 1] + Base64Table[AOut[4] + 1];
end;
if O mod 3 > 0 then
Result[Length(Result)] := '=';
if O mod 3 = 1 then
Result[Length(Result) - 1] := '=';
end;
function Base64Decode(Value: string): string;
var
AIn: array[1..4] of Byte;
AOut: array[1..3] of Byte;
AWork: array[1..3] of Byte;
I: Integer;
C: Integer;
begin
Result := '';
I := 1;
while I < Length(Value) do
begin
C := 3;
FillChar(AWork, SizeOf(AWork), #0);
FillChar(AOut, SizeOf(AWork), #0);
AIn[1] := Byte(Pos(Value[I], Base64Table) - 1);
AIn[2] := Byte(Pos(Value[I + 1], Base64Table) - 1);
AIn[3] := Byte(Pos(Value[I + 2], Base64Table) - 1);
AIn[4] := Byte(Pos(Value[I + 3], Base64Table) - 1);
if Value[I + 3] = '=' then
begin
C := 2;
AIn[4] := 0;
if Value[I + 2] = '=' then
begin
C := 1;
AIn[3] := 0;
end;
end;
AWork[2] := Byte(AIn[1] shl 2);
AWork[3] := Byte(AIn[2] shr 4);
AOut[1] := Byte(AWork[2] or AWork[3]);
AWork[2] := Byte(AIn[2] shl 4);
AWork[3] := Byte(AIn[3] shr 2);
AOut[2] := Byte(AWork[2] or AWork[3]);
AWork[2] := Byte(AIn[3] shl 6);
AOut[3] := Byte(AWork[2] or AIn[4]);
Result := Result + Char(AOut[1]);
if C > 1 then
Result := Result + Char(AOut[2]);
if C > 2 then
Result := Result + Char(AOut[3]);
Inc(I, 4);
end;
end;
// This function converts a string into a RFC 1630 compliant URL,
// provided that the string does not contain illegal characters at illegal
// places, for example this URL is invalid because of the ! sign in the password:
// ftp://ward:pass!word@ftp.ward.nu/my_documents/ward@mymail?
function URLEncode(Value: string): string;
var
I: Integer;
begin
Result := '';
for I := 1 to Length(Value) do
begin
if Pos(UpperCase(Value[I]), ValidURLChars) > 0 then
Result := Result + Value[I]
else
begin
if Value[I] = ' ' then
Result := Result + '+'
else
begin
Result := Result + '%';
Result := Result + IntToHex(Byte(Value[I]), 2);
end;
end;
end;
end;
function URLDecode(Value: string): string;
const
HexChars = '0123456789ABCDEF';
var
I: Integer;
Ch, H1, H2: Char;
begin
Result := '';
I := 1;
while I <= Length(Value) do
begin
Ch := Value[I];
case Ch of
'%':
begin
H1 := Value[I + 1];
H2 := Value[I + 2];
Inc(I, 2);
Result := Result + Chr(((Pos(H1, HexChars) - 1) * 16) + (Pos(H2,
HexChars) - 1));
end;
'+': Result := Result + ' ';
'&': Result := Result + #13 + #10;
else
Result := Result + Ch;
end;
Inc(I);
end;
end;
//*** Registration And Initialization ******************************************
procedure Register;
begin
RegisterComponents('Ward', [TSock]);
end;
initialization // (moved to create)
// We're Looking To Use Version 1.1 Of WinSock Here
{ If WinSock.WSAStartup($0101, WSAData) <> 0 Then
Raise ESockException.Create('WSAStartup - Could Not Initialize WinSock');
IPCache := TStringList.Create;
IPCache.Clear; }
finalization // moved to destroy
{ IPCache.Free;
WinSock.WSACleanup; }
end.
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -