unit NATIVE_File_stream;

interface uses 
{$IFDEF LINUX}{$ELSE}
	Windows,
{$ENDIF}
	Classes, SysUtils, AL4
	;
	
{$I AL4_options.inc}

threadvar All_streams: TList;

function Double_to_int64(d: Double): Int64;

implementation

{$IFDEF _D5orHigher}
	{$DEFINE modern_code}
{$ENDIF}
{$IFDEF FPC}
	{$DEFINE modern_code}
{$ENDIF}

function Double_to_int64(d: Double): Int64;
{$IFDEF modern_code}
var s: String;
    i: Integer;
{$ELSE}
var neg: Boolean;
{$ENDIF}
begin
	{$IFDEF modern_code}
	    s := Format('%.0f', [d]);
	    i := pos('.', s);
	    if i <= 0 then i := pos(',', s);
	    if i > 0 then s := Copy(s, 1, i-1);
	    Result := StrToInt64(s);
    {$ELSE}
    	neg := d < 0;
    	if neg then d := -d; 
    	Result.Hi := Trunc( d / 4294967296.0 );
    	Result.Lo := Trunc( d - Result.Hi * 4294967296.0);
    	if neg then
    	begin
    		Result.Lo := -Result.Lo;
    		Result.Hi := -Result.Hi;
    	end;  
    {$ENDIF}
end;

