Subversion Repositories fastphp

Compare Revisions

No changes between revisions

Regard whitespace Rev 1 → Rev 2

/trunk/FastPHP.bdsproj
0,0 → 1,175
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject>
<PersonalityInfo>
<Option>
<Option Name="Personality">Delphi.Personality</Option>
<Option Name="ProjectType">VCLApplication</Option>
<Option Name="Version">1.0</Option>
<Option Name="GUID">{18E129E3-BE9B-4BD1-9FD0-1E4365C0B337}</Option>
</Option>
</PersonalityInfo>
<Delphi.Personality>
<Source>
<Source Name="MainSource">FastPHP.dpr</Source>
</Source>
<FileVersion>
<FileVersion Name="Version">7.0</FileVersion>
</FileVersion>
<Compiler>
<Compiler Name="A">8</Compiler>
<Compiler Name="B">0</Compiler>
<Compiler Name="C">1</Compiler>
<Compiler Name="D">1</Compiler>
<Compiler Name="E">0</Compiler>
<Compiler Name="F">0</Compiler>
<Compiler Name="G">1</Compiler>
<Compiler Name="H">1</Compiler>
<Compiler Name="I">1</Compiler>
<Compiler Name="J">0</Compiler>
<Compiler Name="K">0</Compiler>
<Compiler Name="L">1</Compiler>
<Compiler Name="M">0</Compiler>
<Compiler Name="N">1</Compiler>
<Compiler Name="O">1</Compiler>
<Compiler Name="P">1</Compiler>
<Compiler Name="Q">0</Compiler>
<Compiler Name="R">0</Compiler>
<Compiler Name="S">0</Compiler>
<Compiler Name="T">0</Compiler>
<Compiler Name="U">0</Compiler>
<Compiler Name="V">1</Compiler>
<Compiler Name="W">0</Compiler>
<Compiler Name="X">1</Compiler>
<Compiler Name="Y">1</Compiler>
<Compiler Name="Z">1</Compiler>
<Compiler Name="ShowHints">True</Compiler>
<Compiler Name="ShowWarnings">True</Compiler>
<Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler>
<Compiler Name="NamespacePrefix"></Compiler>
<Compiler Name="GenerateDocumentation">False</Compiler>
<Compiler Name="DefaultNamespace"></Compiler>
<Compiler Name="SymbolDeprecated">True</Compiler>
<Compiler Name="SymbolLibrary">True</Compiler>
<Compiler Name="SymbolPlatform">True</Compiler>
<Compiler Name="SymbolExperimental">True</Compiler>
<Compiler Name="UnitLibrary">True</Compiler>
<Compiler Name="UnitPlatform">True</Compiler>
<Compiler Name="UnitDeprecated">True</Compiler>
<Compiler Name="UnitExperimental">True</Compiler>
<Compiler Name="HResultCompat">True</Compiler>
<Compiler Name="HidingMember">True</Compiler>
<Compiler Name="HiddenVirtual">True</Compiler>
<Compiler Name="Garbage">True</Compiler>
<Compiler Name="BoundsError">True</Compiler>
<Compiler Name="ZeroNilCompat">True</Compiler>
<Compiler Name="StringConstTruncated">True</Compiler>
<Compiler Name="ForLoopVarVarPar">True</Compiler>
<Compiler Name="TypedConstVarPar">True</Compiler>
<Compiler Name="AsgToTypedConst">True</Compiler>
<Compiler Name="CaseLabelRange">True</Compiler>
<Compiler Name="ForVariable">True</Compiler>
<Compiler Name="ConstructingAbstract">True</Compiler>
<Compiler Name="ComparisonFalse">True</Compiler>
<Compiler Name="ComparisonTrue">True</Compiler>
<Compiler Name="ComparingSignedUnsigned">True</Compiler>
<Compiler Name="CombiningSignedUnsigned">True</Compiler>
<Compiler Name="UnsupportedConstruct">True</Compiler>
<Compiler Name="FileOpen">True</Compiler>
<Compiler Name="FileOpenUnitSrc">True</Compiler>
<Compiler Name="BadGlobalSymbol">True</Compiler>
<Compiler Name="DuplicateConstructorDestructor">True</Compiler>
<Compiler Name="InvalidDirective">True</Compiler>
<Compiler Name="PackageNoLink">True</Compiler>
<Compiler Name="PackageThreadVar">True</Compiler>
<Compiler Name="ImplicitImport">True</Compiler>
<Compiler Name="HPPEMITIgnored">True</Compiler>
<Compiler Name="NoRetVal">True</Compiler>
<Compiler Name="UseBeforeDef">True</Compiler>
<Compiler Name="ForLoopVarUndef">True</Compiler>
<Compiler Name="UnitNameMismatch">True</Compiler>
<Compiler Name="NoCFGFileFound">True</Compiler>
<Compiler Name="ImplicitVariants">True</Compiler>
<Compiler Name="UnicodeToLocale">True</Compiler>
<Compiler Name="LocaleToUnicode">True</Compiler>
<Compiler Name="ImagebaseMultiple">True</Compiler>
<Compiler Name="SuspiciousTypecast">True</Compiler>
<Compiler Name="PrivatePropAccessor">True</Compiler>
<Compiler Name="UnsafeType">False</Compiler>
<Compiler Name="UnsafeCode">False</Compiler>
<Compiler Name="UnsafeCast">False</Compiler>
<Compiler Name="OptionTruncated">True</Compiler>
<Compiler Name="WideCharReduced">True</Compiler>
<Compiler Name="DuplicatesIgnored">True</Compiler>
<Compiler Name="UnitInitSeq">True</Compiler>
<Compiler Name="LocalPInvoke">True</Compiler>
<Compiler Name="MessageDirective">True</Compiler>
<Compiler Name="CodePage"></Compiler>
</Compiler>
<Linker>
<Linker Name="MapFile">0</Linker>
<Linker Name="OutputObjs">0</Linker>
<Linker Name="GenerateHpps">False</Linker>
<Linker Name="ConsoleApp">1</Linker>
<Linker Name="DebugInfo">False</Linker>
<Linker Name="RemoteSymbols">False</Linker>
<Linker Name="GenerateDRC">False</Linker>
<Linker Name="MinStackSize">16384</Linker>
<Linker Name="MaxStackSize">1048576</Linker>
<Linker Name="ImageBase">4194304</Linker>
<Linker Name="ExeDescription"></Linker>
</Linker>
<Directories>
<Directories Name="OutputDir"></Directories>
<Directories Name="UnitOutputDir"></Directories>
<Directories Name="PackageDLLOutputDir"></Directories>
<Directories Name="PackageDCPOutputDir"></Directories>
<Directories Name="SearchPath"></Directories>
<Directories Name="Packages"></Directories>
<Directories Name="Conditionals"></Directories>
<Directories Name="DebugSourceDirs"></Directories>
<Directories Name="UsePackages">False</Directories>
</Directories>
<Parameters>
<Parameters Name="RunParams"></Parameters>
<Parameters Name="HostApplication"></Parameters>
<Parameters Name="Launcher"></Parameters>
<Parameters Name="UseLauncher">False</Parameters>
<Parameters Name="DebugCWD"></Parameters>
<Parameters Name="Debug Symbols Search Path"></Parameters>
<Parameters Name="LoadAllSymbols">True</Parameters>
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
</Parameters>
<Language>
<Language Name="ActiveLang"></Language>
<Language Name="ProjectLang">$00000000</Language>
<Language Name="RootDir"></Language>
</Language>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">True</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">0</VersionInfo>
<VersionInfo Name="MinorVer">1</VersionInfo>
<VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">1031</VersionInfo>
<VersionInfo Name="CodePage">1252</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName">ViaThinkSoft</VersionInfoKeys>
<VersionInfoKeys Name="FileDescription">FastPHP Editor</VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">0.1.0.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName">FastPHP</VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright">(C) 2016 ViaThinkSoft</VersionInfoKeys>
<VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
<VersionInfoKeys Name="OriginalFilename">FastPHP.exe</VersionInfoKeys>
<VersionInfoKeys Name="ProductName">ViaThinkSoft FastPHP Editor</VersionInfoKeys>
<VersionInfoKeys Name="ProductVersion">0.1</VersionInfoKeys>
<VersionInfoKeys Name="Comments"></VersionInfoKeys>
</VersionInfoKeys>
</Delphi.Personality>
</BorlandProject>
/trunk/FastPHP.cfg
0,0 → 1,38
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-LE"C:\Users\DELL User\Documents\Borland Studio-Projekte\Bpl"
-LN"C:\Users\DELL User\Documents\Borland Studio-Projekte\Bpl"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST
/trunk/FastPHP.dpr
0,0 → 1,15
program FastPHP;
 
