The attached patch fixes some problems in IpUtils.pas when running under
linux. This patch do not change any files of my previous patch means
both are needed. The sample now works under linux too.
Jesus Reyes wrote:
--- Armin Diehl <[EMAIL PROTECTED]> escribió:
would be nice if you include this in examples, base path is
lazarus.
This is the same as the sample in examples/helphtml but it uses
ipro as
the viever. Html files are shared with examples/helphtml.
it shows this under linux:
THTMLHelpDatabase.ShowURL A NewNode.URL=file://edit1.html
URLType=file URLPath=edit1.html URLParams=
THTMLHelpDatabase.ShowURL B URL=file://edit1.html URLType=file
URLPath=/home/prog/lazarus/examples/htmlhelp_ipro/../helphtml/html/edit1.html
URLParams=
THTMLHelpViewer.ShowNode:
URL:"file:///home/prog/lazarus/examples/htmlhelp_ipro/../helphtml/html/edit1.html"
ID:"" Context:"0"
TIpCustomHtmlDataProvider.BuildURL Old=""
new="file:///home/prog/lazarus/examples/htmlhelp_ipro/../helphtml/html/edit1.html"
TApplication.HandleException Access violation
Stack trace:
$0823F8C7 TXMLREGISTRY__CREATESUBKEY, line 386 of inc/xmlreg.pp
$0823ED17 TXMLREGISTRY__SETKEY, line 184 of inc/xmlreg.pp
$0823D8E5 TREGISTRY__OPENKEY, line 128 of inc/xregreg.inc
$0822F6DE GETLOCALCONTENT, line 2681 of iputils.pas
$0822A2D1 TIPFILEDATAPROVIDER__CHECKURL, line 308 of
ipfilebroker.pas
$08229D98 TIPCUSTOMHTMLDATAPROVIDER__DOCHECKURL, line 196 of
ipfilebroker.pas
$08224142 TIPHTMLFRAME__OPENRELATIVEURL, line 16428 of iphtml.pas
$08223B18 TIPHTMLFRAME__OPENURL, line 16324 of iphtml.pas
$08227722 TIPHTMLCUSTOMPANEL__INTERNALOPENURL, line 17402 of
iphtml.pas
$0822737B TIPHTMLCUSTOMPANEL__OPENURL, line 17341 of iphtml.pas
$0807A484 THELPVIEWERFORM__SHOWURL, line 143 of
htmlhelp2viewer.pas
$0807A286 THTMLHELPVIEWER__SHOWNODE, line 92 of
htmlhelp2viewer.pas
$081F4A4F THTMLHELPDATABASE__SHOWURL, line 209 of lazhelphtml.pas
$081F4BDE THTMLHELPDATABASE__SHOWHELP, line 222 of
lazhelphtml.pas
$081FABBA THELPDATABASES__SHOWHELPFORNODES, line 1369 of
lazhelpintf.pas
$081FB302 THELPDATABASES__SHOWHELPFORKEYWORD, line 1471 of
lazhelpintf.pas
$081FACC9 THELPDATABASES__SHOWHELPFORQUERY, line 1384 of
lazhelpintf.pas
Jesus Reyes A.
__________________________________________________
Correo Yahoo!
Espacio para todos tus mensajes, antivirus y antispam ¡gratis!
Regístrate ya - http://correo.yahoo.com.mx/
_________________________________________________________________
To unsubscribe: mail [EMAIL PROTECTED] with
"unsubscribe" as the Subject
archives at http://www.lazarus.freepascal.org/mailarchives
Index: iputils.pas
===================================================================
--- iputils.pas (revision 9416)
+++ iputils.pas (working copy)
@@ -42,6 +42,7 @@
LCLIntf,
LMessages,
FileUtil,
+ LCLProc,
{$ELSE}
Messages,
Windows,
@@ -1170,7 +1171,7 @@
for i := 1 to Length(Result) do begin
case Result[i] of
'|': Result[i] := ':';
- '/': Result[i] := '\';
+ '/': Result[i] := DirectorySeparator;
else
{ leave it alone };
end;
@@ -1191,7 +1192,7 @@
for i := 1 to Length(Result) do begin
case Result[i] of
':': Result[i] := '|';
- '\': Result[i] := '/';
+ DirectorySeparator: Result[i] := '/';
else
{ leave it alone };
end;
@@ -1296,6 +1297,7 @@
State : TUrlParseState;
PotAuth, PotPath : string;
SchemeSeen: Boolean;
+ SlashCount: integer;
procedure ProcessChar;
begin
@@ -1374,6 +1376,7 @@
SchemeSeen := True;
PotAuth := '';
State := psSchemeSlashes;
+ SlashCount := 0;
end
else begin
@@ -1427,6 +1430,7 @@
SchemeSeen := True;
PotAuth := '';
State := psSchemeSlashes;
+ SlashCount := 0;
end;
'A'..'Z', 'a'..'z': begin
@@ -1453,10 +1457,12 @@
end;
psSchemeSlashes: begin
+ inc(SlashCount);
+ if (p^ <> '/') or (SlashCount > 2) then
case P^ of
- '/': { ignore };
+ //'/': { ignore };
- '.', '\': begin { start of a local path } {!!.12}
+ '.', '\','/': begin { start of a local path } {!!.12}
PotPath := PotPath + P^; {!!.12}
State := psLocalPath; {!!.12}
end; {!!.12}
@@ -2666,24 +2672,48 @@
{ File/Directory Stuff }
{ Retreive Windows "MIME" type for a particular file extension }
+{$ifndef Windows}
+{define some basic mime types}
+const MimeTypeExt : Array[0..4] of String = ('.htm','.html','.txt','.jpg','.png');
+ MimeTypes : Array[0..4] of String = ('text/html','text/html','text/plain','image/jpeg','image/png');
+{$endif}
+
function GetLocalContent(const TheFileName: string): string;
var
Reg : TRegistry;
Ext : string;
+ {$ifndef Windows}
+ ExtU: string;
+ i : integer;
+ {$endif}
begin
Result := '';
Ext := ExtractFileExt(TheFileName);
-
- Reg := nil;
- try
- Reg := TRegistry.Create;
- Reg.RootKey := HKEY_CLASSES_ROOT;
- if Reg.OpenKey(Ext, True) then
- Result := Reg.ReadString('Content Type');
- finally
- Reg.CloseKey;
- Reg.Free;
+ {$ifndef Windows}
+ ExtU := AnsiLowerCase(Ext);
+ for i := 0 to high(MimeTypeExt) do
+ if MimeTypeExt[i] = ExtU then
+ begin
+ result := MimeTypes[i];
+ break;
+ end;
+ {$endif}
+ if result = '' then
+ begin
+ Reg := nil;
+ try
+ Reg := TRegistry.Create;
+ Reg.RootKey := HKEY_CLASSES_ROOT;
+ if Reg.OpenKey(Ext, False) then
+ Result := Reg.ReadString('Content Type');
+ finally
+ Reg.CloseKey;
+ Reg.Free;
+ end;
end;
+ {$IFDEF IP_LAZARUS}
+ DebugLn('IpUtils.GetLocalContent File:'+TheFileName+' Result:'+result);
+ {$ENDIF}
end;
{ Determine if a directory exists }
