home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 26 / CD_ASCQ_26_1295.iso / vrac / delphcgi.zip / CGI.ZIP / SOURCE / CGIDLG.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-27  |  4KB  |  173 lines
  1. unit CGIDlg;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils,
  7.   WinTypes,
  8.   WinProcs,
  9.   Messages,
  10.   Classes,
  11.   Graphics,
  12.   Controls,
  13.   Forms,
  14.   Dialogs,
  15.   Menus,
  16.   StdCtrls,
  17.   ExtCtrls,
  18.   Grids,
  19.   TabNotBk,
  20.   CGI, Buttons;
  21.  
  22. type
  23.   TCGIDebugDlg = class(TForm)
  24.     ButtonPanel: TPanel;
  25.     InfoNotebook: TTabbedNotebook;
  26.     LFormTuples: TStringGrid;
  27.     LExtraHeaders: TStringGrid;
  28.     LCGIParams: TStringGrid;
  29.     LClientServer: TStringGrid;
  30.     LOutput: TMemo;
  31.     BitBtn1: TBitBtn;
  32.   private
  33.      { Private declarations }
  34.   public
  35.      { Public declarations }
  36.   end;
  37.  
  38.     TTupleGrid = class(TStringGrid)
  39.         procedure AddPair(const Key: String; const Value: String);
  40.         procedure ShowPairs(const Pairs: TTupleList);
  41.     end;
  42.  
  43.     TCGIDlg = class(TComponent)
  44.     private
  45.         FCGI: TCGI;
  46.         procedure SetCGI(Value: TCGI);
  47.        procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  48.     public
  49.         constructor Create(AOwner: TComponent); override;
  50.        procedure Execute;
  51.     published
  52.         property CGI: TCGI read FCGI write SetCGI;
  53.     end;
  54.  
  55. implementation
  56.  
  57. {$R *.DFM}
  58.  
  59. constructor TCGIDlg.Create(AOwner: TComponent);
  60. begin
  61.     inherited Create(AOwner);
  62. end;
  63.  
  64. procedure TCGIDlg.Execute;
  65. var
  66.     CGIDebugDlg: TCGIDebugDlg;
  67.     SDebug: String;
  68.    POutput: PChar;
  69. begin
  70.     if FCGI = nil then exit;
  71.     CGIDebugDlg := TCGIDebugDlg.Create(Self);
  72.     with FCGI, CGIDebugDlg do begin
  73.         with Profile do begin
  74.             if DebugMode then SDebug := 'Yes' else SDebug := 'No';
  75.             with TTupleGrid(LCGIParams) do begin
  76.                 Cells[0,0] := 'Parameter';
  77.                 Cells[1,0] := 'Value';
  78.                 RowCount := 1;
  79.                 AddPair('Debug Mode',SDebug);
  80.                AddPair('Profile File',ProfileFile);
  81.                 AddPair('Content File',ContentFile);
  82.                 AddPair('Output File',OutputFile);
  83.                AddPair('GMT Offset',IntToStr(GMTOffset));
  84.                 AddPair(' ',' ');
  85.                 AddPair('CGI Version',Version);
  86.                 AddPair('Request Protocol',RequestProtocol);
  87.                 AddPair('Request Method',RequestMethod);
  88.                 AddPair('Query String',QueryString);
  89.                 AddPair('Content Type',ContentType);
  90.                 AddPair('Content Length',IntToStr(ContentLength));
  91.                 AddPair(' ',' ');
  92.                 AddPair('Executable Path',ExecutablePath);
  93.                 AddPair('Physical Path',PhysicalPath);
  94.                 AddPair('Logical Path',LogicalPath);
  95.                 FixedRows := 1;
  96.             end;
  97.             with TTupleGrid(LClientServer) do begin
  98.                 Cells[0,0] := 'Parameter';
  99.                 Cells[1,0] := 'Value';
  100.                 RowCount := 1;
  101.                 AddPair('Server Software',ServerSoftware);
  102.                 AddPair('Server Name',ServerName);
  103.                 AddPair('Server Administrator',ServerAdmin);
  104.                 AddPair('Server Port',IntToStr(ServerPort));
  105.                 AddPair(' ',' ');
  106.                 AddPair('Remote Host',RemoteHost);
  107.                 AddPair('Remote Address',RemoteAddr);
  108.                 AddPair('Authorized Username',AuthUser);
  109.                 AddPair('Authentication Method',AuthType);
  110.                 AddPair('RFC-931 Identity',TAPUser);
  111.                 FixedRows := 1;
  112.             end;
  113.             with TTupleGrid(LExtraHeaders) do begin
  114.                 ShowPairs(ExtraHeaders);
  115.                 if RowCount = 1 then RowCount := 2;
  116.                 FixedRows := 1;
  117.             end;
  118.            with StdOut do try
  119.                     POutput := StrAlloc(Size+3);
  120.                     Seek(0,0);
  121.                     Read(POutput^,Size);
  122.                     LOutput.Lines.SetText(POutput);
  123.                 finally
  124.                     StrDispose(POutput);
  125.              end;
  126.         end;
  127.         with TTupleGrid(LFormTuples) do begin
  128.             ShowPairs(FormFields);
  129.             if RowCount = 1 then RowCount := 2;
  130.             FixedRows := 1;
  131.         end;
  132.         CGIDebugDlg.ShowModal;
  133.     end;
  134. end;
  135.  
  136. procedure TCGIDlg.SetCGI(Value: TCGI);
  137. begin
  138.     if FCGI <> Value then FCGI := Value;
  139. end;
  140.  
  141. procedure TCGIDlg.Notification(AComponent: TComponent; Operation: TOperation);
  142. begin
  143.     inherited Notification(AComponent, Operation);
  144.    if (Operation = opRemove) and (AComponent = FCGI) then
  145.        FCGI := nil;
  146. end;
  147.  
  148. { TTupleGrid implementations }
  149.  
  150. procedure TTupleGrid.AddPair(const Key: String; const Value: String);
  151. begin
  152.     if Cells[0,RowCount - 1] <> '' then RowCount := RowCount + 1;
  153.     Cells[0,RowCount - 1] := Key;
  154.     Cells[1,RowCount - 1] := Value;
  155. end;
  156.  
  157. procedure TTupleGrid.ShowPairs(const Pairs: TTupleList);
  158. var
  159.     i: Integer;
  160. begin
  161.     with Pairs do begin
  162.         RowCount := Count + 1;
  163.         Cells[0,0] := 'Key';
  164.         Cells[1,0] := 'Value';
  165.         for i := 0 to Count - 1 do begin
  166.             Cells[0,i+1] := Keys[i];
  167.             Cells[1,i+1] := Values[Keys[i]];
  168.         end;
  169.     end;
  170. end;
  171.  
  172. end.
  173.