uses
Forms,
Unit1 in 'Unit1.pas' {Form1},
Functions in 'Functions.pas';
 
{$R *.res}
 
begin
Application.Initialize;
// Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
/trunk/FastPHP.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/Functions.pas
0,0 → 1,371
unit Functions;
 
interface
 
uses
Windows, Messages, SysUtils, StrUtils, IniFiles, Classes, Forms, Variants, MsHTML,
SHDocVw, StdCtrls;
 
function GetDosOutput(CommandLine: string; Work: string = ''): string;
function StrIPos(const SubStr, S: string): Integer;
procedure WaitForBrowser(WB: TWebbrowser);
function LoadFileToStr(const FileName: TFileName): AnsiString;
function LastPos(const SubStr, S: string): integer;
function ParseCHM(chmFile: string): boolean;
procedure BrowseURL(WebBrowser1: TWebBrowser; url: string);
procedure BrowseContent(WebBrowser1: TWebBrowser; html: string);
function IsTextHTML(s: string): boolean;
function GetWordUnderCaret(AMemo: TMemo): string;
function IsValidPHPExe(const exeFile: string): boolean;
 
implementation
 
function GetDosOutput(CommandLine: string; Work: string = ''): string;
var
SA: TSecurityAttributes;
SI: TStartupInfo;
PI: TProcessInformation;
StdOutPipeRead, StdOutPipeWrite: THandle;
WasOK: Boolean;
Buffer: array[0..255] of AnsiChar;
BytesRead: Cardinal;
WorkDir: string;
Handle: Boolean;
begin
if Work = '' then Work := ExtractFilePath(ParamStr(0));
 
