u_main.pas

httpanalyzer, source code for delphi

  (*logRoot:=root.AddChild('log');
  ValueNode:=logRoot.AddChild('requestHeader');
  ValueNode.Text:=item.SubItems[6];
  ValueNode:=logRoot.AddChild('requestContent');
  ValueNode.Text:='NOT YET IMPLEMENTED';
  ValueNode:=logRoot.AddChild('responseHeader');
  ValueNode.Text:=item.SubItems[7];
  *)

  (*XMLDoc2.Version:='1.0';
  XMLDoc2.Encoding:='ISO-8859-1';
  XMLDoc2.StandAlone:='yes';
  *)
  XMLDoc2.Options:=[doNodeAutoIndent];

  (*xmlstr:='';
  for i:=0 to XMLDoc2.XML.Count-1 do begin;
   xmlstr:=xmlstr+'AAAA';
   xmlstr:=xmlstr+XMLDoc2.XML[i]+lf;
  end;
  *)
  XMLDoc2.saveToXML(xmlstr); //=ein wurst ohne zeilenumbrueche




  result:=xmlstr;
end;


function createXMLMarked : string;
var za1: integer;
    item : Tlistitem;
    anzahl : integer;
var  XMLDocAll, XMLDocAction : IXMLDocument; // siehe http://community.borland.com/article/0,1410,29241,00.html
    Root,ValueNode, paramRoot, logRoot: IXMLNode;
    xmlstr,xmlstrAll : string;

begin
with frm_main do begin;
  anzahl:=0;
  for za1:=0 to listview1.Items.Count-1 do begin;
    item:=listview1.items[za1];
    if (item.Checked) then anzahl:=anzahl+1;
  end;
  if (anzahl=0) then begin;
    // MessageDlg('No actions marked', mtInformation,  [mbOk], 0);
     exit;
  end;

  XMLDocAll := TXMLDocument.Create(nil);
  XMLDocAll.Active:=true;
  //root:=XMLDocAll.AddChild('actions');
  xmlstrAll:='<actions>'+chr(13)+
  '<generatedby>HttpAnalyzer 1.0</generatedby>'+chr(13)+
  '<copyright>Photono Software</copyright>'+chr(13);

  XMLDocAction:=TXMLDocument.Create(nil);
  for za1:=0 to listview1.Items.Count-1 do begin;
    item:=listview1.items[za1];
    if (item.Checked) then begin;
     xmlstr:=item.subitems[11];
     try
     XMLDocAction.LoadFromXML(xmlstr);  //FOR VALIDATING
     //XMLDocAction.
     except
       on E: Exception do begin;

        showmessage('XML-Action '+item.caption+' not wellformed'+chr(13)+chr(10)+E.Message);
       end;
     end;
     //XMLDocAction.SaveToFile(inttostr(za1)+'.xml');
     xmlstrAll:=xmlstrAll+xmlstr;
    end;
  end;

  xmlstrall:=xmlstrAll+'</actions>';
  XMLDocAll.LoadFromXML(xmlStrAll);

  XMLDocAll.Version:='1.0';
  XMLDocAll.Encoding:='UTF-8';
  XMLDocAll.StandAlone:='yes';
  XMLDocAll.Options:=[doNodeAutoIndent];
  XMLDocAll.SaveToXml(xmlstrAll);
  result:=xmlStrAll;
  end;
end;



procedure Tfrm_main.clientConnects(Sender : TObject; Client : TProxyClient; Error  : Word);
var bufobj : THttpProxy;
    newItem : TListItem;
    za1 : integer;
