Componentes.Terceros.DevExp.../official/x.44/ExpressWeb Framework/Sources/cxWebDebugRun.pas

561 lines
15 KiB
ObjectPascal
Raw Permalink Normal View History

{*******************************************************************}
{ }
{ ExpressWeb Framework by Developer Express }
{ Runtime debugger }
{ }
{ Copyright (c) 2000-2009 Developer Express Inc. }
{ ALL RIGHTS RESERVED }
{ }
{ The entire contents of this file is protected by U.S. and }
{ International Copyright Laws. Unauthorized reproduction, }
{ reverse-engineering, and distribution of all or any portion of }
{ the code contained in this file is strictly prohibited and may }
{ result in severe civil and criminal penalties and will be }
{ prosecuted to the maximum extent possible under the law. }
{ }
{ RESTRICTIONS }
{ }
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
{ LICENSED TO DISTRIBUTE THE EXPRESSWEB FRAMEWORK AND ALL }
{ ACCOMPANYING VCL CLASSES AS PART OF AN EXECUTABLE WEB }
{ APPLICATION ONLY. }
{ }
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
{ }
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
{ ADDITIONAL RESTRICTIONS. }
{ }
{*******************************************************************}
unit cxWebDebugRun;
{$I cxVer.inc}
{$IFDEF DELPHI7}
{$DEFINE CLXWAD}
{$ENDIF}
{$IFDEF KYLIX3}
{$DEFINE CLXWAD}
{$ENDIF}
interface
{$IFDEF VCL}
uses
Windows;
{$ENDIF}
procedure RunTestApplication(AWebApplicationName: string);
{$IFDEF MSWINDOWS}
function IsDebuggerPresent: Boolean; external kernel32;
{$ENDIF}
implementation
uses
Classes, SysUtils, HTTPProd,
{$IFDEF VCL}
Forms, Messages, Registry, ShellAPI,
{$ELSE}
QForms, IniFiles, Libc,
{$ENDIF}
cxWebUtils, cxWebStrs, cxWebIntf,
{$IFDEF CLXWAD}IdSocketHandle, IdTCPServer, IdServerIOHandlerSocket
{$ELSE}ScktComp{$ENDIF};
const
{$IFDEF CLXWAD}
WebDebuggerWindowClass = 'QWidget';
{$ELSE}
WebDebuggerWindowClass = 'TWebAppDbgMainForm';
{$ENDIF}
WebDebuggerWindowName = 'Web App Debugger';
WebDebuggerStop = 'Stop';
LocalHostAddress = 'http://localhost:%d/';
{$IFDEF MSWINDOWS}
WebDebuggerFileName = 'webappdbg.exe';
{$IFDEF DELPHI7}
DelphiRegistryKey = '\Software\Borland\Delphi\7.0';
{$ELSE}
DelphiRegistryKey = '\Software\Borland\Delphi\6.0';
{$ENDIF}
WebDebuggerRegistryKey = '\Software\Borland\WebAppDbg';
{$ENDIF}
{$IFDEF LINUX}
WebDebuggerFileName = 'webappdbg';
DelphiIniFile = '/.borland/delphi69rc';
WebDebuggerIniFile = '/.borland/webappdbgrc';
{$ENDIF}
sActiveAtStartup = 'ActiveAtStartup';
sWADPort = 'port';
sWADBrowser = 'Browser';
function GetServerPort: Integer;
begin
{$IFDEF MSWINDOWS}
{$IFDEF DELPHI7}
Result := 8081;
{$ELSE}
Result := 1024;
{$ENDIF}
with TRegistry.Create do
try
{$IFDEF DELPHI7}
RootKey := HKEY_CURRENT_USER;
{$ELSE}
RootKey := HKEY_LOCAL_MACHINE;
{$ENDIF}
if OpenKey(WebDebuggerRegistryKey, False) then
{$IFDEF DELPHI7}
Result := ReadInteger(sWADPort);
{$ELSE}
Result := StrToInt(ReadString(sWADPort));
{$ENDIF}
finally
Free;
end;
{$ENDIF}
{$IFDEF LINUX}
with TIniFile.Create(getenv('HOME') + WebDebuggerIniFile) do
try
Result := StrToInt(ReadString('', sWADPort, '8081'));
finally
Free;
end;
{$ENDIF}
end;
function GetURLAddress(AWebApplicationName: string): string;
begin
Result := Format(LocalHostAddress, [GetServerPort]) + Application.Title + '.' + AWebApplicationName;
if (Result <> '') and (Result[Length(Result)] <> '/') then
Result := Result + '/';
end;
{$IFDEF LINUX}
function GetBrowser: string;
begin
with TIniFile.Create(getenv('HOME') + WebDebuggerIniFile) do
try
Result := ReadString('', sWADBrowser, '');
finally
Free;
end;
end;
{$ENDIF}
{$IFDEF CLXWAD}
type
TIdSocketHandleAccess = class(TIdSocketHandle);
TIdTCPServerAccess = class(TIdTCPServer);
{$ELSE}
var
WasError: Boolean = False;
procedure SctErrHandler(ErrorCode: Integer);
begin
WasError := ErrorCode <> 0;
end;
{$ENDIF}
{$IFDEF LINUX}
procedure WaitForProcessSleep(APID: Integer);
var
Status: TStrings;
I: Integer;
begin
Status := TStringList.Create;
try
while (True) do
begin
Status.LoadFromFile('/proc/' + IntToStr(APID) + '/status');
for I := 0 to Status.Count - 1 do
if (Pos('State:', Status[I]) > 0) and
(Pos('sleeping', Status[I]) > 0) then
Exit;
end;
finally
Status.Free;
end;
end;
{$ENDIF}
procedure RunServer;
function IsActive: Boolean;
{$IFDEF CLXWAD}
var
TestServer: TIdTCPServerAccess;
SocketHandle: TIdSocketHandleAccess;
begin
TestServer := TIdTCPServerAccess.Create(nil);
try
with TestServer do
begin
DefaultPort := GetServerPort;
IOHandler := TIdServerIOHandlerSocket.Create(TestServer);
SocketHandle := TIdSocketHandleAccess(Bindings.Add);
SocketHandle.AllocateSocket;
Result := not SocketHandle.TryBind;
end;
finally
TestServer.Free;
end;
{$ELSE}
var
TestServer: TServerSocket;
SaveErrorProc: TSocketErrorProc;
begin
TestServer := TServerSocket.Create(nil);
try
SaveErrorProc := SetErrorProc(SctErrHandler);
TestServer.Port := GetServerPort;
TestServer.Active := True;
SetErrorProc(SaveErrorProc);
Result := WasError;
finally
TestServer.Free;
end;
{$ENDIF}
end;
function IsActiveOnStartUp: Boolean;
begin
Result := False;
{$IFDEF MSWINDOWS}
with TRegistry.Create do
try
{$IFDEF DELPHI7}
RootKey := HKEY_CURRENT_USER;
{$ELSE}
RootKey := HKEY_LOCAL_MACHINE;
{$ENDIF}
if OpenKey(WebDebuggerRegistryKey, False) then
Result := StrToBoolDef(ReadString(SActiveAtStartup), False);
finally
Free;
end;
{$ENDIF}
{$IFDEF LINUX}
with TIniFile.Create(getenv('HOME') + WebDebuggerIniFile) do
try
Result := StrToBoolDef(ReadString('', SActiveAtStartup, ''), False);
finally
Free;
end;
{$ENDIF}
end;
procedure SetActiveOnStartUp(AValue: string);
begin
{$IFDEF MSWINDOWS}
with TRegistry.Create do
try
{$IFDEF DELPHI7}
RootKey := HKEY_CURRENT_USER;
{$ELSE}
RootKey := HKEY_LOCAL_MACHINE;
{$ENDIF}
if OpenKey(WebDebuggerRegistryKey, False) then
WriteString(SActiveAtStartup, AValue);
finally
Free;
end;
{$ENDIF}
{$IFDEF LINUX}
with TIniFile.Create(getenv('HOME') + WebDebuggerIniFile) do
try
WriteString('', SActiveAtStartup, AValue);
finally
Free;
end;
{$ENDIF}
end;
function GetWebDebuggerPath: string;
begin
Result := '';
{$IFDEF MSWINDOWS}
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey(DelphiRegistryKey, False) then
Result := ReadString('RootDir') + '\Bin\';
finally
Free;
end;
{$ENDIF}
{$IFDEF LINUX}
with TIniFile.Create(getenv('HOME') + DelphiIniFile) do
try
Result := ReadString('Globals', 'DelphiRoot', getenv('HOME') + '/kylix3') + '/bin/';
finally
Free;
end;
{$ENDIF}
end;
function GetDebuggerWindow: Integer;
{$IFDEF MSWINDOWS}
begin
Result := FindWindow(WebDebuggerWindowClass, WebDebuggerWindowName);
{$ENDIF}
{$IFDEF LINUX}
function GetPIDFile: string;
begin
Result := getenv('HOME') + '/.borland/wappappdbg.lck';
end;
function GetDebuggerPID: Integer;
begin
Result := 0;
if FileExists(GetPIDFile) then
with TFileStream.Create(GetPIDFile, 0) do
try
Read(Result, sizeof(Integer));
finally
Free;
end;
end;
procedure DeletePIDFile;
begin
if FileExists(GetPIDFile) then
DeleteFile(GetPIDFile);
end;
begin
Result := GetDebuggerPID;
if Result <> 0 then
begin
DeletePIDFile;
kill(Result, SIGUSR2);
Result := GetDebuggerPID;
end;
{$ENDIF}
end;
procedure DebuggerExecute;
{$IFDEF MSWINDOWS}
var
SI: TStartupInfo;
PI: TProcessInformation;
begin
SI.cb := SizeOf(SI);
SI.lpReserved := nil;
SI.lpDesktop := nil;
SI.lpTitle := nil;
SI.dwFlags := STARTF_USESHOWWINDOW;
SI.wShowWindow := SW_SHOWNORMAL;
SI.lpReserved2 := nil;
SI.cbReserved2 := 0;
CreateProcess(nil, PChar(GetWebDebuggerPath + WebDebuggerFileName), nil, nil, True, 0, nil, nil, SI, PI);
WaitForInputIdle(PI.hProcess, INFINITE);
{$ENDIF}
{$IFDEF LINUX}
var
PID: Integer;
FArgv: array of PChar;
begin
SetLength(FArgv, 2);
FArgv[0] := PChar(GetWebDebuggerPath + WebDebuggerFileName);
FArgv[1] := nil;
PID := fork;
if PID = 0 then
begin
execv(PChar(FArgv[0]), @FArgv[0]);
Exit;
end
{ else
WaitForProcessSleep(PID);
} //TODO
{$ENDIF}
end;
var
ActiveSetting: Boolean;
begin
if GetDebuggerWindow <> 0 then
if not IsActive then
begin
{$IFDEF MSWINDOWS}
PostMessage(GetDebuggerWindow, WM_CLOSE, 0, 0);
{$ENDIF}
{$IFDEF LINUX}
kill(GetDebuggerWindow, SIGTERM);
{$ENDIF}
while GetDebuggerWindow <> 0 do
Application.ProcessMessages;
end
else Exit;
ActiveSetting := IsActiveOnStartUp;
if not ActiveSetting then
SetActiveOnStartUp('1');
DebuggerExecute;
if not ActiveSetting then
SetActiveOnStartUp('0');
end;
procedure RunTestApplication(AWebApplicationName: string);
var
AHTTPName: string;
{$IFDEF LINUX}
PID: Integer;
FArgv: array of PChar;
{$ENDIF}
begin
if DesignerFileManager = nil then exit;
RunServer;
AHTTPName := GetURLAddress(AWebApplicationName);
{$IFDEF MSWINDOWS}
ShellExecute(0, 'open', PChar(AHTTPName), nil, nil, 0);
{$ENDIF}
{$IFDEF LINUX}
SetLength(FArgv, 3);
FArgv[0] := PChar(GetBrowser);
FArgv[1] := PChar(AHTTPName);
FArgv[2] := nil;
PID := fork;
if PID = 0 then
begin
execv(PChar(FArgv[0]), @FArgv[0]);
Exit;
end
{$ENDIF}
end;
type
TcxWebDebuggerFileItem = class
private
FFileName: string;
FText: String;
public
constructor Create(AFileName: string; AText: string);
end;
constructor TcxWebDebuggerFileItem.Create(AFileName: string; AText: string);
begin
FFileName := AFileName;
FText := AText;
end;
type
TcxWebDebuggerFileManager = class(TInterfacedObject, IDesignerFileManager,
IcxWebDebugDesignerFileManager)
private
FList: TList;
procedure CreateItems;
protected
function QualifyFileName(const AFileName: string): string;
function GetStream(const AFileName: string; var AOwned: Boolean): TStream;
public
constructor Create;
destructor Destroy; override;
end;
{ TcxWebDesignerFileManager }
constructor TcxWebDebuggerFileManager.Create;
begin
FList := TList.Create;
CreateItems;
end;
destructor TcxWebDebuggerFileManager.Destroy;
var
I: Integer;
begin
for I := 0 to FList.Count - 1 do
TcxWebDebuggerFileItem(FList[I]).Free;
FList.Free;
inherited Destroy;
end;
procedure TcxWebDebuggerFileManager.CreateItems;
function GetTempDir: string;
begin
{$IFDEF MSWINDOWS}
SetLength(Result, 255);
SetLength(Result, GetTempPath(255, PChar(Result)));
{$ENDIF}
{$IFDEF LINUX}
Result := '/tmp';
{$ENDIF}
if (Result <> '') and (Result[Length(Result)] <> PathDelim) then
Result := Result + PathDelim;
end;
var
AFileStream: TFileStream;
AReader: TReader;
AFileName: string;
AHTMLFileName, AText: string;
AItem: TcxWebDebuggerFileItem;
begin
AFileName := GetTempDir + scxDebugHTMLFileName;
if not FileExists(AFileName) then exit;
AFileStream := TFileStream.Create(AFileName, fmOpenRead);
AReader := TReader.Create(AFileStream, 1024);
try
while AFileStream.Position < AFileStream.Size do
begin
AHTMLFileName := AReader.ReadString;
AText := AReader.ReadString;
AItem := TcxWebDebuggerFileItem.Create(AHTMLFileName, AText);
FList.Add(AItem);
end;
finally
AReader.Free;
AFileStream.Free;
DeleteFile(AFileName);
end;
end;
function TcxWebDebuggerFileManager.GetStream(const AFileName: string; var AOwned: Boolean): TStream;
var
I: Integer;
AFullFileName: string;
begin
Result := nil;
if FList.Count = 0 then exit;
AFullFileName := QualifyFileName(AFileName);
for I := 0 to FList.Count - 1 do
if CompareText(TcxWebDebuggerFileItem(FList[I]).FFileName, AFullFileName) = 0 then
begin
Result := TStringStream.Create(TcxWebDebuggerFileItem(FList[I]).FText);
break;
end;
end;
function TcxWebDebuggerFileManager.QualifyFileName(const AFileName: string): string;
var
ASaveDesignerFileManager: IDesignerFileManager;
begin
ASaveDesignerFileManager := DesignerFileManager;
DesignerFileManager := nil;
Result := cxWebUtils.QualifyFileName(AFileName);
DesignerFileManager := ASaveDesignerFileManager;
end;
initialization
{$IFDEF MSWINDOWS}
if IsDebuggerPresent then
{$ENDIF}
//TODO LINUX
DesignerFileManager := TcxWebDebuggerFileManager.Create;
finalization
DesignerFileManager := nil;
end.