1 Star 0 Fork 25

Lyon/php_desktop

forked from lobtao/php_desktop 
加入 Gitee
与超过 1200万 开发者一起发现、参与优秀开源项目,私有仓库也完全免费 :)
免费加入
文件
该仓库未声明开源许可证文件(LICENSE),使用请关注具体项目描述及其代码上游依赖。
克隆/下载
unPHPModule.pas 3.76 KB
一键复制 编辑 原始数据 按行查看 历史
lobtao 提交于 2018-08-22 11:32 . init
unit unPHPModule;
interface
uses
SysUtils, Classes, diocp_ex_httpServer, Contnrs, CnObjectPool
, superobject, PHPCommon, php4delphi, zendAPI,
phpAPI, PHPCustomLibrary, utils_strings, diocp_ex_httpClient;
const
PHP_SESSIONID = 'PHPSESSID';
type
TPHPModule = class(TDataModule)
FPHPEngine: TPHPEngine;
procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
procedure FPHPEngineScriptError(Sender: TObject; AText: AnsiString;
AType: TPHPErrorType; AFileName: AnsiString; ALineNo: Integer);
private
{ Private declarations }
FHttpServer: TDiocpHttpServer;
FDbModuleList: TObjectList;
FCrs: TCriticalSection;
//请求响应
procedure OnHttpSvrRequest(pvRequest: TDiocpHttpRequest);
public
{ Public declarations }
procedure start(iPort: Integer);
procedure stop();
end;
var
PHPModule: TPHPModule;
implementation
{$R *.dfm}
{ TDataModule1 }
procedure TPHPModule.DataModuleCreate(Sender: TObject);
begin
FPHPEngine.StartupEngine;
FHttpServer := TDiocpHttpServer.Create(nil);
FHttpServer.Name := 'Ys_AppServer';
FHttpServer.OnDiocpHttpRequest := OnHttpSvrRequest;
end;
procedure TPHPModule.DataModuleDestroy(Sender: TObject);
begin
FHttpServer.SafeStop();
FHttpServer.Free;
FPHPEngine.ShutdownAndWaitFor;
end;
procedure TPHPModule.FPHPEngineScriptError(Sender: TObject; AText: AnsiString;
AType: TPHPErrorType; AFileName: AnsiString; ALineNo: Integer);
begin
//
end;
procedure TPHPModule.OnHttpSvrRequest(pvRequest: TDiocpHttpRequest);
var
S, tmp, sessionID: string;
L, iCount, iStart, iStop: integer;
FileName: string;
FilePath: string;
ws: UTF8String;
fs: TStringList;
psvPhpOne: TpsvPHP;
i: Integer;
lvSession: TDiocpHttpDValueSession;
list: TStrings;
strUrl: string;
httpClient: TDiocpHttpClient;
begin
if pvRequest.RequestURI = '/favicon.ico' then
Exit;
// pvRequest.Response.Header.ForceByName('Access-Control-Allow-Origin').AsString := '*';
// pvRequest.Response.Header.ForceByName('Access-Control-Allow-Methods').AsString := 'POST, GET, OPTIONS, DELETE';
// pvRequest.Response.Header.ForceByName('Access-Control-Allow-Headers').AsString := 'x-requested-with,content-type';
FilePath := ExtractFilePath(ParamStr(0));
if pvRequest.RequestURI = '/' then
strUrl := '/test.php'
else
strUrl := pvRequest.RequestURI;
FileName := FilePath + 'app'+strUrl;
psvPhpOne := TpsvPHP.Create(nil);
iCount := pvRequest.Header.Count;
//1. 获取delphi的PHPSESSID到PHP
with psvPhpOne.Variables.Add do
begin
Name := PHP_SESSIONID;
Value := pvRequest.GetCookie(PHP_SESSIONID);
end;
with psvPhpOne.Variables.Add do
begin
Name := 'f';
Value := 'test_test';
end;
try
S := psvPhpOne.Execute(FileName);
for i := 0 to psvPhpOne.Headers.Count - 1 do //psvPHP1.Headers.GetHeaders
tmp := tmp + psvPhpOne.Headers[i].Header + '<br>';
//2. 获取到PHP中的sessionID,并通过delphi到浏览器
sessionID := psvPhpOne.Headers[2].Header;
sessionID := GetStrValueOfName(sessionID, 'Set-Cookie', [':', ' '], [' ']); //截取变量值
sessionID := GetStrValueOfName(sessionID, 'PHPSESSID', ['=', ' '], [';', ' ']);
//3. 把sessionID值设置到浏览器
with pvRequest.Response.AddCookie do
begin
Name := PHP_SESSIONID;
Value := sessionID;
end;
tmp := tmp + pvRequest.Header.AsString + '<br>';
tmp := tmp + sessionID + '<br>';
finally
psvPhpOne.Free;
end;
pvRequest.Response.ResponseCode := 200;
pvRequest.Response.WriteString(s + '<hr>' + AnsiToUtf8(tmp), False); //
pvRequest.ResponseEnd();
end;
procedure TPHPModule.start(iPort: Integer);
begin
FHttpServer.Port := iPort;
Self.FHttpServer.Active := True;
end;
procedure TPHPModule.stop;
begin
Self.FHttpServer.SafeStop;
end;
end.
马建仓 AI 助手
尝试更多
代码解读
代码找茬
代码优化
PHP
1
https://gitee.com/LyonH/php_desktop.git
git@gitee.com:LyonH/php_desktop.git
LyonH
php_desktop
php_desktop
master

搜索帮助