?? httpprot.pas
字號:
I := Pos(#10, FReceiveBuffer);
if I <= 0 then
break;
if I > FReceiveLen then
break;
if (I > 1) and (FReceiveBuffer[I-2] = #13) then
FLastResponse := Copy(FReceiveBuffer, 1, I - 2)
else
FLastResponse := Copy(FReceiveBuffer, 1, I - 1);
{$IFDEF DUMP}
FDumpBuf := '>|';
FDumpStream.WriteBuffer(FDumpBuf[1], Length(FDumpBuf));
FDumpStream.WriteBuffer(FLastResponse[1], Length(FLastResponse));
FDumpBuf := '|' + #13#10;
FDumpStream.WriteBuffer(FDumpBuf[1], Length(FDumpBuf));
{$ENDIF}
{$IFDEF VER80}
{ Add a nul byte at the end of string for Delphi 1 }
FLastResponse[Length(FLastResponse) + 1] := #0;
{$ENDIF}
FReceiveLen := FReceiveLen - I;
if FReceiveLen > 0 then
Move(FReceiveBuffer[I], FReceiveBuffer[0], FReceiveLen + 1);
if FState in [httpWaitingHeader, httpWaitingBody] then begin
if Assigned(FNext) then
FNext
else
SetReady; {StateChange(httpReady);}
end
else begin
if Assigned(FOnDataAvailable) then
FOnDataAvailable(Self, Error);
end;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpCli.SocketDataSent(Sender : TObject; Error : Word);
var
Len : Integer;
begin
if not FAllowedToSend then
Exit;
Len := FSendStream.Read(FSendBuffer, sizeof(FSendBuffer));
if Len <= 0 then begin
FAllowedToSend := FALSE;
TriggerSendEnd;
Exit;
end;
if Len > 0 then begin
FSentCount := FSentCount + Len;
TriggerSendData(@FSendBuffer, Len);
FWSocket.Send(@FSendBuffer, Len);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This will start the Get process and wait until terminated (blocking) }
procedure THttpCli.Get;
begin
DoRequestSync(httpGet);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This will start the Head process and wait until terminated (blocking) }
procedure THttpCli.Head;
begin
DoRequestSync(httpHEAD);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This will start the Post process and wait until terminated (blocking) }
procedure THttpCli.Post;
begin
DoRequestSync(httpPOST);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This will start the get process and returns immediately (non blocking) }
procedure THttpCli.GetAsync;
begin
DoRequestASync(httpGet);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This will start the head process and returns immediately (non blocking) }
procedure THttpCli.HeadAsync;
begin
DoRequestASync(httpHEAD);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This will start the post process and returns immediately (non blocking) }
procedure THttpCli.PostAsync;
begin
DoRequestASync(httpPOST);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Syntax of an URL: protocol://[user[:password]@]server[:port]/path }
procedure ParseURL(
const url : String;
var Proto, User, Pass, Host, Port, Path : String);
var
p, q : Integer;
s : String;
begin
proto := '';
User := '';
Pass := '';
Host := '';
Port := '';
Path := '';
if Length(url) < 1 then
Exit;
p := pos('://',url);
if p = 0 then begin
if (url[1] = '/') then begin
{ Relative path without protocol specified }
proto := 'http';
p := 1;
if (Length(url) > 1) and (url[2] <> '/') then begin
{ Relative path }
Path := Copy(url, 1, Length(url));
Exit;
end;
end
else if lowercase(Copy(url, 1, 5)) = 'http:' then begin
proto := 'http';
p := 6;
if (Length(url) > 6) and (url[7] <> '/') then begin
{ Relative path }
Path := Copy(url, 6, Length(url));
Exit;
end;
end
else if lowercase(Copy(url, 1, 7)) = 'mailto:' then begin
proto := 'mailto';
p := pos(':', url);
end;
end
else begin
proto := Copy(url, 1, p - 1);
inc(p, 2);
end;
s := Copy(url, p + 1, Length(url));
p := pos('/', s);
if p = 0 then
p := Length(s) + 1;
Path := Copy(s, p, Length(s));
s := Copy(s, 1, p-1);
p := Posn(':', s, -1);
if p > Length(s) then
p := 0;
q := Posn('@', s, -1);
if q > Length(s) then
q := 0;
if (p = 0) and (q = 0) then begin { no user, password or port }
Host := s;
Exit;
end
else if q < p then begin { a port given }
Port := Copy(s, p + 1, Length(s));
Host := Copy(s, q + 1, p - q - 1);
if q = 0 then
Exit; { no user, password }
s := Copy(s, 1, q - 1);
end
else begin
Host := Copy(s, q + 1, Length(s));
s := Copy(s, 1, q - 1);
end;
p := pos(':', s);
if p = 0 then
User := s
else begin
User := Copy(s, 1, p - 1);
Pass := Copy(s, p + 1, Length(s));
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function EncodeStr(Encoding : THttpEncoding; const Value : String) : String;
begin
Result := EncodeLine(Encoding, @Value[1], Length(Value));
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function EncodeLine(
Encoding : THttpEncoding;
SrcData : PChar;
Size : Integer) : String;
var
Offset : Integer;
Pos1 : Integer;
Pos2 : Integer;
I : Integer;
begin
SetLength(Result, Size * 4 div 3 + 4);
FillChar(Result[1], Size * 4 div 3 + 2, #0);
if Encoding = encUUEncode then begin
Result[1] := Char(((Size - 1) and $3f) + $21);
Size := ((Size + 2) div 3) * 3;
end;
Offset := 2;
Pos1 := 0;
Pos2 := 0;
case Encoding of
encUUEncode: Pos2 := 2;
encBase64, encMime: Pos2 := 1;
end;
Result[Pos2] := #0;
while Pos1 < Size do begin
if Offset > 0 then begin
Result[Pos2] := Char(ord(Result[Pos2]) or
((ord(SrcData[Pos1]) and
($3f shl Offset)) shr Offset));
Offset := Offset - 6;
Inc(Pos2);
Result[Pos2] := #0;
end
else if Offset < 0 then begin
Offset := Abs(Offset);
Result[Pos2] := Char(ord(Result[Pos2]) or
((ord(SrcData[Pos1]) and
($3f shr Offset)) shl Offset));
Offset := 8 - Offset;
Inc(Pos1);
end
else begin
Result[Pos2] := Char(ord(Result[Pos2]) or
((ord(SrcData[Pos1]) and $3f)));
Inc(Pos2);
Inc(Pos1);
Result[Pos2] := #0;
Offset := 2;
end;
end;
case Encoding of
encUUEncode:
begin
if Offset = 2 then
Dec(Pos2);
for i := 2 to Pos2 do
Result[i] := bin2uue[ord(Result[i])+1];
end;
encBase64, encMime:
begin
if Offset = 2 then
Dec(Pos2);
for i := 1 to Pos2 do
Result[i] := bin2b64[ord(Result[i])+1];
while (Pos2 and 3) <> 0 do begin
Inc(Pos2);
Result[Pos2] := '=';
end;
end;
end;
SetLength(Result, Pos2);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Find the count'th occurence of the s string in the t string. }
{ If count < 0 then look from the back }
function Posn(const s , t : String; Count : Integer) : Integer;
var
i, h, Last : Integer;
u : String;
begin
u := t;
if Count > 0 then begin
Result := Length(t);
for i := 1 to Count do begin
h := Pos(s, u);
if h > 0 then
u := Copy(u, h + 1, Length(u))
else begin
u := '';
Inc(Result);
end;
end;
Result := Result - Length(u);
end
else if Count < 0 then begin
Last := 0;
for i := Length(t) downto 1 do begin
u := Copy(t, i, Length(t));
h := Pos(s, u);
if (h <> 0) and ((h + i) <> Last) then begin
Last := h + i - 1;
Inc(count);
if Count = 0 then
break;
end;
end;
if Count = 0 then
Result := Last
else
Result := 0;
end
else
Result := 0;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -