u_main.pas

httpanalyzer, source code for delphi

unit u_main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, proxy1, proxy2,httpProxyExtend, ExtCtrls,
  ComCtrls, Menus, XPMan, xmldom, XMLIntf, msxmldom, XMLDoc;

type
  Tfrm_main = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    panel_tab1left: TPanel;
    panel_tab1right: TPanel;
    Splitter1: TSplitter;
    memo_p1_flow: TMemo;
    memo_p2_flow: TMemo;
    TabSheet4: TTabSheet;
    panel_tab2left: TPanel;
    Splitter2: TSplitter;
    panel_tab2right: TPanel;
    memo_p1_data_hex: TMemo;
    memo_p2_data_hex: TMemo;
    panel_tab3left: TPanel;
    Splitter3: TSplitter;
    panel_tab3right: TPanel;
    memo_p1_data_str: TMemo;
    memo_p2_data_str: TMemo;
    MainMenu1: TMainMenu;
    Datei1: TMenuItem;
    Exit1: TMenuItem;
    Proxy1: TMenuItem;
    Start1: TMenuItem;
    Stop1: TMenuItem;
    About1: TMenuItem;
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    panel_tab4left: TPanel;
    Splitter4: TSplitter;
    panel_tab4right: TPanel;
    memo_p1_header: TMemo;
    memo_p2_header: TMemo;
    SaveAs1: TMenuItem;
    N1: TMenuItem;
    SaveDialog1: TSaveDialog;
    Clearall1: TMenuItem;
    TabSheet5: TTabSheet;
    LogStart1: TMenuItem;
    LogStop1: TMenuItem;
    Timer1: TTimer;
    XPManifest1: TXPManifest;
    panel_tab5left: TPanel;
    ListView1: TListView;
    Splitter5: TSplitter;
    panel_tab5right: TPanel;
    PageControl2: TPageControl;
    TabSheet6: TTabSheet;
    TabSheet7: TTabSheet;
    memo_header_plain: TMemo;
    memo_xml: TMemo;
    SaveMarkedRequests1: TMenuItem;
    XMLDocument1: TXMLDocument;
    TabSheet8: TTabSheet;
    TreeView1: TTreeView;
    Panel2: TPanel;
    Button1: TButton;
    TabSheet9: TTabSheet;
    panel_tab6left: TPanel;
    Splitter6: TSplitter;
    panel_tab6right: TPanel;
    memo_content_p1: TMemo;
    memo_content_p2: TMemo;
    panel_tab9left_top: TPanel;
    panel_tab9right_top: TPanel;
    chk_hideEmptyEntries: TCheckBox;
    chk_logContent: TCheckBox;
    Label1: TLabel;
    PopupMenu1: TPopupMenu;
    Deleteselectedentries1: TMenuItem;
    SelectAll1: TMenuItem;


    procedure myProxyP1(Sender : TObject; msg : pchar);
    procedure myProxyP2(Sender : TObject; msg : pchar);

    function gotDataP1(Sender: TObject; run_nr : integer; p : pointer; VAR s:longint): pointer;
    function gotDataP2(Sender: TObject; run_nr : integer; p : pointer; VAR s:longint): pointer;

    function P1HeaderModified(Sender: TObject; run_nr : integer; p : pointer; VAR s:longint): pointer;
    function P2Header(Sender: TObject; run_nr : integer; p : pointer; VAR s:longint): pointer;

    function P1Content(Sender: TObject; run_nr : integer;p : pointer; VAR s:longint): pointer;
    function P2Content(Sender: TObject; run_nr : integer;p : pointer; VAR s:longint): pointer;

    procedure clientDisconnects(Sender : TObject; Client : TProxyClient; Error  : Word);
    procedure clientConnects(Sender : TObject; Client : TProxyClient; Error  : Word);

    procedure Start1Click(Sender: TObject);
    procedure Stop1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure SaveAs1Click(Sender: TObject);
    procedure Clearall1Click(Sender: TObject);
    procedure LogStart1Click(Sender: TObject);
    procedure LogStop1Click(Sender: TObject);
   
    procedure Timer1Timer(Sender: TObject);
  
    procedure ListView1InfoTip(Sender: TObject; Item: TListItem;
      var InfoTip: String);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure SaveMarkedRequests1Click(Sender: TObject);
    procedure memo_xmlChange(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Deleteselectedentries1Click(Sender: TObject);
    procedure SelectAll1Click(Sender: TObject);
   
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frm_main: Tfrm_main;

var
  myproxy : TProxyServer;

implementation
uses mem_utils, saving, httphelp, u_about,XmlTree;

var
 logging : boolean = true;
 

{$R *.dfm}

//Methoden zum Auslesen der HTTP-Header


function getHeaderAttribut(header,searchStr:string) : string;
var A : TstrArray; i: integer;
begin;
 result:='';
 A:= Split(header,chr(10)) ;
 for i:=0 to length(A)-1 do begin;
    //frm_main.memo_header_plain.lines.add(A[i]);
    if (pos(searchStr,A[i])=1) then begin;
       result:= Copy(A[i], pos(searchStr,A[i])+length(searchStr),length(A[i])-length(searchStr)-1 );
       exit;
     end;
 end;

end;




function getHost(str : String) : string;
begin;
 result:= getHeaderAttribut(str,'Host: ');
end;

function getReferer(str : String) : string;
begin;
 result:= getHeaderAttribut(str,'Referer: ');
end;

function getMethod(str : String) : string; // GET oder POST
begin;
  result:=paramX(str,0,' ');
end;

function getURL(str : String) : string;
begin;
 result:=paramX(str,1,' ');
end;

function getContentType(str : String) : string;
begin;
 result:= getHeaderAttribut(str,'Content-Type: ');
end;

//HTTP/1.1 304 Not Modified
function getStatus(str : String) : string;
begin;
  result:=paramX(str,1,' ');
end;

//HttpProxyEvents
function Tfrm_main.P1HeaderModified(Sender: TObject; run_nr : integer;p : pointer; VAR s:longint): pointer;
var header : string; za1 : integer;
    item : TListItem;
begin;
if logging then begin;
if Assigned(memo_p1_header) then begin;
  if assigned(sender) then begin;
    header:=mem2str(p,s);
    //suche das TListItem mit der run_nr=caption;
    for za1:=0 to listview1.Items.Count-1 do begin
      item:=listview1.Items.Item[za1];
      if (item.Caption=inttostr(run_nr)) then begin;
        item.SubItems[0]:=getHost(header);    //Host=0
        item.SubItems[1]:=getMethod(header);  //Method=1
        item.SubItems[2]:=getUrl(header);     //URL=2
        item.SubItems[3]:=getReferer(header); //Referer=3

        item.SubItems[6]:=mem2str(p,s);       //Header Request=6
      end;
    end;
    memo_p1_header.Lines.add('['+inttostr(run_nr)+'] '+mem2pchar(p,s));
  end; //assigned(sender)
 end;  //assigned(memo)
end; //logging
 result:=p;  //erlaubt prinzipiell die ver鋘derung aller Daten;
end;

function Tfrm_main.P2Header(Sender: TObject; run_nr : integer;p : pointer; VAR s:longint): pointer;
var header : string;
    za1 : integer;
    item : TListitem;
begin;
if logging then begin;
if Assigned(memo_p2_header) then begin;
  if assigned(sender) then begin;
    header:=mem2str(p,s);

    memo_p2_header.Lines.add('['+inttostr(run_nr)+'] '+mem2pchar(p,s));
    //suche das TListItem mit der run_nr=caption;
    for za1:=0 to listview1.Items.Count-1 do begin
     item:=listview1.Items.Item[za1];
     if (item.Caption=inttostr(run_nr)) then begin;
       item.SubItems[4]:= getStatus(header);
       item.SubItems[5]:= getContentType(header);
       item.SubItems[7]:=mem2str(p,s);
     end;
    end;

  end; //assigned sender
 end; //assigned memo
end; //logging
 result:=p;  //膎derungen der P2-Header-Daten werden verworfen!!
end;


function Tfrm_main.P1Content(Sender: TObject; run_nr : integer;p : pointer; VAR s:longint): pointer;
var
    za1 : integer;
    item : TListitem;
begin;
if logging then begin;
if Assigned(memo_content_p1) then begin;
  if assigned(sender) then begin;
    if (chk_hideEmptyEntries.Checked) and (s=0) then begin
    end else memo_content_p1.Lines.add('['+inttostr(run_nr)+'] '+mem_show(p,s));
    //

    for za1:=0 to listview1.Items.Count-1 do begin
     item:=listview1.Items.Item[za1];
     if (item.Caption=inttostr(run_nr)) then begin;
       item.SubItems[9]:=item.Subitems[9]+mem2str(p,s);
     end;
    end;
    //
  end;
 end;
end;
 result:=p;  //erlaubt prinzipiell die ver鋘derung aller Daten;
end;

function Tfrm_main.P2Content(Sender: TObject; run_nr : integer;p : pointer; VAR s:longint): pointer;
begin;
if logging then begin;
if Assigned(memo_content_p2) then begin;
  if assigned(sender) then begin;
  if (chk_logContent.Checked) then 
  memo_content_p2.Lines.add('['+inttostr(run_nr)+'] '+mem_show(p,s));
  end;
 end;
end;
 result:=p;  //erlaubt prinzipiell die ver鋘derung aller Daten;
end;


function Tfrm_main.gotDataP1(Sender: TObject; run_nr : integer;p : pointer; VAR s:longint): pointer;
begin;
if logging then begin;
if Assigned(memo_p1_data_hex) then begin;
  if assigned(sender) then begin;
  memo_p1_data_hex.Lines.add('['+inttostr(run_nr)+'] '+mem_show(p,s));
  memo_p1_data_str.Lines.add('['+inttostr(run_nr)+'] '+mem2pchar(p,s));
  end;
 end;
end;
 result:=p;  //erlaubt prinzipiell die ver鋘derung aller Daten;
end;

function Tfrm_main.gotDataP2(Sender: TObject; run_nr : integer;p : pointer; VAR s:longint): pointer;
begin;
if logging then begin;
if Assigned(memo_p2_data_hex) then begin;
  if assigned(sender) then begin;
  memo_p2_data_hex.Lines.add('['+inttostr(run_nr)+'] '+mem_show(p,s));
  memo_p2_data_str.Lines.add('['+inttostr(run_nr)+'] '+mem2pchar(p,s));
  end;
 end;
end;
 result:=p;  //erlaubt prinzipiell die ver鋘derung aller Daten
end;



procedure Tfrm_main.myProxyP1( Sender : TObject; msg : pchar);
var bufobj : THttpProxy;
begin;
if not logging then exit;
 if Assigned(memo_p1_flow) then begin;
  if assigned(sender) then begin;
   bufobj:=THttpProxy(Sender);
   memo_p1_flow.lines.add('['+inttostr(bufobj.run_nr)+'] '+msg);
  end;
 end;
end;

procedure Tfrm_main.myProxyP2( Sender : TObject; msg : pchar);
var bufobj : THttpProxy;
begin;
if not logging then exit;
 if Assigned(memo_p2_flow) then begin;
  if assigned(sender) then begin;
   bufobj:=THttpProxy(Sender);
   memo_p2_flow.lines.add('['+inttostr(bufobj.run_nr)+'] '+msg);
  end;
 end;
end;


{function createXML(item : TListItem) : string;
var xml : string;
    const lf : string = chr(13)+chr(10);
begin;
 xml:=
 '<action id="'+item.Caption+'">'+lf+
 '  <description></description>'+lf+
 '  <method>'+item.SubItems[1]+'</method>'+lf+
 '  <host>'+item.SubItems[0]+'</host>'+lf+
 '  <documentpath>'+item.SubItems[2]+'</documentpath>'+lf+
 '  <reference>'+item.SubItems[3]+'</reference>'+lf;
 if (item.SubItems[1]='POST') then begin;
    xml:=xml+'  <postvalues>'+lf+'Not yet done'+
            '  </postvalues>'+lf;
 end;

(* xml:=xml+
 '  <contentTransmitted>'+lf+
 '    <requestHeader>'+lf+item.SubItems[6]+
 '    </requestHeader>'+lf+
 '    <requestContent>'+lf+'Not yet done'+
 '    </requestContent>'+lf+
 '    <responseHeader>'+lf+item.SubItems[7]+
 '    </responseHeader>'+lf+
 '  </contentTransmitted>'+lf+
 *)

 xml:=xml+'</action>'+lf;

 result:=xml;
end;
}
function createXML(item : TListItem) : string;
var XMLDoc2 : IXMLDocument; // siehe http://community.borland.com/article/0,1410,29241,00.html
    Root,ValueNode, paramRoot, logRoot: IXMLNode;
    xmlstr : string;

    //i : integer;
    //const lf : string = chr(13)+chr(10);

//Extrahieren der POST Name=Value Pairs
   poststr: string;
   var A : TstrArray; i: integer;
   var bothstr, namestr, valuestr : string;
begin
  XMLDoc2 := TXMLDocument.Create(nil);
  //XMLDoc2.LoadFromXml('<test>Hallo Welt<reference></test>');

  XMLDoc2.Active:=true;
  root:=XMLDoc2.AddChild('action');
  root.Attributes['id']:=item.Caption;
  root.Attributes['description']:='none';

  //ValueNode:=root.AddChild('description');

  ValueNode:=root.AddChild('method');
  ValueNode.Text:=item.SubItems[1];

  ValueNode:=root.AddChild('host');
  ValueNode.Text:=item.SubItems[0];

  ValueNode:=root.AddChild('documentpath');
  ValueNode.Text:=item.SubItems[2];

  ValueNode:=root.AddChild('referer');
  ValueNode.Text:=item.SubItems[3];

  poststr:=item.subitems[9];
  if (item.SubItems[1]='POST') then begin;
    (*
    ValueNode:=root.AddChild('poststring');
    //ValueNode.Attributes['type']='encoded'; //TODO: real encoding aus Header auslesen
    ValueNode.Text:=poststr;
    *)

    paramRoot:=root.AddChild('postcontent');
    //paramRoot.Attributes['type']='plain text';

    A:= Split(poststr,'&') ;
    for i:=0 to length(A)-1 do begin;
      bothstr:=A[i];
      namestr:=paramX(bothstr,0,'=');
      valuestr:=paramX(bothstr,1,'=');

      ValueNode:=paramRoot.AddChild('param');
      ValueNode.Attributes['name']:=UrlDecode(namestr);
      ValueNode.Attributes['value']:=UrlDecode(valuestr);
    end;
   end;