/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 |