delphi_scriptcontrol_httpserver/Unit1.pas at master · cn09876/delphi_scriptcontrol_httpserver · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,ComObj, StdCtrls,OleCtrls,unit3, MSScriptControl_TLB,
  IdBaseComponent, IdComponent, IdTCPServer, IdCustomHTTPServer,
  IdHTTPServer,idglobal,idcontext,activex,ucommon,SHDocVw;

type
  TForm1 = class(TForm)
    httpd: TIdHTTPServer;
    WebBrowser1: TWebBrowser;
    procedure FormCreate(Sender: TObject);
    procedure httpdCommandGet(AContext: TIdContext;
      ARequestInfo: TIdHTTPRequestInfo;
      AResponseInfo: TIdHTTPResponseInfo);
  private
    { Private declarations }
  public
    function file_get_contents(s: string): string;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.file_get_contents(s: string): string;
var
	list:tStrings;
begin
  list:=tStringList.Create;
  list.LoadFromFile(s);
  result:=list.Text;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  httpd.DefaultPort:=809;
  httpd.Active:=true;
  ucommon.init;
  self.WebBrowser1.Navigate('http://127.0.0.1:809/d.ssf');
end;

procedure TForm1.httpdCommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  MyObject: TTSwSSP;
  vbs:TScriptControl;
  thePath:string;
  script_content:string;
begin
  thePath:=sysutils.ExtractFilePath(application.ExeName);
  CoInitialize(nil);

  if uppercase(sysutils.ExtractFileExt(arequestinfo.Document))<>'.SSF' then
  begin
    aresponseinfo.ServeFile(acontext,thePath+arequestinfo.Document);
    exit;
  end;

  try
    vbs:=TScriptControl.Create(self);
    MyObject:= TTSwSSP.Create;
    MyObject.ObjAddRef;
    myobject.requestParams:=arequestinfo.Params;
    myobject.responseText:='';
    vbs.Language:='VBScript';
    vbs.Reset;
    vbs.Error.Clear;

    vbs.AddObject('sw', MyObject, True);

    if fileexists(thePath+arequestinfo.Document) then
    begin
      script_content:=file_get_contents(thePath+arequestinfo.Document);
    end
    else
    begin
      aresponseinfo.ContentText:='404 '+ARequestInfo.Document+' not found';
      exit;
    end;

    try
      vbs.ExecuteStatement(script_content);
    except
      on e:exception do
      begin
        myobject.responseText:=myobject.responseText+e.Message;
      end;
    end;

    aresponseinfo.ContentText:=myobject.responseText;
    vbs.FreeOnRelease;
    vbs.Free;
    myobject.ObjRelease;
  except
    on e:exception do
    begin
      aresponseinfo.ContentText:='error execute '+ARequestInfo.Document+' '+e.Message;
    end;
  end;

  //


end;

initialization
  CoInitialize(nil);


end.