begin;
 if assigned(sender) then begin;
   if logging then begin;
   bufobj:=THttpProxy(Client);
    newItem:=listview1.Items.Add;
    newItem.Caption:= inttostr(bufobj.run_nr);
    newItem.SubItems.append('-');   //Host=0
    newItem.SubItems.append('-');   //Method=1
    newItem.SubItems.append('-');   //URL=2
    newItem.SubItems.append('-');   //Referer=3
    newItem.SubItems.append('?');                //Response Status=4
    newItem.SubItems.append('?');                //response Content Type=5
    newItem.SubItems.Append('-');       //Header Request=6
    newItem.SubItems.Append('returned header not yet received'); //Header Response=7
    newItem.SubItems.Append('Location');         //New Location=8, falls document moved
    newItem.SubItems.Append('');   //=9
    newItem.SubItems.Append('ContentResponse');  //=10

    newItem.SubItems.Append('XML processing code can not be calculated yet');  // =11
   end; //logging
 end; //assigned(sender)
end;


procedure Tfrm_main.clientDisconnects(Sender : TObject; Client : TProxyClient; Error  : Word);
var bufobj : THttpProxy;
    item : TListItem;
    za1 : integer;
begin;
 if assigned(sender) then begin;
   bufobj:=THttpProxy(Client);
   for za1:=0 to listview1.Items.Count-1 do begin
     item:=listview1.Items.Item[za1];
     if (item.Caption=inttostr(bufobj.run_nr)) then begin;
       item.SubItems[11]:=createXML(item);
      // memo_content_p2.Lines.Add('createXML:'+inttostr(bufobj.run_nr));
     end;
    end;

  end;
end;


procedure Tfrm_main.Start1Click(Sender: TObject);
var oldindex,i : integer;
begin
statusbar1.Panels[0].Text:='Proxy running';
 Start1.Enabled:=false;
 Stop1.Enabled:=true;

//damit alle memo-felder auch tats鋍hlich g黮tige Window-handler haben
oldindex:=pagecontrol1.ActivePageIndex;

for i:=0 to pagecontrol1.PageCount-1 do
pagecontrol1.ActivePageIndex:=i;

pagecontrol1.ActivePageIndex:=oldindex;


//Proxy-Server initieren
myproxy:=TProxyServer.create(self);
myproxy.ClientClass:= THttpProxy; //THttpProxyExtended;


{ Now we set the eventhandlers }


 myproxy.OnP1Message:=myproxyp1;
 myproxy.OnP2Message:=myproxyp2;

 myproxy.OnClientConnect := ClientConnects;
 myproxy.OnClientDisConnect := ClientDisConnects;

 myproxy.OnP1DataReceived:=gotDataP1;
 myproxy.OnP2DataReceived:=gotDataP2;

 myproxy.OnP1HttpHeaderModified:=P1HeaderModified;
 myproxy.OnP2HttpHeader:=P2Header;

 myproxy.OnP1HttpContent:=P1Content;
 myproxy.OnP2HttpContent:=P2Content;

 myproxy.Destination_Port:='80';   // 3128  ansonsten proxy to go
 myproxy.addr:='0.0.0.0';  // we accept connections from all ip's

 myproxy.port:='8080';  // at this port we are listening
 if myproxy.start=false then showmessage('Error starting Proxy Engine at port 8080');


end;

procedure Tfrm_main.Stop1Click(Sender: TObject);
begin
 statusbar1.Panels[0].Text:='Proxy stopped';
 Start1.Enabled:=true;
 Stop1.Enabled:=false;

 myproxy.shutdown;
end;

procedure Tfrm_main.Exit1Click(Sender: TObject);
begin
 close;
end;

procedure Tfrm_main.About1Click(Sender: TObject);
begin
 aboutbox.showmodal;
end;

