Search code examples
phpdelphipostdelphi-7winsock

Delphi code works in console but not VLC

I made my OWN unit to get a POST request from a webserver using winsocket.

Here is my unit:

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.

I run the function GetPost in an VCL application like this:

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

The results are the followed:

HTTP/1.1 400 Bad Request Content-Type: text/html Date: Fri, 26 Oct 2012 18:56:03 GMT Connection: close Content-Length: 35

Bad Request (Invalid Verb)

If i run the the SAME function in an console application like this:

program Project2;

{$APPTYPE CONSOLE}

uses
  uGetPost;

  var
   Res : String;

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

It works just fine.

My PHP code is this:

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

I use www.coderun.com to test my php.

Why does it NOT work in VLC? BTW.: If you run the function GetPost in a Thread in VCL like this:

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;

... it works all of a sudden...

Why is that? Can please someone help me? Thank you.

EDIT: Here are the results from wireshark: http://dl.dropbox.com/u/349314/transfer.pcapng

EDIT: It looks like that something is wrong with the actual Transmission Header :/

Solution

  • The Wireshark capture shows that the primary difference between the two attempts is that the GUI version has an extra null character in the HTTP data. That is, prior to the first line POST /PHPWebSite/ HTTP/1.1, there's a zero character. That explains why the server complains about an invalid verb.

    The failure has nothing to do with running in console or GUI mode. Rather, the problem is that you're using an initialized variable in the following loop:

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

    You haven't set SentBytes, but you use it to index into SendBuffer. Initialize it to zero before the loop.

    The compiler should have warned you about the uninitialized variable. Never ignore a message from the compiler, even if it's "only" a hint or warning.

    In the VCL thread, that local variable apparently occupied memory that had previously held a non-zero value, probably -1. In other cases, it apparently got the value 0, and your code appeared to work as intended. That's what's known as undefined behavior.