Result := '';
with SA do begin
nLength := SizeOf(SA);
bInheritHandle := True;
lpSecurityDescriptor := nil;
end;
CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
try
with SI do
begin
FillChar(SI, SizeOf(SI), 0);
cb := SizeOf(SI);
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
wShowWindow := SW_HIDE;
hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end;
WorkDir := Work;
Handle := CreateProcess(nil, PChar('cmd.exe /C "' + CommandLine + '"'),
nil, nil, True, 0, nil,
PChar(WorkDir), SI, PI);
CloseHandle(StdOutPipeWrite);
if Handle then
try
repeat
WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
if BytesRead > 0 then
begin
Buffer[BytesRead] := #0;
Result := Result + Buffer;
end;
until not WasOK or (BytesRead = 0);
WaitForSingleObject(PI.hProcess, INFINITE);
finally
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
end;
finally
CloseHandle(StdOutPipeRead);
end;
end;
 
function StrIPos(const SubStr, S: string): Integer;
begin
Result := Pos(UpperCase(SubStr), UpperCase(S));
end;
 
procedure WaitForBrowser(WB: TWebbrowser);
begin
while (WB.Busy)
and not (Application.Terminated) do
begin
Application.ProcessMessages;
Sleep(100);
end;
end;
 
function LoadFileToStr(const FileName: TFileName): AnsiString;
var
FileStream : TFileStream;
 
begin
Result:= '';
FileStream:= TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
if FileStream.Size>0 then begin
SetLength(Result, FileStream.Size);
FileStream.Read(Result[1], FileStream.Size);
end;
finally
FileStream.Free;
end;
end;
 
function LastPos(const SubStr, S: string): integer;
var
I, J, K: integer;
begin
Result := 0;
I := Length(S);
K := Length(SubStr);
if (K = 0) or (K > I) then
Exit;
while (Result = 0) and (I >= K) do
begin
J := K;
if S[I] = SubStr[J] then
begin
while (J > 1) and (S[I + J - K - 1] = SubStr[J - 1]) do
Dec(J);
if J = 1 then
Result := I - K + 1;
end;
Dec(I);
end;
end;
 