procedure Tfrm_main.SaveAs1Click(Sender: TObject);
var filename : string;
begin
 if SaveDialog1.Execute then begin;
  filename:=SaveDialog1.FileName;
   Memo_p1_flow.Lines.SaveToFile(FileName+'.p1_flow.txt');
  Memo_p2_flow.Lines.SaveToFile(FileName+'.p2_flow.txt');

  Memo_p1_data_hex.Lines.SaveToFile(FileName+'.p1_data_hex.txt');
  Memo_p2_data_hex.Lines.SaveToFile(FileName+'.p2_data_hex.txt');

  Memo_p1_data_str.Lines.SaveToFile(FileName+'.p1_data_str.txt');
  Memo_p2_data_str.Lines.SaveToFile(FileName+'.p2_data_str.txt');

  Memo_p1_header.Lines.SaveToFile(FileName+'.p1_header.txt');
  Memo_p2_header.Lines.SaveToFile(FileName+'.p2_header.txt');

  Memo_content_p1.Lines.SaveToFile(FileName+'.p1_content.txt');
  Memo_content_p2.Lines.SaveToFile(FileName+'.p2_content.txt');

  MessageDlg('Saved all as plain data', mtInformation,[mbOk], 0);
 end;
end;

procedure Tfrm_main.Clearall1Click(Sender: TObject);
begin
if MessageDlg('Do you really want to clear all logged data', mtConfirmation,mbOKCancel, 0)=mrOk then begin;
 Memo_p1_flow.Lines.Clear;  Memo_p1_flow.Lines.Add(Memo_p1_flow.Name);
 Memo_p2_flow.Clear;       Memo_p2_flow.Lines.Add(Memo_p2_flow.Name);
 Memo_p1_data_hex.Clear;   Memo_p1_data_hex.Lines.Add(Memo_p1_data_hex.Name);
 Memo_p2_data_hex.Clear;   Memo_p2_data_hex.Lines.Add(Memo_p2_data_hex.Name);
 Memo_p1_data_str.Clear;   Memo_p1_data_str.Lines.Add(Memo_p1_data_str.Name);
 Memo_p2_data_str.Clear;   Memo_p2_data_str.Lines.Add(Memo_p2_data_str.Name);
 Memo_p1_header.Clear;     Memo_p1_header.Lines.Add(Memo_p1_header.Name);
 Memo_p2_header.Clear;     Memo_p2_header.Lines.Add(Memo_p2_header.Name);
 Memo_content_p1.clear;    Memo_content_p1.Lines.Add(Memo_content_p1.Name);
 Memo_content_p2.clear;    Memo_content_p2.Lines.Add(Memo_content_p2.Name);
 memo_header_plain.clear;
 memo_xml.clear;
 memo_xml.Enabled:=false;
 listview1.Items.Clear;
end;
end;

procedure Tfrm_main.LogStart1Click(Sender: TObject);
begin
 statusbar1.Panels[1].Text:='Logging ON';
 LogStart1.Enabled:=false;
 LogStop1.Enabled:=true;
 logging:=true;
end;

procedure Tfrm_main.LogStop1Click(Sender: TObject);
begin
 statusbar1.Panels[1].Text:='Logging OFF';
 LogStart1.Enabled:=true;
 LogStop1.Enabled:=false;
 logging:=false;
end;



procedure Tfrm_main.Timer1Timer(Sender: TObject);
begin
 timer1.enabled:=false;
 Start1Click(Sender);
end;





procedure Tfrm_main.ListView1InfoTip(Sender: TObject; Item: TListItem;
  var InfoTip: String);
begin

 InfoTip:=
  'ID '+item.caption+chr(13)+
  'Host: "'+item.SubItems[0]+'"'+chr(13)+
  'Request Method: "'+item.SubItems[1]+'"'+chr(13)+
  'Request URL: "'+item.SubItems[2]+'"'+chr(13)+
  'Request Reference: "'+item.SubItems[3]+'"'+chr(13)+
  'Returned Http Status: '+item.SubItems[4]+' = '+status_message(strtointdef(item.SubItems[4],0))+chr(13)+
  'Returned Content Type: "'+item.SubItems[5]+'"'+chr(13)+
  'PostContent: "'+item.Subitems[9]+'"';
end;

var currentItem : TListItem;

procedure Tfrm_main.ListView1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);



