Rev 4 | Rev 7 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
2 | daniel-mar | 1 | unit Functions; |
2 | |||
3 | interface |
||
4 | |||
5 | uses |
||
6 | Windows, Messages, SysUtils, StrUtils, IniFiles, Classes, Forms, Variants, MsHTML, |
||
4 | daniel-mar | 7 | SHDocVw_TLB, StdCtrls, SynEdit, |
2 | daniel-mar | 8 | |
4 | daniel-mar | 9 | |
10 | |||
11 | |||
12 | |||
13 | dialogs; |
||
14 | |||
2 | daniel-mar | 15 | function GetDosOutput(CommandLine: string; Work: string = ''): string; |
16 | function StrIPos(const SubStr, S: string): Integer; |
||
17 | procedure WaitForBrowser(WB: TWebbrowser); |
||
18 | function LoadFileToStr(const FileName: TFileName): AnsiString; |
||
19 | function LastPos(const SubStr, S: string): integer; |
||
20 | function ParseCHM(chmFile: string): boolean; |
||
21 | procedure BrowseURL(WebBrowser1: TWebBrowser; url: string); |
||
22 | procedure BrowseContent(WebBrowser1: TWebBrowser; html: string); |
||
23 | function IsTextHTML(s: string): boolean; |
||
4 | daniel-mar | 24 | function GetWordUnderCaret(AMemo: TSynEdit): string; |
2 | daniel-mar | 25 | function IsValidPHPExe(const exeFile: string): boolean; |
26 | |||
27 | implementation |
||
28 | |||
29 | function GetDosOutput(CommandLine: string; Work: string = ''): string; |
||
30 | var |
||
31 | SA: TSecurityAttributes; |
||
32 | SI: TStartupInfo; |
||
33 | PI: TProcessInformation; |
||
34 | StdOutPipeRead, StdOutPipeWrite: THandle; |
||
35 | WasOK: Boolean; |
||
36 | Buffer: array[0..255] of AnsiChar; |
||
37 | BytesRead: Cardinal; |
||
38 | WorkDir: string; |
||
39 | Handle: Boolean; |
||
40 | begin |
||
41 | if Work = '' then Work := ExtractFilePath(ParamStr(0)); |
||
42 | |||
43 | Result := ''; |
||
44 | with SA do begin |
||
45 | nLength := SizeOf(SA); |
||
46 | bInheritHandle := True; |
||
47 | lpSecurityDescriptor := nil; |
||
48 | end; |
||
49 | CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0); |
||
50 | try |
||
51 | with SI do |
||
52 | begin |
||
53 | FillChar(SI, SizeOf(SI), 0); |
||
54 | cb := SizeOf(SI); |
||
55 | dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; |
||
56 | wShowWindow := SW_HIDE; |
||
57 | hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin |
||
58 | hStdOutput := StdOutPipeWrite; |
||
59 | hStdError := StdOutPipeWrite; |
||
60 | end; |
||
61 | WorkDir := Work; |
||
62 | Handle := CreateProcess(nil, PChar('cmd.exe /C "' + CommandLine + '"'), |
||
63 | nil, nil, True, 0, nil, |
||
64 | PChar(WorkDir), SI, PI); |
||
65 | CloseHandle(StdOutPipeWrite); |
||
66 | if Handle then |
||
67 | try |
||
68 | repeat |
||
69 | WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil); |
||
70 | if BytesRead > 0 then |
||
71 | begin |
||
72 | Buffer[BytesRead] := #0; |
||
73 | Result := Result + Buffer; |
||
74 | end; |
||
75 | until not WasOK or (BytesRead = 0); |
||
76 | WaitForSingleObject(PI.hProcess, INFINITE); |
||
77 | finally |
||
78 | CloseHandle(PI.hThread); |
||
79 | CloseHandle(PI.hProcess); |
||
80 | end; |
||
81 | finally |
||
82 | CloseHandle(StdOutPipeRead); |
||
83 | end; |
||
84 | end; |
||
85 | |||
86 | function StrIPos(const SubStr, S: string): Integer; |
||
87 | begin |
||
88 | Result := Pos(UpperCase(SubStr), UpperCase(S)); |
||
89 | end; |
||
90 | |||
91 | procedure WaitForBrowser(WB: TWebbrowser); |
||
92 | begin |
||
93 | while (WB.Busy) |
||
94 | and not (Application.Terminated) do |
||
95 | begin |
||
96 | Application.ProcessMessages; |
||
97 | Sleep(100); |
||
98 | end; |
||
99 | end; |
||
100 | |||
101 | function LoadFileToStr(const FileName: TFileName): AnsiString; |
||
102 | var |
||
103 | FileStream : TFileStream; |
||
104 | |||
105 | begin |
||
106 | Result:= ''; |
||
107 | FileStream:= TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); |
||
108 | try |
||
109 | if FileStream.Size>0 then begin |
||
110 | SetLength(Result, FileStream.Size); |
||
111 | FileStream.Read(Result[1], FileStream.Size); |
||
112 | end; |
||
113 | finally |
||
114 | FileStream.Free; |
||
115 | end; |
||
116 | end; |
||
117 | |||
118 | function LastPos(const SubStr, S: string): integer; |
||
119 | var |
||
120 | I, J, K: integer; |
||
121 | begin |
||
122 | Result := 0; |
||
123 | I := Length(S); |
||
124 | K := Length(SubStr); |
||
125 | if (K = 0) or (K > I) then |
||
126 | Exit; |
||
127 | while (Result = 0) and (I >= K) do |
||
128 | begin |
||
129 | J := K; |
||
130 | if S[I] = SubStr[J] then |
||
131 | begin |
||
132 | while (J > 1) and (S[I + J - K - 1] = SubStr[J - 1]) do |
||
133 | Dec(J); |
||
134 | if J = 1 then |
||
135 | Result := I - K + 1; |
||
136 | end; |
||
137 | Dec(I); |
||
138 | end; |
||
139 | end; |
||
140 | |||
141 | function ParseCHM(chmFile: string): boolean; |
||
142 | var |
||
143 | test, candidate, candidate2: string; |
||
144 | p, p2, q: integer; |
||
145 | i: integer; |
||
146 | good: Boolean; |
||
147 | ini: TMemIniFile; |
||
148 | domain: string; |
||
149 | sl: TStringList; |
||
150 | symbolCount: Integer; |
||
151 | sl2: TStrings; |
||
152 | outFile: string; |
||
153 | begin |
||
154 | // TODO: problem: mysqli::commit has /res/mysqli.commit.html -> keyword is NOT commit alone |
||
155 | |||
156 | outFile := ChangeFileExt(chmFile, '.ini'); |
||
157 | DeleteFile(outFile); |
||
158 | test := LoadFileToStr(chmFile); |
||
159 | if Pos('/php_manual_', test) = -1 then |
||
160 | begin |
||
161 | result := false; |
||
162 | exit; |
||
163 | end; |
||
164 | p := 0; |
||
165 | ini := TMemIniFile.Create(outFile); |
||
166 | try |
||
167 | ini.WriteString('_Info_', 'Source', chmFile); |
||
168 | ini.WriteString('_Info_', 'Generated', DateTimeToStr(Now)); |
||
169 | ini.WriteString('_Info_', 'GeneratorVer', '1.0'); |
||
170 | ini.WriteString('_Info_', 'Signature', '$ViaThinkSoft$'); |
||
171 | {$REGION 'Excludes'} |
||
172 | // TODO: more excludes |
||
173 | ini.WriteBool('_HelpExclude_', 'about', true); |
||
174 | ini.WriteBool('_HelpExclude_', 'apache', true); |
||
175 | {$ENDREGION} |
||
176 | while true do |
||
177 | begin |
||
178 | Application.ProcessMessages; |
||
179 | |||
180 | p := PosEx('/res/', Test, p+1); |
||
181 | if p = 0 then break; |
||
182 | p2 := PosEx('.html', Test, p); |
||
183 | if p = 0 then break; |
||
184 | candidate := copy(Test, p+5, p2-p-5); |
||
185 | if candidate = '' then continue; |
||
186 | if Length(candidate) > 50 then continue; |
||
187 | good := true; |
||
188 | for i := p+5 to p2-1 do |
||
189 | begin |
||
190 | if ord(test[i]) < 32 then |
||
191 | begin |
||
192 | good := false; |
||
193 | break; |
||
194 | end; |
||
195 | if not (test[i] in ['a'..'z', 'A'..'Z', '.', '-', '_', '0'..'9']) then |
||
196 | begin |
||
197 | ini.WriteInteger('_Errors_', 'Contains unexpected character! ' + candidate, ini.ReadInteger('_Errors_', 'Contains unexpected character! ' + candidate, 0)+1); |
||
198 | good := false; |
||
199 | break; |
||
200 | end; |
||
201 | end; |
||
202 | if good then |
||
203 | begin |
||
204 | candidate2 := LowerCase(StringReplace(candidate, '-', '_', [rfReplaceAll])); |
||
205 | q := LastPos('.', candidate2); |
||
206 | domain := copy(candidate2, 1, q-1); |
||
207 | if domain = '' then continue; |
||
208 | candidate2 := copy(candidate2, q+1, Length(candidate2)-q); |
||
209 | ini.WriteInteger('_Category_', domain, ini.ReadInteger('_Category_', domain, 0)+1); |
||
210 | ini.WriteString(domain, candidate2, '/res/'+candidate+'.html'); |
||
211 | if not ini.ReadBool('_HelpExclude_', domain, false) |
||
212 | and (candidate2 <> 'configuration') |
||
213 | and (candidate2 <> 'constants') |
||
214 | and (candidate2 <> 'installation') |
||
215 | and (candidate2 <> 'requirements') |
||
216 | and (candidate2 <> 'resources') |
||
217 | and (candidate2 <> 'setup') then |
||
218 | begin |
||
219 | if ini.ReadString('_HelpWords_', candidate2, '') <> '' then |
||
220 | begin |
||
221 | ini.WriteInteger('_Conflicts_', candidate2, ini.ReadInteger('_Conflicts_', candidate2, 0)+1); |
||
222 | end; |
||
223 | |||
224 | ini.WriteString('_HelpWords_', candidate2, '/res/'+candidate+'.html'); |
||
225 | end; |
||
226 | end; |
||
227 | end; |
||
228 | |||
229 | sl := TStringList.Create; |
||
230 | sl2 := TStringList.Create; |
||
231 | try |
||
232 | ini.ReadSections(sl); |
||
233 | ini.WriteInteger('_Info_', 'TotalDomains', sl.Count); |
||
234 | symbolCount := 0; |
||
235 | for domain in sl do |
||
236 | begin |
||
237 | ini.ReadSection(domain, sl2); |
||
238 | Inc(symbolCount, sl2.Count) |
||
239 | end; |
||
240 | ini.WriteInteger('_Info_', 'TotalSymbols', symbolCount); |
||
241 | finally |
||
242 | sl.Free; |
||
243 | sl2.Free; |
||
244 | end; |
||
245 | |||
246 | ini.UpdateFile; |
||
247 | result := true; |
||
248 | finally |
||
249 | ini.Free; |
||
250 | end; |
||
251 | end; |
||
252 | |||
253 | procedure BrowseURL(WebBrowser1: TWebBrowser; url: string); |
||
254 | var |
||
255 | BrowserFlags : olevariant; |
||
256 | MyTargetFrameName : olevariant; |
||
257 | MyPostaData : olevariant; |
||
258 | MyHeaders : olevariant; |
||
259 | begin |
||
260 | { Flags: |
||
261 | Constant Value Meaning |
||
262 | NavOpenInNewWindow $01 Open the resource or file in a new window. |
||
263 | NavNoHistory $02 Do not add the resource or file to the history list. The new page replaces the current page in the list. |
||
264 | NavNoReadFromCache $04 Do not read from the disk cache for this navigation. |
||
265 | NavNoWriteToCache $08 Do not write the results of this navigation to the disk cache. |
||
266 | 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. |
||
267 | } |
||
268 | BrowserFlags := $02; |
||
269 | MyTargetFrameName := null; |
||
270 | MyPostaData := null; |
||
271 | MyHeaders := null; |
||
272 | WebBrowser1.Silent := true; // no JavaScript errors |
||
273 | Webbrowser1.Navigate(url, BrowserFlags,MyTargetFrameName,MyPostaData,MyHeaders); |
||
274 | WaitForBrowser(WebBrowser1); |
||
275 | end; |
||
276 | |||
277 | procedure BrowseContent(WebBrowser1: TWebBrowser; html: string); |
||
278 | var |
||
279 | BrowserFlags : olevariant; |
||
280 | MyTargetFrameName : olevariant; |
||
281 | MyPostaData : olevariant; |
||
282 | MyHeaders : olevariant; |
||
283 | Doc: Variant; |
||
284 | begin |
||
285 | { Flags: |
||
286 | Constant Value Meaning |
||
287 | NavOpenInNewWindow $01 Open the resource or file in a new window. |
||
288 | NavNoHistory $02 Do not add the resource or file to the history list. The new page replaces the current page in the list. |
||
289 | NavNoReadFromCache $04 Do not read from the disk cache for this navigation. |
||
290 | NavNoWriteToCache $08 Do not write the results of this navigation to the disk cache. |
||
291 | 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. |
||
292 | } |
||
293 | if WebBrowser1.Document = nil then |
||
294 | begin |
||
295 | BrowserFlags := $02 + $04 + $08 + $10; |
||
296 | MyTargetFrameName := null; |
||
297 | MyPostaData := null; |
||
298 | MyHeaders := null; |
||
299 | Webbrowser1.Navigate('about:blank', BrowserFlags,MyTargetFrameName,MyPostaData,MyHeaders); |
||
300 | WaitForBrowser(WebBrowser1); |
||
301 | end; |
||
302 | |||
303 | Doc := WebBrowser1.Document; |
||
304 | Doc.Clear; |
||
305 | Doc.Write(html); |
||
306 | Doc.Close; |
||
307 | WaitForBrowser(WebBrowser1); |
||
308 | end; |
||
309 | |||
310 | function IsTextHTML(s: string): boolean; |
||
311 | |||
312 | function _Tag(const tag: string): integer; |
||
313 | begin |
||
314 | result := 0; |
||
315 | if (StrIPos('<'+tag+'>', s) > 0) then Inc(result); |
||
316 | if (StrIPos('</'+tag+'>', s) > 0) then Inc(result); |
||
317 | if (StrIPos('<'+tag+' />', s) > 0) then Inc(result); |
||
318 | if (StrIPos('<'+tag+' ', s) > 0) then Inc(result); |
||
319 | end; |
||
320 | |||
321 | var |
||
322 | score: integer; |
||
323 | begin |
||
324 | score := _Tag('html') + _Tag('body') + _Tag('p') + _Tag('a') + _Tag('b') + |
||
325 | _Tag('i') + _Tag('u') + _Tag('li') + _Tag('ol') + _Tag('ul') + |
||
326 | _Tag('img') + _Tag('div') + _Tag('hr') + _Tag('code') + |
||
327 | _Tag('pre') + _Tag('blockquote') + _Tag('span'); |
||
328 | result := score >= 2; |
||
329 | end; |
||
330 | |||
331 | // Template: http://stackoverflow.com/questions/6339446/delphi-get-the-whole-word-where-the-caret-is-in-a-memo |
||
4 | daniel-mar | 332 | function GetWordUnderCaret(AMemo: TSynEdit): string; |
2 | daniel-mar | 333 | |
334 | function ValidChar(c: char): boolean; |
||
335 | begin |
||
336 | result := c in ['a'..'z', 'A'..'Z', '0'..'9', '_']; |
||
337 | end; |
||
338 | |||
339 | var |
||
340 | Line : Integer; |
||
341 | Column : Integer; |
||
342 | LineText: string; |
||
343 | InitPos : Integer; |
||
344 | EndPos : Integer; |
||
345 | begin |
||
346 | //Get the caret position |
||
4 | daniel-mar | 347 | (* |
348 | if AMemo is TMemo then |
||
349 | begin |
||
350 | Line := AMemo.Perform(EM_LINEFROMCHAR,AMemo.SelStart, 0); |
||
351 | Column := AMemo.SelStart - AMemo.Perform(EM_LINEINDEX, Line, 0); |
||
352 | end; |
||
353 | if AMemo is TSynEdit then |
||
354 | begin |
||
5 | daniel-mar | 355 | *) |
4 | daniel-mar | 356 | Line := AMemo.CaretY-1; |
357 | Column := AMemo.CaretX-1; |
||
5 | daniel-mar | 358 | (* |
4 | daniel-mar | 359 | end; |
5 | daniel-mar | 360 | *) |
4 | daniel-mar | 361 | |
2 | daniel-mar | 362 | //Validate the line number |
363 | if AMemo.Lines.Count-1 < Line then Exit; |
||
364 | |||
365 | //Get the text of the line |
||
366 | LineText := AMemo.Lines[Line]; |
||
367 | |||
5 | daniel-mar | 368 | if LineText = '' then exit(''); |
369 | |||
2 | daniel-mar | 370 | // Column zeigt auf das Zeichen LINKS vom Cursor! |
371 | |||
372 | InitPos := Column; |
||
373 | if not ValidChar(LineText[InitPos]) then Inc(InitPos); |
||
374 | while (InitPos-1 >= 1) and ValidChar(LineText[InitPos-1]) do Dec(InitPos); |
||
375 | |||
376 | EndPos := Column; |
||
377 | while (EndPos+1 <= Length(LineText)) and ValidChar(LineText[EndPos+1]) do Inc(EndPos); |
||
378 | |||
379 | //Get the text |
||
380 | Result := Copy(LineText, InitPos, EndPos - InitPos + 1); |
||
381 | end; |
||
382 | |||
383 | function IsValidPHPExe(const exeFile: string): boolean; |
||
384 | var |
||
385 | cont: string; |
||
386 | begin |
||
387 | cont := LoadFileToStr(exeFile); |
||
388 | result := (Pos('php://stdout', cont) >= 0) or |
||
389 | (Pos('PHP_SELF', cont) >= 0); |
||
390 | end; |
||
391 | |||
392 | end. |