function ParseCHM(chmFile: string): boolean;
var
test, candidate, candidate2: string;
p, p2, q: integer;
i: integer;
good: Boolean;
ini: TMemIniFile;
domain: string;
sl: TStringList;
symbolCount: Integer;
sl2: TStrings;
outFile: string;
begin
// TODO: problem: mysqli::commit has /res/mysqli.commit.html -> keyword is NOT commit alone
 
outFile := ChangeFileExt(chmFile, '.ini');
DeleteFile(outFile);
test := LoadFileToStr(chmFile);
if Pos('/php_manual_', test) = -1 then
begin
result := false;
exit;
end;
p := 0;
ini := TMemIniFile.Create(outFile);
try
ini.WriteString('_Info_', 'Source', chmFile);
ini.WriteString('_Info_', 'Generated', DateTimeToStr(Now));
ini.WriteString('_Info_', 'GeneratorVer', '1.0');
ini.WriteString('_Info_', 'Signature', '$ViaThinkSoft$');
{$REGION 'Excludes'}
// TODO: more excludes
ini.WriteBool('_HelpExclude_', 'about', true);
ini.WriteBool('_HelpExclude_', 'apache', true);
{$ENDREGION}
while true do
begin
Application.ProcessMessages;
 
p := PosEx('/res/', Test, p+1);
if p = 0 then break;
p2 := PosEx('.html', Test, p);
if p = 0 then break;
candidate := copy(Test, p+5, p2-p-5);
if candidate = '' then continue;
if Length(candidate) > 50 then continue;
good := true;
for i := p+5 to p2-1 do
begin
if ord(test[i]) < 32 then
begin
good := false;
break;
end;
if not (test[i] in ['a'..'z', 'A'..'Z', '.', '-', '_', '0'..'9']) then
begin
ini.WriteInteger('_Errors_', 'Contains unexpected character! ' + candidate, ini.ReadInteger('_Errors_', 'Contains unexpected character! ' + candidate, 0)+1);
good := false;
break;
end;
end;
if good then
begin
candidate2 := LowerCase(StringReplace(candidate, '-', '_', [rfReplaceAll]));
q := LastPos('.', candidate2);
domain := copy(candidate2, 1, q-1);
if domain = '' then continue;
candidate2 := copy(candidate2, q+1, Length(candidate2)-q);
ini.WriteInteger('_Category_', domain, ini.ReadInteger('_Category_', domain, 0)+1);
ini.WriteString(domain, candidate2, '/res/'+candidate+'.html');
if not ini.ReadBool('_HelpExclude_', domain, false)
and (candidate2 <> 'configuration')
and (candidate2 <> 'constants')
and (candidate2 <> 'installation')
and (candidate2 <> 'requirements')
and (candidate2 <> 'resources')
and (candidate2 <> 'setup') then
begin
if ini.ReadString('_HelpWords_', candidate2, '') <> '' then
begin
ini.WriteInteger('_Conflicts_', candidate2, ini.ReadInteger('_Conflicts_', candidate2, 0)+1);
end;
 
ini.WriteString('_HelpWords_', candidate2, '/res/'+candidate+'.html');
end;
end;
end;
 
sl := TStringList.Create;
sl2 := TStringList.Create;
try
ini.ReadSections(sl);
ini.WriteInteger('_Info_', 'TotalDomains', sl.Count);
symbolCount := 0;
for domain in sl do
begin
ini.ReadSection(domain, sl2);
Inc(symbolCount, sl2.Count)
end;
ini.WriteInteger('_Info_', 'TotalSymbols', symbolCount);
finally
sl.Free;
sl2.Free;
end;
 
ini.UpdateFile;
result := true;
finally
ini.Free;
end;
end;
 
