2

我让我的 OWN 单元使用 winsocket 从网络服务器获取 POST 请求。

这是我的单位：

unit uGetPost;

interface

uses
Winsock,
SysUtils,
Windows;

function GetPost(CompleteURL, PostData : String; var Results : String ; Port: Integer = 80) : Integer;

implementation

procedure RemoveCRLFFromEndAndBeginning (var s : String);
var
 i : Integer;
begin
  i := Length(s);
  while (s[i] = #10) or (s[i] = #13) do begin
    SetLength (s, i - 1);
    dec (i);  
  end;
  i := 1;
  while (s[i] = #10) or (s[i] = #13) do begin
    s := Copy (s, 2, Length(s));
    inc (i);  
  end;
end;

function GetIpFromDns(HostName: string): string;
type
  tAddr = array[0..100] of PInAddr;
  pAddr = ^tAddr;
var
  I: Integer;
  WSA: TWSAData;
  PHE: PHostEnt;
  P: pAddr;
begin
  Result := HostName;
  WSAStartUp($101, WSA);
  try
    PHE := GetHostByName(pChar(HostName));
    if (PHE <> nil) then
    begin
      P := pAddr(PHE^.h_addr_list);
      I := 0;
      while (P^[i] <> nil) do
      begin
        Result := (inet_nToa(P^[i]^));
        Inc(I);
      end;
    end;
  except
  end;
  WSACleanUp;
end;

function Parsing(Char, Str: string; Count: Integer): string;
var
  i                 : Integer;
  strResult         : string;
begin
  if Str[Length(Str)] <> Char then
    Str := Str + Char;
  for i := 1 to Count do
  begin
    strResult := Copy(Str, 0, Pos(Char, Str) - 1);
    Str := Copy(Str, Pos(Char, Str) + 1, Length(Str));
  end;
  Result := strResult;
end;


function GetPost(CompleteURL, PostData : String; var Results : String ; Port: Integer = 80) : Integer;
// 1 = Complete Success
// 2 = No Content (Length found) or wrong GET/POST
// 3 = Host found but no php file
// 4 = Host not found (Total FAIL!);
var
  WSA: TWSAData;
  Sock: TSocket;
  Addr: TSockAddrIn;
  SendBuffer: String;
  ReceiveBuffer: array[0..4096] of Char;
  ReceivedBytes: Integer;
  DNS, RemoteFilePath, FileName: string;
  i: integer;
  SentBytes: Integer;
  ContentLength : Integer;
begin
  result := 4;
  DNS := Copy(CompleteURL, Pos('http://', CompleteURL) + 7, Length(CompleteURL));
  RemoteFilePath := Copy(DNS, Pos('/', DNS), Length(DNS));
  DNS := Copy(DNS, 1, Pos('/', DNS) - 1);
  i := Length(RemoteFilePath);
  while (RemoteFilePath[i] <> '/') do
  begin
    FileName := RemoteFilePath[i] + FileName;
    Dec(i);
  end;  
  WSAStartup($101, WSA);
  Sock := Socket(AF_INET, SOCK_STREAM, 0);
  Addr.sin_family := AF_INET;
  if (Port < 1) or (Port > 65535) then Port := 80;
  Addr.sin_port := htons(Port);
  Addr.sin_addr.S_addr := inet_addr(PChar(GetIPfromDNS(PChar(DNS))));
  if Connect(Sock, Addr, sizeof(Addr)) = 0 then begin
    result := 3;
    SendBuffer := 'POST ' + RemoteFilePath + ' HTTP/1.1' + #13#10 +
    'Host: ' + DNS + #13#10 +
    'User-Agent: Mozilla/5.0 (Windows NT 5.1; rv:16.0) Gecko/20100101 Firefox/16.0' + #13#10 +
    'Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8' + #13#10 +
    'Accept-Language: en-US,en;q=0.5' + #13#10 +
    'Accept-Encoding: gzip, deflate' + #13#10 +
    'Connection: close' + #13#10 +
    'Cache-Control: max-age=0' + #13#10 +
    'Content-Type: application/x-www-form-urlencoded' + #13#10 +
    'Content-Length: ' + inttostr(Length(PostData)) + #13#10#13#10 +
    PostData;
    repeat
      SentBytes := Send(Sock, SendBuffer[1 + SentBytes], Length(SendBuffer) - SentBytes, 0);
    until SentBytes >= Length(SendBuffer);
    repeat
      ZeroMemory(@ReceiveBuffer, Sizeof(ReceiveBuffer));
      ReceivedBytes := Recv(Sock, ReceiveBuffer, Sizeof(ReceiveBuffer), 0);
      if ReceivedBytes > 0 then begin
        Results := Results + ReceiveBuffer;
      end;
    until (ReceivedBytes <= 0);
    CloseSocket(Sock);
  end;
  WSACleanup();
  if Copy (Results, 10, 6) = '200 OK' then begin
    result := 2;
    if Pos ('Content-Length: ', Results) <> 0 then begin
      i := 1;
      while Parsing(#13, Results, i) <> '' do begin
        if Pos ('Content-Length: ' , Parsing(#13, Results, i)) <> 0 then begin
          ContentLength := strtoint (Copy(Parsing(#13, Results, i), 18, Length (Results)));
          results := Copy (results,Length(results) - ContentLength + 1, ContentLength);
          break;
        end;
        inc (i);
      end;
      if ContentLength <> 0 then begin
        result := 1;
        RemoveCRLFFromEndandBeginning (results);
      end else begin
        results := '';
      end;
    end;
  end;
end;


end.

我在这样的 VCL 应用程序中运行 GetPost 函数：

var
 Res : String;
begin
 GetPost ('http://guest1320958.studio2.coderun.com/PHPTest/', 'GET=VERSION', Res);
 ShowMessage (Res);
end;

结果如下：

HTTP/1.1 400 错误请求内容类型：文本/html 日期：2012 年 10 月 26 日星期五 18:56:03 GMT 连接：关闭内容长度：35

错误请求（无效动词）

如果我在这样的控制台应用程序中运行 SAME 函数：

program Project2;

{$APPTYPE CONSOLE}

uses
  uGetPost;

  var
   Res : String;

begin
  GetPost ('http://guest1320958.studio2.coderun.com/PHPTest/', 'GET=VERSION', Res);
  writeln (Res);
  readln;
end.

它工作得很好。

我的 PHP 代码是这样的：

<?php
if (isset($_POST["GET"]))  {
$funcName = $_POST["GET"];
switch($funcName) {
case "VERSION":
echo "1.0";
break;
case "SOMETHINGELSE":
echo "...";
break;
case "ANDSOSON":
echo "...";
}
}
?>

我使用www.coderun.com来测试我的 php。

为什么它在 VLC 中不起作用？顺便说一句。：如果您在 VCL 的线程中运行函数 GetPost，如下所示：

function MyThread ( p : pointer ) : Integer;stdcall;
var
 Res : String;
begin
 GetPost ('http://guest1320958.studio2.coderun.com/PHPTest/', 'GET=VERSION', Res);
 MessageBoxA (0, pchar(Res), '', 0);
end;

procedure StartGetPost;
var
 Dummy : DWORD;
begin
 CreateThread(NIL,0, @MyThread, NIL,0, Dummy);
end;

......它突然工作......

这是为什么？可以请人帮助我吗？谢谢你。

编辑：这是来自wireshark的结果：http: //dl.dropbox.com/u/349314/transfer.pcapng

编辑：看起来实际的传输标题有问题：/

4

1 回答 1

7

Wireshark 捕获显示两次尝试之间的主要区别在于 GUI 版本在 HTTP 数据中有一个额外的空字符。也就是说，在第一行之前POST /PHPWebSite/ HTTP/1.1，有一个零字符。这就解释了为什么服务器抱怨一个无效的动词。

失败与在控制台或 GUI 模式下运行无关。相反，问题在于您在以下循环中使用了初始化变量：

repeat
  SentBytes := Send(Sock, SendBuffer[1 + SentBytes], Length(SendBuffer) - SentBytes, 0);
until SentBytes >= Length(SendBuffer);

你还没有设置SentBytes，但你用它来索引SendBuffer. 在循环之前将其初始化为零。

编译器应该警告您未初始化的变量。永远不要忽略来自编译器的消息，即使它“只是”一个提示或警告。

在 VCL 线程中，该局部变量显然占用了以前持有非零值（可能是 -1）的内存。在其他情况下，它的值显然为 0，并且您的代码似乎按预期工作。这就是所谓的未定义行为。

于 2012-10-26T19:57:45.207 回答