paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 02:59:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

* open html properly on read only file systems, resolves #10015

Browse Source 
git-svn-id: trunk@8975 -
This commit is contained in:
florian 2007-10-28 18:50:10 +00:00
parent c3475dddc0
commit 036744bc16
2 changed files with 6 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
ide/whtml.pas
View File

@ -200,12 +200,16 @@ constructor TDOSTextFile.Init(AFileName: string);
var f: file; var f: file;
linecomplete,hasCR: boolean; linecomplete,hasCR: boolean;
S: string; S: string;
OldFMode : Integer;
begin begin
inherited Init; inherited Init;
if AFileName='' then Fail; if AFileName='' then Fail;
{$I-} {$I-}
Assign(f,AFileName); Assign(f,AFileName);
OldFMode:= FileMode;
FileMode:= 0;
Reset(f,1); Reset(f,1);
FileMode:= OldFMode;
if IOResult<>0 then Fail; if IOResult<>0 then Fail;
DosFileName:=AFileName; DosFileName:=AFileName;
Dispose(Lines,Done); Dispose(Lines,Done);

4
ide/whtmlhlp.pas
View File

@ -867,7 +867,7 @@ begin
exists PM } exists PM }
src:=DirAndNameOf(src)+'.ans'; src:=DirAndNameOf(src)+'.ans';
{$ifdef DEBUG} {$ifdef DEBUG}
DebugMessage(GetFileName,' Trying "'+Src+'"',Line,1); DebugMessage(GetFileName,' Trying "'+Src+'"',Line,1);
{$endif DEBUG} {$endif DEBUG}
if not ExistsFile(src) then if not ExistsFile(src) then
begin begin
@ -1443,7 +1443,7 @@ begin
if Name<>'' then if Name<>'' then
HTMLFile:=New(PDOSTextFile, Init(Name)); HTMLFile:=New(PDOSTextFile, Init(Name));
if (HTMLFile=nil)and (CurFileName<>'') then if (HTMLFile=nil) and (CurFileName<>'') then
begin begin
Name:=CurFileName; Name:=CurFileName;
HTMLFile:=New(PDOSTextFile, Init(Name)); HTMLFile:=New(PDOSTextFile, Init(Name));