procedure BrowseURL(WebBrowser1: TWebBrowser; url: string);
var
BrowserFlags : olevariant;
MyTargetFrameName : olevariant;
MyPostaData : olevariant;
MyHeaders : olevariant;
begin
{ Flags:
Constant Value Meaning
NavOpenInNewWindow $01 Open the resource or file in a new window.
NavNoHistory $02 Do not add the resource or file to the history list. The new page replaces the current page in the list.
NavNoReadFromCache $04 Do not read from the disk cache for this navigation.
NavNoWriteToCache $08 Do not write the results of this navigation to the disk cache.
NavAllowAutosearch $10 If the navigation fails, the Web browser attempts to navigate common root domains (.com, .org, and so on). If this still fails, the URL is passed to a search engine.
}
BrowserFlags := $02;
MyTargetFrameName := null;
MyPostaData := null;
MyHeaders := null;
WebBrowser1.Silent := true; // no JavaScript errors
Webbrowser1.Navigate(url, BrowserFlags,MyTargetFrameName,MyPostaData,MyHeaders);
WaitForBrowser(WebBrowser1);
end;
 
procedure BrowseContent(WebBrowser1: TWebBrowser; html: string);
var
BrowserFlags : olevariant;
MyTargetFrameName : olevariant;
MyPostaData : olevariant;
MyHeaders : olevariant;
Doc: Variant;
begin
{ Flags:
Constant Value Meaning
NavOpenInNewWindow $01 Open the resource or file in a new window.
NavNoHistory $02 Do not add the resource or file to the history list. The new page replaces the current page in the list.
NavNoReadFromCache $04 Do not read from the disk cache for this navigation.
NavNoWriteToCache $08 Do not write the results of this navigation to the disk cache.
NavAllowAutosearch $10 If the navigation fails, the Web browser attempts to navigate common root domains (.com, .org, and so on). If this still fails, the URL is passed to a search engine.
}
if WebBrowser1.Document = nil then
begin
BrowserFlags := $02 + $04 + $08 + $10;
MyTargetFrameName := null;
MyPostaData := null;
MyHeaders := null;
Webbrowser1.Navigate('about:blank', BrowserFlags,MyTargetFrameName,MyPostaData,MyHeaders);
WaitForBrowser(WebBrowser1);
end;
 
Doc := WebBrowser1.Document;
Doc.Clear;
Doc.Write(html);
Doc.Close;
WaitForBrowser(WebBrowser1);
end;
 
function IsTextHTML(s: string): boolean;
 
function _Tag(const tag: string): integer;
begin
result := 0;
if (StrIPos('<'+tag+'>', s) > 0) then Inc(result);
if (StrIPos('</'+tag+'>', s) > 0) then Inc(result);
if (StrIPos('<'+tag+' />', s) > 0) then Inc(result);
if (StrIPos('<'+tag+' ', s) > 0) then Inc(result);
end;
 
var
score: integer;
begin
score := _Tag('html') + _Tag('body') + _Tag('p') + _Tag('a') + _Tag('b') +
_Tag('i') + _Tag('u') + _Tag('li') + _Tag('ol') + _Tag('ul') +
_Tag('img') + _Tag('div') + _Tag('hr') + _Tag('code') +
_Tag('pre') + _Tag('blockquote') + _Tag('span');
result := score >= 2;
end;
 
// Template: http://stackoverflow.com/questions/6339446/delphi-get-the-whole-word-where-the-caret-is-in-a-memo
function GetWordUnderCaret(AMemo: TMemo): string;
 
function ValidChar(c: char): boolean;
begin
result := c in ['a'..'z', 'A'..'Z', '0'..'9', '_'];
end;
 
var
Line : Integer;
Column : Integer;
LineText: string;
InitPos : Integer;
EndPos : Integer;
begin
//Get the caret position
Line := AMemo.Perform(EM_LINEFROMCHAR,AMemo.SelStart, 0) ;
Column := AMemo.SelStart - AMemo.Perform(EM_LINEINDEX, Line, 0) ;
//Validate the line number
if AMemo.Lines.Count-1 < Line then Exit;
 
//Get the text of the line
LineText := AMemo.Lines[Line];
 
// Column zeigt auf das Zeichen LINKS vom Cursor!
 
InitPos := Column;
if not ValidChar(LineText[InitPos]) then Inc(InitPos);
while (InitPos-1 >= 1) and ValidChar(LineText[InitPos-1]) do Dec(InitPos);
 
EndPos := Column;
while (EndPos+1 <= Length(LineText)) and ValidChar(LineText[EndPos+1]) do Inc(EndPos);
 
//Get the text
Result := Copy(LineText, InitPos, EndPos - InitPos + 1);
end;
 