(*
/*

CLASS {NATIVE_File_stream|_Delphi_VCL_FPC},
	BYTES, NATIVE, UNTESTED,
ABSTRACT :

//NATIVE: "{$IFNDEF FPC}{$DEFINE USE_FirstByte}{$ENDIF}" .
NATIVE: "{$DEFINE USE_FirstByte}" .

NATIVE: "///COPY NATIVE_File_stream.pas" .

NATIVE: @
"{$IFNDEF LINUX}"
"function GetFileSizeEx(Handle: THandle; var Size: Int64): Boolean; stdcall;"
"  external 'kernel32.dll' name 'GetFileSizeEx';" 
"{$ENDIF}" .

CONST STR :
    NATIVE_File_stream_import = @
    "uses {$IFNDEF LINUX} "
    "		Windows,"
    " 	  {$ENDIF} NATIVE_File_stream"
    
	NATIVE_All_streams = ""
    
    NATIVE_File_stream_open = @
    "var h, i, mf, share: Integer;"
    " try"
    "    if All_streams = nil then "
    "		All_streams := TList.Create;"
    "    if All_streams.Count = 0 then"
    "       All_streams.Add(nil);"
    "    h := -1;"
    "    for i := 1 to All_streams.Count-1 do"
    "        if All_streams[i] = nil then begin"
    "           h := i; break;"
    "        end;"
    "    if (h <= 0) then begin"
    "       h := All_streams.Count;"
    "       All_streams.Add(nil);"
    "    end;"
    "    mf := fmOpenRead or fmShareDenyWrite;"
    "	 share := fmShareDenyWrite;"     
    "    case X_Mode of"
    "       1: mf := fmCreate;"
    "       2: mf := fmOpenReadWrite;"
    "       3: begin mf := fmOpenRead; share := fmShareDenyNone; end;"
    "       4: begin mf := fmOpenReadWrite; share := fmShareDenyNone; end;"
    "    end;"
    "    if not FileExists({$IFDEF FPC}Str_X_Path{$ELSE}X_Path{$ENDIF}) "
    "		and ((mf and fmOpenRead) = 0) then"
    "       mf := fmCreate;"
    "    try"
    "        All_streams[h] := TFileStream.Create("
    "           {$IFDEF FPC}Str_X_Path{$ELSE}X_Path{$ENDIF}, mf or share );"
    "    except on E: Exception do"
    "				begin"
    "					Any_exception(E);"
    "					All_streams[h] := nil;"     
    "					h := 0;"
    "				end;"     
    "    end;"
    "    Result := h;"
    "  except"
    "  end;"
    
    NATIVE_File_stream_destroy = @
    "    if (X_Handle < 1) or "
    "       (X_Handle >= All_streams.Count) or"
    "       (All_streams[X_Handle] = nil) then Exit;"
    "    All_streams[X_Handle] := nil;"
    
    NATIVE_File_stream_size = @
    "var sz: Int64;"
    "    if (All_streams = nil) or (X_Handle < 1) or "
    "       (X_Handle >= All_streams.Count) or"
    "       (All_streams[X_Handle] = nil) then Exit;"
    "	 sz := TStream(All_streams[X_Handle]).Size;"     
    "    X_lo_hi.SetIntegers(0, sz);"
    "    X_lo_hi.SetIntegers(1, sz shr 32);"
    
    NATIVE_File_stream_set_size = @
    "var sz: Int64;"
    "    if (All_streams = nil) or (X_Handle < 1) or "
    "       (X_Handle >= All_streams.Count) or"
    "       (All_streams[X_Handle] = nil) then Exit;"
    "	 sz := X_lo_hi.GetIntegers(0);"     
    "	 sz := sz or (Int64(X_lo_hi.GetIntegers(1)) shl 32);"     
    "	 TFileStream(All_streams[X_Handle]).Size := (sz);"
    
    NATIVE_File_stream_position = @
    "var p: Int64;"
    "    if (All_streams = nil) or (X_Handle < 1) or "
    "       (X_Handle >= All_streams.Count) or"
    "       (All_streams[X_Handle] = nil) then Exit;"
    "    p := TStream(All_streams[X_Handle]).Position;"
    "	 X_lo_hi.SetIntegers(0, p);"     
    "	 X_lo_hi.SetIntegers(1, p shr 32);"     
    
    NATIVE_File_stream_set_pos = @
    "var To_pos: {$IFDEF _D5orHigher} Int64 {$ELSE} Double {$ENDIF} ;"
    "var Size64: {$IFDEF _D5orHigher} Int64 {$ELSE} Double {$ENDIF};"
    "var fs: TFileStream;"
    "    if (All_streams = nil) or (X_Handle < 1) or "
    "       (X_Handle >= All_streams.Count) or"
    "       (All_streams[X_Handle] = nil) then Exit;"
    "    fs := TFileStream(All_streams[X_Handle]);"
    "    if fs.Position > fs.Size then"
    "       fs.Size := fs.Position;"
    "    To_pos := X_New_lo "
    "		{$IFDEF FPC}"
    "		  or (Int64(X_New_hi) shl 32);"
    "		{$ELSE}"     
    "		  {$IFDEF _D4orHigher}"     
    "		  or (Int64(X_New_hi) shl 32);"
    "		  {$ELSE}"
    "		  + X_New_hi * 4294967296.0;"     
    "		  {$ENDIF}"
    "		{$ENDIF}"     
    "    case X_Disp of" 
    "       1: To_pos := To_pos + fs.Position;"
    "       2: To_pos := fs.Size + To_pos;"
    "    end;"
    "    if To_pos < 0 then To_pos := 0;"
    "	 {$IFDEF _D5orHigher}"     
    "    Size64 := Double_to_int64(fs.Size);"
    "	 {$ELSE}"     
    "    Size64 := fs.Size;"
    "	 {$ENDIF}"     
    "    if  To_pos > Size64 then To_pos := Size64;"
    "    fs.Seek({$IFnDEF _D5orHigher} Trunc {$ENDIF} (To_pos),"
    "		soFromBeginning );"
    
    NATIVE_File_stream_close = @
    "    if (All_streams = nil) or (X_Handle < 1) or "
    "       (X_Handle >= All_streams.Count) or"
    "       (All_streams[X_Handle] = nil) then Exit;"
    "    TFileStream(All_streams[X_Handle]).Free;"
    "    All_streams[X_Handle] := nil;"
    
    NATIVE_File_stream_read_bytes = @
    "var s: TStream;"
    "var dest: PByte; {$IFNDEF USE_FirstByte} buf: array of Byte; {$ENDIF}"
    "var count {$IFNDEF USE_FirstByte}, i {$ENDIF}: Integer;"
    "    if (All_streams = nil) or (X_Handle < 1) or "
    "       (X_Handle >= All_streams.Count) "
    "       or (All_streams[X_Handle] = nil) then"
    "       Exit;"
    "    try"
    "        s := TStream(All_streams[X_Handle]);"
    "        count := X_Dest.Count();"
    "		 {$IFDEF USE_FirstByte}"
    "        	dest := X_Dest.FirstByte();"
    "        	Result := s.Read(dest^, count);"
    "		 {$ELSE}"
    "			SetLength(buf, X_Dest.Count());"
    "			Result := s.Read(buf[0], count);"
    "			for i := 0 to count-1 do"
    "				X_Dest.SetBytes(i, buf[i]);"
    "		 {$ENDIF}"
    "    except on E: Exception do Any_exception(E);"
    "    end;"
    
    NATIVE_File_stream_write_bytes = @
    "var i: Integer; {$IFNDEF USE_FirstByte} buf: array of Byte; {$ENDIF}"
    "var st: TFileStream; {$IFNDEF LINUX} sz: Int64; {$ENDIF}"     
    "    if (All_streams = nil) or (X_Handle < 1) or "
    "       (X_Handle >= All_streams.Count) or "
    "       (All_streams[X_Handle] = nil) then Exit;"
    "    try"
    "		st := TFileStream(All_streams[X_Handle]);"     
    "		{$IFDEF LINUX}"
    "		{$ELSE}"     
    "		GetFileSizeEx(st.Handle, sz);"
    "		{$ENDIF}"     
    "		{$IFDEF USE_FirstByte}"
    "        Result := st.Write(X_Source.FirstByte()^, X_Source.Count());"
    "		{$ELSE}"
    "			SetLength(buf, X_Source.Count());"
    "			for i := 0 to High(buf) do"
    "				buf[i] := X_Source.GetBytes(i);"
    "        Result := st.Write(buf[0], Length(buf));"
    "		{$ENDIF}"
    "		{$IFDEF LINUX}"
    "		{$ELSE}"     
    "		if st.Position > sz then begin"
    "		   st.Size := st.Position;"
    "		   SetEndOfFile(st.Handle);"     
    "		end;"
	"		{$ENDIF}"     
    "    except on E: Exception do Any_exception(E);"
    "    end;" 
    .

            
END
*/
*)
end.
