Merge pull request #41 from divinity76/patch-1

warning about Delphi 10.4 Community being incompatible

README.md

@@ -1,3 +1,9 @@
+# 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
 You can use HFS (HTTP File Server) to send and receive files.
 It's different from classic file sharing because it uses web technology.
@@ -9,6 +15,10 @@ 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).
 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
 - [ICS v8.64](http://www.overbyte.be) by François PIETTE 
 - [TRegExpr v0.952b](https://github.com/andgineer/TRegExpr/releases) by Andrey V. Sorokin

classesLib.pas

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

hfs.dproj

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

hfs.lng

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

hslib.pas

@@ -104,7 +104,7 @@ type
     );
     body: ansistring;    // specifies reply body according to bodyMode
     bodyFile: string;
-    bodyStream: Tstream;   // note: the stream is automatically freed 
+    bodyStream: Tstream;   // note: the stream is automatically freed
     firstByte, lastByte: int64;  // body interval for partial replies (206)
     realm,           // this will appear in the authentication dialog
     reason,         // customized reason phrase
@@ -423,7 +423,7 @@ begin
   repeat
   result:=posEx(ss, s, ofs);
   if result = 0 then exit;
-  
+
     repeat
     qpos:=posEx(quote, s, ofs);
     if qpos = 0 then exit; // there's no quoting, our result will fit
@@ -1599,7 +1599,7 @@ end; // initInputStream
 
 function ThttpConn.sendNextChunk(max:integer=MAXINT):integer;
 var
-  n: int64;
+  n, toSend: int64;
   buf: ansistring;
 begin
 result:=0;
@@ -1611,7 +1611,8 @@ if (n = 0) or (bytesSentLastItem = 0) then n:=max;
 if n > MAXIMUM_CHUNK_SIZE then n:=MAXIMUM_CHUNK_SIZE;
 if n < MINIMUM_CHUNK_SIZE then n:=MINIMUM_CHUNK_SIZE;
 if n > max then n:=max;
-if n > bytesToSend then n:=bytesToSend;
+toSend:=bytesToSend;
+if n > toSend then n:=toSend;
 if n = 0 then exit;
 setLength(buf, n);
 n:=stream.read(buf[1], n);

main.dfm

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

main.pas

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

scriptLib.pas

@@ -161,16 +161,18 @@ var
   procedure deprecatedMacro(what:string=''; instead:string='');
   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;
   begin
   result:=assigned(p);
-  if not result then
+  unsatisfied(not result);
-    macroError('cannot be used here');
   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;
   var
     i: integer;
@@ -262,9 +264,9 @@ var
     result:=staticVars;
     delete(varname,1,length(G_VAR_PREFIX));
     end
-  else if satisfied(md.cd) then
+  else if assigned(md.cd) then
     result:=md.cd.vars
-  else if satisfied(md.tempVars) then
+  else if assigned(md.tempVars) then
     result:=md.tempVars
   else
     raise Exception.create('no namespace available');
@@ -293,7 +295,7 @@ var
   if not satisfied(space) then exit;
   i:=space.indexOfName(varname);
   if i < 0 then
-    if value = '' then exit // all is good the way it is
+    if value = '' then exit(TRUE) // all is good the way it is
     else i:=space.add(varname+'='+value)
   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)

todo.txt

@@ -29,12 +29,13 @@ document: {.if|var}
 document: {.exec|out|timeout|exitcode.}
 document: [+section]
 document: {.set item|diff template.}
+document: {.add header|overwrite=0.}
 document: {.calc| ][ }
 document: single line diff templates (file path)
 document: {.disconnection reason|if=XXX.}
 document: %url%
 document: commands returning white space: add folder, save, set account, exec, mkdir, chdir, delete, rename, move copy, set
-document: base64, base64decode, dir, disk free, filetime, file changed, load tpl, sha256, for line
+document: pipe, base64, base64decode, dir, disk free, filetime, file changed, load tpl, sha256, for line
 document {.convert|macros|dec|hex.}
 document: new event [login]
 + event to filter logging http://www.rejetto.com/forum/index.php/topic,9784.0.html
@@ -92,12 +93,12 @@ document: new event [login]
 + an updated hint on virtual folders, to explain how to get upload working
 - requesting a non-existant file inside an unauthorized folder, apache replies 401, hfs 404. try to comply.
 + make %list% available in every page
-+ support for ALT+F4 with option "Minimize to tray clicking the close button" www.rejetto.com/forum/?topic=6351 
++ support for ALT+F4 with option "Minimize to tray clicking the close button" www.rejetto.com/forum/?topic=6351
 + replace and delete icons http://www.rejetto.com/forum/index.php?topic=6317.msg1038157#msg1038157
 ? currently the delete permission is only inside a folder. you can't mark a file or delete the marked folder. is this ok?