function IsValidPHPExe(const exeFile: string): boolean;
var
cont: string;
begin
cont := LoadFileToStr(exeFile);
result := (Pos('php://stdout', cont) >= 0) or
(Pos('PHP_SELF', cont) >= 0);
end;
 
end.
/trunk/Unit1.dfm
0,0 → 1,161
object Form1: TForm1
Left = 0
Top = 0
Caption = 'ViaThinkSoft FastPHP'
ClientHeight = 661
ClientWidth = 1120
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
WindowState = wsMaximized
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object Splitter1: TSplitter
Left = 0
Top = 385
Width = 1120
Height = 3
Cursor = crVSplit
Align = alBottom
ExplicitTop = 262
ExplicitWidth = 399
end
object PageControl1: TPageControl
Left = 0
Top = 388
Width = 1120
Height = 273
ActivePage = HtmlTabSheet
Align = alBottom
TabOrder = 0
object PlaintextTabSheet: TTabSheet
Caption = 'Plaintext'
object Memo2: TMemo
Left = 0
Top = 0
Width = 1112
Height = 245
Align = alClient
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
ReadOnly = True
ScrollBars = ssBoth
TabOrder = 0
end
end
object HtmlTabSheet: TTabSheet
Caption = 'HTML'
ImageIndex = 1
object WebBrowser1: TWebBrowser
Left = 0
Top = 0
Width = 1112
Height = 245
Align = alClient
TabOrder = 0
ExplicitWidth = 348
ExplicitHeight = 150
ControlData = {
4C000000EE720000521900000000000000000000000000000000000000000000
000000004C000000000000000000000001000000E0D057007335CF11AE690800
2B2E126208000000000000004C0000000114020000000000C000000000000046
8000000000000000000000000000000000000000000000000000000000000000
00000000000000000100000000000000000000000000000000000000}
end
end
end
object PageControl2: TPageControl
Left = 0
Top = 0
Width = 1120
Height = 385
ActivePage = TabSheet3
Align = alClient
TabOrder = 1
OnChanging = PageControl2Changing
object TabSheet3: TTabSheet
Caption = 'Scrap'
object Memo1: TMemo
Left = 0
Top = 0
Width = 1112
Height = 357
Align = alClient
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
ParentFont = False
TabOrder = 0
OnKeyDown = Memo1KeyDown
end
end
object HelpTabsheet: TTabSheet
Caption = 'Help'
ImageIndex = 1
object WebBrowser2: TWebBrowser
Left = 0
Top = 0
Width = 1112
Height = 357
Align = alClient
TabOrder = 0
ExplicitWidth = 300
ExplicitHeight = 150
ControlData = {
4C000000EE720000E62400000000000000000000000000000000000000000000
000000004C000000000000000000000001000000E0D057007335CF11AE690800
2B2E126208000000000000004C0000000114020000000000C000000000000046
8000000000000000000000000000000000000000000000000000000000000000
00000000000000000100000000000000000000000000000000000000}
end
end
end
object Panel1: TPanel
Left = 544
Top = 112
Width = 185
Height = 41
Caption = 'Generating help. Please wait...'
TabOrder = 2
Visible = False
end
object OpenDialog1: TOpenDialog
DefaultExt = '.chm'
Filter = 'Help files (*.chm)|*.chm'
Options = [ofReadOnly, ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing]
Title = 'Please select your PHP Help file (CHM format)'
Left = 504
Top = 248
end
object OpenDialog2: TOpenDialog
DefaultExt = '.exe'
FileName = 'php.exe'
Filter = 'Executable file (*.exe)|*.exe'
Options = [ofReadOnly, ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing]
Title = 'Please chose your PHP interpreter (php.exe)'
Left = 552
Top = 248
end
object OpenDialog3: TOpenDialog
DefaultExt = '.php'
Filter = 'PHP file (*.php)|*.php|All files (*.*)|*.*'
Options = [ofHideReadOnly, ofPathMustExist, ofEnableSizing]
Title = 'Where should the scrap file be saved?'
Left = 608
Top = 248
end
end
/trunk/Unit1.pas
0,0 → 1,306
unit Unit1;
 
// TODO: localize
 
