Compare commits

..

No commits in common. "master" and "v2.4-rc06" have entirely different histories.

11 changed files with 447 additions and 643 deletions

View File

@ -1,9 +1,3 @@
# Obsolete
This is the repository of the old HFS.
I'm working on HFS 3 on another repository. Check it out!
https://github.com/rejetto/hfs
## Introduction ## Introduction
You can use HFS (HTTP File Server) to send and receive files. You can use HFS (HTTP File Server) to send and receive files.
It's different from classic file sharing because it uses web technology. It's different from classic file sharing because it uses web technology.
@ -15,10 +9,6 @@ The virtual file system will allow you to easily share even one single file.
Initially developed in 2002 with Delphi 6, now with Delphi 10.3.3 (Community Edition). Initially developed in 2002 with Delphi 6, now with Delphi 10.3.3 (Community Edition).
Icons are generated at http://fontello.com/ . Use fontello.json for further modifications. Icons are generated at http://fontello.com/ . Use fontello.json for further modifications.
For the default template we are targeting compatibility with Chrome 49 as it's the latest version running on Windows XP.
Warning: Delphi Community Edition 10.4 removed support for command-line compilation, and is thus unable to compile JEDI Code Library, and is thus unable to compile HFS2, ref [Community Edition no longer includes the command-line compilers](https://blogs.embarcadero.com/delphi-cbuilder-community-editions-now-available-in-version-10-4-2/#comment-1339) - meaning the last version of Community Edition cabale of compiling HFS2 is Delphi 10.3.x
## Libs used ## Libs used
- [ICS v8.64](http://www.overbyte.be) by François PIETTE - [ICS v8.64](http://www.overbyte.be) by François PIETTE
- [TRegExpr v0.952b](https://github.com/andgineer/TRegExpr/releases) by Andrey V. Sorokin - [TRegExpr v0.952b](https://github.com/andgineer/TRegExpr/releases) by Andrey V. Sorokin

View File

@ -99,7 +99,6 @@ type
constructor create; constructor create;
destructor Destroy; override; destructor Destroy; override;
function addFile(src:string; dst:string=''; data:Tobject=NIL):boolean; virtual; function addFile(src:string; dst:string=''; data:Tobject=NIL):boolean; virtual;
function contains(src:string):boolean;
function count():integer; function count():integer;
procedure reset(); virtual; procedure reset(); virtual;
property totalSize:int64 read getTotal; property totalSize:int64 read getTotal;
@ -525,16 +524,6 @@ if cachedTotal < 0 then calculate();
result:=cachedTotal; result:=cachedTotal;
end; // getTotal end; // getTotal
function TarchiveStream.contains(src:string):boolean;
var
i: integer;
begin
for i:=0 to Length(flist)-1 do
if flist[i].src = src then
exit(TRUE);
result:=FALSE;
end;
function TarchiveStream.addFile(src:string; dst:string=''; data:Tobject=NIL):boolean; function TarchiveStream.addFile(src:string; dst:string=''; data:Tobject=NIL):boolean;
function getMtime(fh:Thandle):int64; function getMtime(fh:Thandle):int64;
@ -1138,7 +1127,7 @@ var
ss: TStringDynArray; ss: TStringDynArray;
s, si: string; s, si: string;
till: pchar; till: pchar;
append, prepend, add: boolean; append: boolean;
sect, from: PtplSection; sect, from: PtplSection;
begin begin
till:=pred(bos); till:=pred(bos);
@ -1154,10 +1143,8 @@ var
if not parseFlagsAndAcceptSection(ss) then if not parseFlagsAndAcceptSection(ss) then
exit; exit;
prepend:=startsStr('^', cur_section); append:=ansiStartsStr('+', cur_section);
append:=startsStr('+', cur_section); if append then
add:=prepend or append;
if add then
delete(cur_section,1,1); delete(cur_section,1,1);
// there may be several section names separated by = // there may be several section names separated by =
@ -1173,19 +1160,16 @@ var
from:=NIL; from:=NIL;
if sect = NIL then // not found if sect = NIL then // not found
begin begin
if add then if append then
from:=getSection(s); from:=getSection(s);
sect:=newSection(s); sect:=newSection(s);
end end
else else
if add then if append then
from:=sect; from:=sect;
if from<>NIL then if from<>NIL then
begin // inherit from it begin // inherit from it
if append then sect.txt:=from.txt+base.txt;
sect.txt:=from.txt+base.txt
else
sect.txt:=base.txt+CRLF+from.txt;
sect.nolog:=from.nolog or base.nolog; sect.nolog:=from.nolog or base.nolog;
sect.public:=from.public or base.public; sect.public:=from.public or base.public;
sect.noList:=from.noList or base.noList; sect.noList:=from.noList or base.noList;

File diff suppressed because it is too large Load Diff

View File

@ -206,10 +206,9 @@
</Platforms> </Platforms>
<ModelSupport>False</ModelSupport> <ModelSupport>False</ModelSupport>
<Deployment Version="3"> <Deployment Version="3">
<DeployFile LocalName="hfs.dpr" Configuration="Release" Class="ProjectFile"> <DeployFile LocalName="hfs.exe" Configuration="Release" Class="ProjectOutput">
<Platform Name="Win32"> <Platform Name="Win32">
<RemoteDir>.\</RemoteDir> <RemoteName>hfs.exe</RemoteName>
<Enabled>false</Enabled>
<Overwrite>true</Overwrite> <Overwrite>true</Overwrite>
</Platform> </Platform>
</DeployFile> </DeployFile>
@ -219,18 +218,19 @@
<Overwrite>true</Overwrite> <Overwrite>true</Overwrite>
</Platform> </Platform>
</DeployFile> </DeployFile>
<DeployFile LocalName="hfs.exe" Configuration="Release" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>hfs.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="hfs.dpr" Configuration="Debug" Class="ProjectFile"> <DeployFile LocalName="hfs.dpr" Configuration="Debug" Class="ProjectFile">
<Platform Name="Win32"> <Platform Name="Win32">
<RemoteDir>.\</RemoteDir> <RemoteDir>.\</RemoteDir>
<Overwrite>true</Overwrite> <Overwrite>true</Overwrite>
</Platform> </Platform>
</DeployFile> </DeployFile>
<DeployFile LocalName="hfs.dpr" Configuration="Release" Class="ProjectFile">
<Platform Name="Win32">
<RemoteDir>.\</RemoteDir>
<Enabled>false</Enabled>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols"> <DeployClass Name="AdditionalDebugSymbols">
<Platform Name="OSX32"> <Platform Name="OSX32">
<Operation>1</Operation> <Operation>1</Operation>

View File

@ -1,5 +1,5 @@
; Kryvich's Delphi Localizer Language File. ; Kryvich's Delphi Localizer Language File.
; Generated by K.D.L. Scanner, 02/08/2020 18:30:32 ; Generated by K.D.L. Scanner, 28/06/2020 20:30:07
Humanize=1 Humanize=1
HumanizedCR=\^ HumanizedCR=\^
@ -282,6 +282,7 @@ menu.Debug1.dumpTrafficChk.Caption=Dump traffic
menu.Debug1.Showcustomizedoptions1.Caption=Show customized options... menu.Debug1.Showcustomizedoptions1.Caption=Show customized options...
menu.Debug1.highSpeedChk.Caption=Experimental high speed handling menu.Debug1.highSpeedChk.Caption=Experimental high speed handling
menu.Debug1.macrosLogChk.Caption=Enable macros.log menu.Debug1.macrosLogChk.Caption=Enable macros.log
menu.Debug1.Appendmacroslog1.Caption=Append macros.log
menu.Debug1.Runscript1.Caption=Run script... menu.Debug1.Runscript1.Caption=Run script...
menu.Debug1.showMemUsageChk.Caption=Show memory usage menu.Debug1.showMemUsageChk.Caption=Show memory usage
menu.Debug1.noContentdispositionChk.Caption=No Content-disposition menu.Debug1.noContentdispositionChk.Caption=No Content-disposition

View File

@ -1599,7 +1599,7 @@ end; // initInputStream
function ThttpConn.sendNextChunk(max:integer=MAXINT):integer; function ThttpConn.sendNextChunk(max:integer=MAXINT):integer;
var var
n, toSend: int64; n: int64;
buf: ansistring; buf: ansistring;
begin begin
result:=0; result:=0;
@ -1611,8 +1611,7 @@ if (n = 0) or (bytesSentLastItem = 0) then n:=max;
if n > MAXIMUM_CHUNK_SIZE then n:=MAXIMUM_CHUNK_SIZE; if n > MAXIMUM_CHUNK_SIZE then n:=MAXIMUM_CHUNK_SIZE;
if n < MINIMUM_CHUNK_SIZE then n:=MINIMUM_CHUNK_SIZE; if n < MINIMUM_CHUNK_SIZE then n:=MINIMUM_CHUNK_SIZE;
if n > max then n:=max; if n > max then n:=max;
toSend:=bytesToSend; if n > bytesToSend then n:=bytesToSend;
if n > toSend then n:=toSend;
if n = 0 then exit; if n = 0 then exit;
setLength(buf, n); setLength(buf, n);
n:=stream.read(buf[1], n); n:=stream.read(buf[1], n);

View File

@ -2963,6 +2963,10 @@ object mainFrm: TmainFrm
AutoCheck = True AutoCheck = True
Caption = 'Enable macros.log' Caption = 'Enable macros.log'
end end
object Appendmacroslog1: TMenuItem
AutoCheck = True
Caption = 'Append macros.log'
end
object Runscript1: TMenuItem object Runscript1: TMenuItem
Caption = 'Run script...' Caption = 'Run script...'
OnClick = Runscript1Click OnClick = Runscript1Click

View File

@ -35,8 +35,8 @@ uses
HSlib, traylib, monoLib, progFrmLib, classesLib; HSlib, traylib, monoLib, progFrmLib, classesLib;
const const
VERSION = '2.4.0 RC8'; VERSION = '2.4.0 RC6';
VERSION_BUILD = '320'; VERSION_BUILD = '318';
VERSION_STABLE = {$IFDEF STABLE } TRUE {$ELSE} FALSE {$ENDIF}; VERSION_STABLE = {$IFDEF STABLE } TRUE {$ELSE} FALSE {$ENDIF};
CURRENT_VFS_FORMAT :integer = 1; CURRENT_VFS_FORMAT :integer = 1;
CRLF = #13#10; CRLF = #13#10;
@ -671,6 +671,7 @@ type
Speedlimitforsingleaddress1: TMenuItem; Speedlimitforsingleaddress1: TMenuItem;
macrosLogChk: TMenuItem; macrosLogChk: TMenuItem;
Debug1: TMenuItem; Debug1: TMenuItem;
Appendmacroslog1: TMenuItem;
preventStandbyChk: TMenuItem; preventStandbyChk: TMenuItem;
titlePnl: TPanel; titlePnl: TPanel;
HTMLtemplate1: TMenuItem; HTMLtemplate1: TMenuItem;
@ -1382,6 +1383,7 @@ type
constructor TfileListing.create(); constructor TfileListing.create();
begin begin
dir:=NIL; dir:=NIL;
timeout:=Now()+1/MINUTES;
end; // create end; // create
destructor TfileListing.destroy; destructor TfileListing.destroy;
@ -1664,7 +1666,7 @@ this would let us have "=" inside the names, but names cannot be assigned
repeat repeat
application.ProcessMessages(); application.ProcessMessages();
cd.lastActivityTime:=now(); cd.lastActivityTime:=now();
if (timeout > 0) and (cd.lastActivityTime > timeout) then if cd.lastActivityTime > timeout then
break; break;
// we don't list these entries // we don't list these entries
if (sr.name = '.') or (sr.name = '..') if (sr.name = '.') or (sr.name = '..')
@ -3623,11 +3625,13 @@ begin
result:=''; result:='';
if (folder = NIL) or not folder.isFolder() then exit; if (folder = NIL) or not folder.isFolder() then exit;
if macrosLogChk.checked and not appendmacroslog1.checked then
resetLog();
diffTpl:=Ttpl.create(); diffTpl:=Ttpl.create();
folder.lock(); folder.lock();
try try
buildTime:=now(); buildTime:=now();
cd.conn.setHeaderIfNone('Cache-Control: no-cache, no-store, must-revalidate, max-age=-1'); cd.conn.addHeader('Cache-Control: no-cache, no-store, must-revalidate, max-age=-1');
recur:=shouldRecur(cd); recur:=shouldRecur(cd);
baseurl:=protoColon()+getSafeHost(cd)+folder.url(TRUE); baseurl:=protoColon()+getSafeHost(cd)+folder.url(TRUE);
@ -4006,9 +4010,9 @@ if result then
conn.reply.mode:=HRM_NOT_MODIFIED; conn.reply.mode:=HRM_NOT_MODIFIED;
exit; exit;
end; end;
conn.setHeaderIfNone('ETag: '+UTF8encode(etag)); conn.addHeader('ETag: '+UTF8encode(etag));
if ts > '' then if ts > '' then
conn.setHeaderIfNone('Last-Modified: '+UTF8encode(ts)); conn.addHeader('Last-Modified: '+UTF8encode(ts));
end; // notModified end; // notModified
function notModified(conn:ThttpConn; f:string):boolean; overload; function notModified(conn:ThttpConn; f:string):boolean; overload;
@ -4940,7 +4944,7 @@ var
var s:ansistring; var s:ansistring;
begin begin
s:=ansistring(HSlib.encodeURL(data.lastFN)); s:=ansistring(HSlib.encodeURL(data.lastFN));
conn.setHeaderIfNone( ansistring('Content-Disposition: '+if_(attach, 'attachment; ') conn.addHeader( ansistring('Content-Disposition: '+if_(attach, 'attachment; ')
+'filename*=UTF-8'''''+s+'; filename='+s)); +'filename*=UTF-8'''''+s+'; filename='+s));
end; end;
@ -5024,12 +5028,6 @@ var
tar: TtarStream; tar: TtarStream;
nofolders, selection, itsAsearch: boolean; nofolders, selection, itsAsearch: boolean;
procedure addToTar(src,dst:string);
begin
if not selection or not tar.contains(src) then
tar.addFile(src, dst);
end;
procedure addFolder(f:Tfile; ignoreConnFilters:boolean=FALSE); procedure addFolder(f:Tfile; ignoreConnFilters:boolean=FALSE);
var var
i, ofs: integer; i, ofs: integer;
@ -5042,7 +5040,6 @@ var
listing:=TfileListing.create(); listing:=TfileListing.create();
try try
listing.ignoreConnFilter:=ignoreConnFilters; listing.ignoreConnFilter:=ignoreConnFilters;
listing.timeout:= now()+1/MINUTES;
listing.fromFolder( f, data, shouldRecur(data)); listing.fromFolder( f, data, shouldRecur(data));
fIsTemp:=f.isTemp(); fIsTemp:=f.isTemp();
ofs:=length(f.resource)-length(f.name)+1; ofs:=length(f.resource)-length(f.name)+1;
@ -5064,7 +5061,7 @@ var
else else
s:=fi.pathTill(f.parent); // we want the path to include also f, so stop at f.parent s:=fi.pathTill(f.parent); // we want the path to include also f, so stop at f.parent
addToTar(fi.resource, s); tar.addFile(fi.resource, s);
end end
finally listing.free end; finally listing.free end;
end; // addFolder end; // addFolder
@ -5099,7 +5096,7 @@ var
t:=substr(s, lastDelimiter('\/', s)+1) t:=substr(s, lastDelimiter('\/', s)+1)
else else
t:=s; t:=s;
addToTar(ft.resource, t); tar.addFile(ft.resource, t);
finally freeIfTemp(ft) end; finally freeIfTemp(ft) end;
end; end;
end; // addSelection end; // addSelection
@ -5345,29 +5342,6 @@ var
runEventScript('login') runEventScript('login')
end; //urlAuth end; //urlAuth
function thumb():Boolean;
var
b: rawbytestring;
s, e: integer;
begin
if mode <> 'thumb' then
exit(FALSE);
result:=TRUE;
b:=loadFile(f.resource, 0, 96*KILO);
s:= pos(rawbytestring(#$FF#$D8#$FF), b, 2);
if s > 0 then
e:=pos(rawbytestring(#$FF#$D9), b, s);
if (s=0) or (e=0) then
begin
data.conn.reply.mode:=HRM_NOT_FOUND;
exit;
end;
conn.reply.contentType:='image/jpeg';
conn.reply.mode:=HRM_REPLY;
conn.reply.bodyMode:=RBM_STRING;
conn.reply.body:=Copy(b, s, e-s+2);
end;
var var
b: boolean; b: boolean;
s: string; s: string;
@ -5727,9 +5701,6 @@ var
if notModified(conn, f) then // calling notModified before limitsExceededOnDownload makes possible for [download] to manipualate headers set here if notModified(conn, f) then // calling notModified before limitsExceededOnDownload makes possible for [download] to manipualate headers set here
exit; exit;
if thumb() then
Exit;
data.countAsDownload:=f.shouldCountAsDownload(); data.countAsDownload:=f.shouldCountAsDownload();
if data.countAsDownload and limitsExceededOnDownload() then if data.countAsDownload and limitsExceededOnDownload() then
exit; exit;
@ -6014,7 +5985,7 @@ case event of
refreshConn(data); refreshConn(data);
end; end;
HE_POST_VAR: data.postVars.add(conn.post.varname+'='+UTF8toString(conn.post.data)); HE_POST_VAR: data.postVars.add(conn.post.varname+'='+conn.post.data);
HE_POST_VARS: HE_POST_VARS:
if conn.post.mode = PM_URLENCODED then if conn.post.mode = PM_URLENCODED then
urlToStrings(conn.post.data, data.postVars); urlToStrings(conn.post.data, data.postVars);
@ -8118,10 +8089,10 @@ var
if userSocketBuffer > 0 then if userSocketBuffer > 0 then
data.conn.sndBuf:=userSocketBuffer data.conn.sndBuf:=userSocketBuffer
else if highSpeedChk.checked then else
begin begin
size:=minmax(8192, MEGA, round(data.averageSpeed)); size:=minmax(8192, MEGA, round(data.averageSpeed));
if safeDiv(0.0+size, data.conn.sndbuf, 2) > 2 then if highSpeedChk.checked and (safeDiv(0.0+size, data.conn.sndbuf, 2) > 2) then
data.conn.sndBuf:=size; data.conn.sndBuf:=size;
end; end;
end; end;
@ -11900,6 +11871,7 @@ if menu.items.find(logmenu.items.caption) = NIL then
SwitchON1.imageIndex:=if_(srv.active, 11, 4); SwitchON1.imageIndex:=if_(srv.active, 11, 4);
SwitchON1.caption:=if_(srv.active, S_OFF, S_ON); SwitchON1.caption:=if_(srv.active, S_OFF, S_ON);
Appendmacroslog1.Enabled:=macrosLogChk.checked;
stopSpidersChk.Enabled:=not fileExistsByURL('/robots.txt'); stopSpidersChk.Enabled:=not fileExistsByURL('/robots.txt');
Showbandwidthgraph1.visible:=not graphBox.visible; Showbandwidthgraph1.visible:=not graphBox.visible;
if bakShellMenuText='' then if bakShellMenuText='' then
@ -12124,7 +12096,7 @@ tray:=TmyTrayicon.create(self);
DragAcceptFiles(handle, true); DragAcceptFiles(handle, true);
caption:=format('HFS ~ HTTP File Server %s', [VERSION]); caption:=format('HFS ~ HTTP File Server %s', [VERSION]);
application.Title:=format('HFS %s', [VERSION]); application.Title:=format('HFS %s', [VERSION]);
setSpeedLimit(50000); setSpeedLimit(-1);
setSpeedLimitIP(-1); setSpeedLimitIP(-1);
setGraphRate(10); setGraphRate(10);
setMaxConnections(0); setMaxConnections(0);

View File

@ -161,18 +161,16 @@ var
procedure deprecatedMacro(what:string=''; instead:string=''); procedure deprecatedMacro(what:string=''; instead:string='');
begin mainfrm.add2log('WARNING, deprecated macro: '+first(what, name)+nonEmptyConcat(' - Use instead: ',instead), NIL, clRed) end; begin mainfrm.add2log('WARNING, deprecated macro: '+first(what, name)+nonEmptyConcat(' - Use instead: ',instead), NIL, clRed) end;
procedure unsatisfied(b:boolean=TRUE);
begin
if b then
macroError('cannot be used here')
end;
function satisfied(p:pointer):boolean; function satisfied(p:pointer):boolean;
begin begin
result:=assigned(p); result:=assigned(p);
unsatisfied(not result); if not result then
macroError('cannot be used here');
end; end;
procedure unsatisfied(b:boolean=TRUE);
begin if b then macroError('cannot be used here') end;
function parEx(idx:integer; name:string=''; doTrim:boolean=TRUE):string; overload; function parEx(idx:integer; name:string=''; doTrim:boolean=TRUE):string; overload;
var var
i: integer; i: integer;
@ -264,9 +262,9 @@ var
result:=staticVars; result:=staticVars;
delete(varname,1,length(G_VAR_PREFIX)); delete(varname,1,length(G_VAR_PREFIX));
end end
else if assigned(md.cd) then else if satisfied(md.cd) then
result:=md.cd.vars result:=md.cd.vars
else if assigned(md.tempVars) then else if satisfied(md.tempVars) then
result:=md.tempVars result:=md.tempVars
else else
raise Exception.create('no namespace available'); raise Exception.create('no namespace available');
@ -295,7 +293,7 @@ var
if not satisfied(space) then exit; if not satisfied(space) then exit;
i:=space.indexOfName(varname); i:=space.indexOfName(varname);
if i < 0 then if i < 0 then
if value = '' then exit(TRUE) // all is good the way it is if value = '' then exit // all is good the way it is
else i:=space.add(varname+'='+value) else i:=space.add(varname+'='+value)
else else
if value > '' then // in case of empty value, there's no need to assign, because we are going to delete it (after we cleared the bound object) if value > '' then // in case of empty value, there's no need to assign, because we are going to delete it (after we cleared the bound object)

View File

@ -29,13 +29,12 @@ document: {.if|var}
document: {.exec|out|timeout|exitcode.} document: {.exec|out|timeout|exitcode.}
document: [+section] document: [+section]
document: {.set item|diff template.} document: {.set item|diff template.}
document: {.add header|overwrite=0.}
document: {.calc| ][ } document: {.calc| ][ }
document: single line diff templates (file path) document: single line diff templates (file path)
document: {.disconnection reason|if=XXX.} document: {.disconnection reason|if=XXX.}
document: %url% document: %url%
document: commands returning white space: add folder, save, set account, exec, mkdir, chdir, delete, rename, move copy, set document: commands returning white space: add folder, save, set account, exec, mkdir, chdir, delete, rename, move copy, set
document: pipe, base64, base64decode, dir, disk free, filetime, file changed, load tpl, sha256, for line document: base64, base64decode, dir, disk free, filetime, file changed, load tpl, sha256, for line
document {.convert|macros|dec|hex.} document {.convert|macros|dec|hex.}
document: new event [login] document: new event [login]
+ event to filter logging http://www.rejetto.com/forum/index.php/topic,9784.0.html + event to filter logging http://www.rejetto.com/forum/index.php/topic,9784.0.html

View File

@ -2220,7 +2220,7 @@ const
var var
sa : TSecurityAttributes; sa : TSecurityAttributes;
ReadPipe,WritePipe : THandle; ReadPipe,WritePipe : THandle;
start : TStartUpInfoW; start : TStartUpInfoA;
ProcessInfo : TProcessInformation; ProcessInfo : TProcessInformation;
Buffer : Pansichar; Buffer : Pansichar;
TotalBytesRead, TotalBytesRead,
@ -2251,7 +2251,7 @@ else
timeout:=now()+timeout/SECONDS; timeout:=now()+timeout/SECONDS;
// Create a Console Child Process with redirected input and output // Create a Console Child Process with redirected input and output
try try
if CreateProcess(nil, PChar(dosApp), @sa, @sa, true, CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then if CreateProcessA(nil, PansiChar(ansistring(DosApp)), @sa, @sa, true, CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then
repeat repeat
result:=TRUE; result:=TRUE;
// wait for end of child process // wait for end of child process
@ -2261,22 +2261,16 @@ try
// so that the pipe is not blocked by an overflow. New information // so that the pipe is not blocked by an overflow. New information
// can be written from the console app to the pipe only if there is // can be written from the console app to the pipe only if there is
// enough buffer space. // enough buffer space.
if not PeekNamedPipe(ReadPipe, @Buffer[TotalBytesRead], ReadBuffer, @BytesRead, @TotalBytesAvail, @BytesLeftThisMessage ) if not PeekNamedPipe(ReadPipe, @Buffer[TotalBytesRead], ReadBuffer,
or (BytesRead > 0) and not ReadFile(ReadPipe, Buffer[TotalBytesRead], BytesRead, BytesRead, nil ) then @BytesRead, @TotalBytesAvail, @BytesLeftThisMessage ) then
break; break
else if BytesRead > 0 then
ReadFile(ReadPipe, Buffer[TotalBytesRead], BytesRead, BytesRead, nil );
inc(TotalBytesRead, BytesRead); inc(TotalBytesRead, BytesRead);
until (Apprunning <> WAIT_TIMEOUT) or (now() >= timeout); until (Apprunning <> WAIT_TIMEOUT) or (now() >= timeout);
if IsTextUnicode(Buffer, TotalBytesRead, NIL) then
begin
Pchar(@Buffer[TotalBytesRead])^:= #0;
output:=pchar(Buffer)
end
else
begin
Buffer[TotalBytesRead]:= #0; Buffer[TotalBytesRead]:= #0;
OemToCharA(Buffer,Buffer); OemToCharA(PansiChar(Buffer),Buffer);
output:=string(ansistrings.strPas(Buffer)); output:=string(ansistrings.strPas(Buffer));
end;
finally finally
GetExitCodeProcess(ProcessInfo.hProcess, exitcode); GetExitCodeProcess(ProcessInfo.hProcess, exitcode);
TerminateProcess(ProcessInfo.hProcess, 0); TerminateProcess(ProcessInfo.hProcess, 0);