-+ when a link is protected (no access for this user) it may be displayed as a link to the %item-name%, then 401, and if login is successful provide a redirection 
++ when a link is protected (no access for this user) it may be displayed as a link to the %item-name%, then 401, and if login is successful provide a redirection
-+ change folder/link/generic-file icons (via GUI, without editing the template) 
++ change folder/link/generic-file icons (via GUI, without editing the template)
-+ a way to get bigger icons (client side) 
++ a way to get bigger icons (client side)
 + be able to produce rss http://www.rejetto.com/forum/index.php?topic=5846.msg1035481#msg1035481
 * better warning message http://www.rejetto.com/forum/index.php?topic=5795.msg1034406#msg1034406
 ? on the fly files compression www.rejetto.com/forum/?topic=5492
@@ -105,7 +106,7 @@ document: new event [login]
 ? auto-removing folders www.rejetto.com/forum/?topic=3149
 + last-access-time for files www.rejetto.com/forum/?topic=5266
 + expiration time for account www.rejetto.com/forum/?topic=5409
-+ warn the user if there's no useful IP address http://www.rejetto.com/forum/index.php?topic=3193.msg1031371#msg1031371  
++ warn the user if there's no useful IP address http://www.rejetto.com/forum/index.php?topic=3193.msg1031371#msg1031371
 + GUI suggestions www.rejetto.com/forum/?topic=5334
 + {.cookie.} http://www.rejetto.com/forum/index.php?topic=5349.0
 + restrict access to -> ip mask www.rejetto.com/forum/?topic=5244
@@ -126,37 +127,37 @@ document: new event [login]
 + per-folder no-limit
 + windows auth (NLTM? seems to be available in ICS) www.rejetto.com/forum/?topic=3762
 + more stats www.rejetto.com/forum/?topic=4968
-+ to disable single ban rules 
++ to disable single ban rules
 + ban by hostname
 + edit comments for real folders www.rejetto.com/forum/?topic=4667
 + a way to pass ini commands through the command line
 + create folders via command line www.rejetto.com/forum/?topic=3955
 ? support mp3ToIon www.rejetto.com/forum/?topic=4600
 + download only for <account-list>
-+ account: see all transfers in ~progress http://www.rejetto.com/forum/index.php/topic,9325.msg1053416/topicseen.html#msg1053416 
++ account: see all transfers in ~progress http://www.rejetto.com/forum/index.php/topic,9325.msg1053416/topicseen.html#msg1053416
 + limit account to a host mask
 + tray icons for uploads
 + MAC filter
 + if robots.txt does not exist, an option "don't be listed on search engines"
 + menu -> limits -> temporarily disable all limits
 + menu -> limits -> max speed for each address
-+ option to display counter for folders as number of accesses instead of total access to files in it   
++ option to display counter for folders as number of accesses instead of total access to files in it
-+ autodisabling accounts www.rejetto.com/forum/?topic=5379 
++ autodisabling accounts www.rejetto.com/forum/?topic=5379
 + on update, propose a link to the "what's new" page
 + add special folder (expert mode): let you specify a special folder, like documents, or manually enter a path (useful for relative paths), or GUID
 + logs rotation (hfs always append)
-+ double address bar, one for LAN and one for the Internet   
++ double address bar, one for LAN and one for the Internet
 + per user diff-tpl (apply both folder and user diff-tpl.s, and let the user decide priority, default:user,folder)
 + "Folder image mask", a file mask indicating the external file that should be used as icon (~img_folder)
 + to be able to add icons from multi-icon files (like shell32.dll)
 + installer (saving to registry, and making ini-file the new default, don't ask for shell menu)
-+ support unicode filenames (FindFirstFileW. Cannot be done because widgets don't support unicode) 
++ support unicode filenames (FindFirstFileW. Cannot be done because widgets don't support unicode)
 * show "(home)" instead of "/" in VFS
 + show updateinfo notice also in autocheck
 + top 10 downloaded files
 + after the self test fails, and a router problem is detected, prompt a wizard for portforwad.com (extract routers list)
 + export vfs map as txt/html
-+ specific message for each disabled account             
++ specific message for each disabled account
 + search for files including meta information (id3 tag) www.rejetto.com/forum/?topic=5312
 + multiupload using flash
 ? support shortcut to folders in real-folders
@@ -184,7 +185,7 @@ document: new event [login]
 * stop using /~commands and move all of them in the standard ?name=value form
 
 VER 3
-+ new kind of folder (no more real/virtual folders) 
++ new kind of folder (no more real/virtual folders)
 
 VER 3.5
 + search for files

utillib.pas

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