begin
 currentItem:= Item;
 memo_xml.Enabled:=true;
 memo_header_plain.Clear;
 memo_header_plain.Lines.Add('['+currentItem.Caption+'] REQUEST:'+chr(13)+chr(10)+
 currentItem.SubItems[6]+
 '['+item.Caption+'] RESPONSE:'+chr(13)+chr(10)+
 currentItem.SubItems[7]
 );
 memo_xml.Clear;
 memo_xml.Lines.Add(currentItem.SubItems[11]);

end;

procedure Tfrm_main.SaveMarkedRequests1Click(Sender: TObject);
var za1: integer;
    item : Tlistitem;
    anzahl : integer;
    filename : string;
var f : textfile;
begin
 if SaveDialog1.Execute then begin;
  filename:=SaveDialog1.FileName;
  anzahl:=0;
  for za1:=0 to listview1.Items.Count-1 do begin;
    item:=listview1.items[za1];
    if (item.Checked) then anzahl:=anzahl+1;
  end;
  if (anzahl=0) then begin;
     MessageDlg('No request marked', mtInformation,
      [mbOk], 0);
     exit;
  end;

  assignfile(f,filename);
  {$I-}
  rewrite(f);
  {$I+}
  if IOResult=0 then begin
  writeln(f,createXMLMarked);
  {$I-}
  closefile(f);
  {$I+}
  if IOResult<>0 then raise ESavingError.Create('IO Fehler: Datei "'+filename+'"');
  end
  else raise ESavingError.Create('IO Fehler beim Sichern der Datei "'+filename+'"');

  MessageDlg('Saved '+inttostr(anzahl)+' requests as xml-processing commands', mtInformation,[mbOk], 0);
 end;
end;

procedure Tfrm_main.memo_xmlChange(Sender: TObject);

begin
 if memo_xml.Modified then begin;
  if currentItem=nil then begin;
   showmessage('Kein Item ausgew鋒lt');
   exit;
  end;
  currentItem.SubItems[11]:=memo_xml.text;
 end;

end;

procedure Tfrm_main.Button1Click(Sender: TObject);

procedure updateTree;
var
 strTreeFormat : string;
 TreeFile: TextFile;
 StrStream:TStringStream;
var  XMLDocAll  : IXMLDocument; // siehe http://community.borland.com/article/0,1410,29241,00.html
var xmlAll : string;
begin;
 xmlAll:=  createXMLMarked;
 if (length(xmlAll)>10) then begin;
   XMLDocAll := TXMLDocument.Create(nil);
  XMLDocAll.Active:=true;
  XMLDocAll.LoadFromXML(xmlAll);

  strTreeFormat:=Treeview(XMLDocAll.DocumentElement,0);
  StrStream := TStringStream.Create(strTreeFormat);
  frm_main.TreeView1.LoadFromStream(StrStream);
  StrStream.Free;
  end;
end;

begin
 frm_main.TreeView1.Items.Clear;
 updateTree;
end;

procedure Tfrm_main.Deleteselectedentries1Click(Sender: TObject);
var sel : boolean;
    za1 : integer;
begin
if listview1.items.count>0 then begin
 sel:=false;
 for za1:=0 to (listview1.items.count-1) do begin;
  if listview1.items[za1].selected=true then sel:=true;
 end;
 if sel=true then begin
  listview1.items.beginupdate;
  za1:=0;
  repeat
   if listview1.items[za1].selected=true then begin; listview1.items.delete(za1);  za1:=-1; end;
   za1:=za1+1;
  until za1>=listview1.items.count;
  listview1.items.endupdate;
 end
 else showmessage('Select some entries first!');

end
else begin
  showmessage('There are no entries you could remove!');
end;
end;

procedure Tfrm_main.SelectAll1Click(Sender: TObject);
var
    za1 : integer;
begin
for za1:=0 to listview1.Items.count-1 do begin;
 listview1.Items[za1].Selected:=true;
end;

end;

end.