// TODO: wieso geht copy paste im twebbrowser nicht???
// Wieso dauert webbrowser1 erste kompilierung so lange???
 
// Future ideas
// - ToDo list
// - Open/Save real files
// - configurable scraps dir. multiple scraps?
// - verschiedene php versionen?
// - webbrowser1 nur laden, wenn man den tab anwählt?
// - doppelklick auf tab soll diesen schließen
 
interface
 
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, SHDocVw, ComCtrls, ExtCtrls, ToolWin, IniFiles;
 
type
TForm1 = class(TForm)
PageControl1: TPageControl;
PlaintextTabSheet: TTabSheet;
HtmlTabSheet: TTabSheet;
Memo2: TMemo;
WebBrowser1: TWebBrowser;
Splitter1: TSplitter;
PageControl2: TPageControl;
TabSheet3: TTabSheet;
HelpTabsheet: TTabSheet;
WebBrowser2: TWebBrowser;
Memo1: TMemo;
OpenDialog1: TOpenDialog;
Panel1: TPanel;
OpenDialog2: TOpenDialog;
OpenDialog3: TOpenDialog;
procedure Run(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure PageControl2Changing(Sender: TObject; var AllowChange: Boolean);
private
CurSearchTerm: string;
HlpPrevPageIndex: integer;
procedure Help;
procedure ApplicationOnMessage(var Msg: tagMSG; var Handled: Boolean);
protected
FastPHPConfig: TMemIniFile;
ChmIndex: TMemIniFile;
function GetScrapFile: string;
end;
 
var
Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses
Functions;
 
procedure TForm1.ApplicationOnMessage(var Msg: tagMSG; var Handled: Boolean);
begin
case Msg.message of
WM_KEYUP:
begin
case Msg.wParam of
VK_ESCAPE:
begin
// It is necessary to use Application.OnMessage, because Form1.KeyPreview does not work when TWebBrowser has the focus
if (HlpPrevPageIndex <> -1) and (PageControl2.ActivePage = HelpTabSheet) and
(HelpTabsheet.TabVisible) then
begin
PageControl2.ActivePageIndex := HlpPrevPageIndex;
HelpTabsheet.TabVisible := false;
end;
Handled := true;
end;
end;
end;
end;
end;
 
procedure TForm1.Run(Sender: TObject);
var
phpExe: string;
begin
if not FileExists(phpExe) then
begin
phpExe := FastPHPConfig.ReadString('Paths', 'PHPInterpreter', '');
if not FileExists(phpExe) then
begin
if not OpenDialog2.Execute then exit;
if not FileExists(OpenDialog2.FileName) then exit;
phpExe := OpenDialog2.FileName;
 
if not IsValidPHPExe(phpExe) then
begin
ShowMessage('This is not a valid PHP executable.');
exit;
end;
 
FastPHPConfig.WriteString('Paths', 'PHPInterpreter', phpExe);
FastPHPConfig.UpdateFile;
end;
end;
 
memo1.Lines.SaveToFile(GetScrapFile);
 
memo2.Lines.Text := GetDosOutput('"'+phpExe+'" "'+GetScrapFile+'"', ExtractFileDir(Application.ExeName));
 
BrowseContent(Webbrowser1, memo2.Lines.Text);
 
if IsTextHTML(memo2.lines.text) then
PageControl1.ActivePage := HtmlTabSheet
else
PageControl1.ActivePage := PlaintextTabSheet;
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Memo1.Lines.SaveToFile(GetScrapFile);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
HlpPrevPageIndex := -1;
CurSearchTerm := '';
Application.OnMessage := ApplicationOnMessage;
 
FastPHPConfig := TMemIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(ChmIndex) then
begin
FreeAndNil(ChmIndex);
end;
 
FastPHPConfig.UpdateFile;
FreeAndNil(FastPHPConfig);
end;
 
procedure TForm1.FormShow(Sender: TObject);
var
ScrapFile: string;
begin
ScrapFile := GetScrapFile;
if ScrapFile = '' then
begin
Close;
exit;
end;
Memo1.Lines.LoadFromFile(ScrapFile);
 
PageControl1.ActivePage := PlaintextTabSheet;
 
PageControl2.ActivePageIndex := 0; // Scraps
HelpTabsheet.TabVisible := false;
end;
 
function TForm1.GetScrapFile: string;
begin
result := FastPHPConfig.ReadString('Paths', 'ScrapFile', '');
if not FileExists(result) then
begin
if not OpenDialog3.Execute then
begin
result := '';
exit;
end;
 
result := OpenDialog3.FileName;
 
if not DirectoryExists(ExtractFilePath(result)) then
begin
ShowMessage('Path does not exist!');
result := '';
exit;
end;
 
Memo1.Lines.Clear;
Memo1.Lines.SaveToFile(result);
 
FastPHPConfig.WriteString('Paths', 'ScrapFile', result);
end;
end;
 
procedure TForm1.Help;
var
IndexFile, chmFile, w, url: string;
internalHtmlFile: string;
begin
if not Assigned(ChmIndex) then
begin
IndexFile := FastPHPConfig.ReadString('Paths', 'HelpIndex', '');
IndexFile := ChangeFileExt(IndexFile, '.ini'); // Just to be sure. Maybe someone wrote manually the ".chm" file in there
if FileExists(IndexFile) then
begin
ChmIndex := TMemIniFile.Create(IndexFile);
end;
end;
 
if Assigned(ChmIndex) then
begin
IndexFile := FastPHPConfig.ReadString('Paths', 'HelpIndex', '');
// We don't check if IndexFile still exists. It is not important since we have ChmIndex pre-loaded in memory
 
chmFile := ChangeFileExt(IndexFile, '.chm');
if not FileExists(chmFile) then
begin
FreeAndNil(ChmIndex);
end;
end;
 
if not Assigned(ChmIndex) then
begin
if not OpenDialog1.Execute then exit;
 
chmFile := OpenDialog1.FileName;
if not FileExists(chmFile) then exit;
 
IndexFile := ChangeFileExt(chmFile, '.ini');
 
if not FileExists(IndexFile) then
begin
Panel1.Align := alClient;
Panel1.Visible := true;
Panel1.BringToFront;
Screen.Cursor := crHourGlass;
Application.ProcessMessages;
try
if not ParseCHM(chmFile) then
begin
ShowMessage('The CHM file is not a valid PHP documentation. Cannot use help.');
exit;
end;
finally
Screen.Cursor := crDefault;
Panel1.Visible := false;
end;
 
if not FileExists(IndexFile) then
begin
ShowMessage('Unknown error. Cannot use help.');
exit;
end;
end;
 
FastPHPConfig.WriteString('Paths', 'HelpIndex', IndexFile);
FastPHPConfig.UpdateFile;
 
ChmIndex := TMemIniFile.Create(IndexFile);
end;
 
w := GetWordUnderCaret(Memo1);
if w = '' then exit;
if w[1] in ['0'..'9'] then exit;
w := StringReplace(w, '_', '-', [rfReplaceAll]);
w := LowerCase(w);
CurSearchTerm := w;
 
internalHtmlFile := ChmIndex.ReadString('_HelpWords_', CurSearchTerm, '');
if internalHtmlFile = '' then
begin
HelpTabsheet.TabVisible := false;
HlpPrevPageIndex := -1;
ShowMessage('No help for "'+CurSearchTerm+'" available');
Exit;
end;
 
url := 'mk:@MSITStore:'+ChmFile+'::'+internalHtmlFile;
 
HlpPrevPageIndex := PageControl2.ActivePageIndex; // Return by pressing ESC
HelpTabsheet.TabVisible := true;
PageControl2.ActivePage := HelpTabsheet;
BrowseURL(WebBrowser2, url);
end;
 
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_F9) or (Key = VK_F5) then
Run(Sender)
else if Key = VK_F1 then
Help;
end;
 
procedure TForm1.PageControl2Changing(Sender: TObject;
var AllowChange: Boolean);
begin
if PageControl2.ActivePage = HelpTabsheet then
HlpPrevPageIndex := -1
else
HlpPrevPageIndex := PageControl2.ActivePageIndex;
 
AllowChange := true;
end;
 
end.
/trunk/.
Property changes:
Added: svn:ignore
+*.dcu
+*.~*
+__history
+__recovery
+*.local
+*.identcache
+FastPHP.ini