unit TxtioRutin;
(*
  *************************************************************************
             Delpi TextFile kezelési rutinok és a strings.savetodile,
             loadfromfile átdefiniálása,
             az eredeti rutinok egyes XP konfiguráciokon nem müködnek.
             ========================================================
  Szerző: Fogler Tibor   http://www.robitbt.hu   foglert@robitbt.hu
  Licensz: GNU/GPL szabad szoftver
  Utolsó modositás: 2007.09.07   Fogler Tibor
  Használata:
    A redetTXTFile hivást közvetlenül a system.assign hivás után kell
    elhelyezni.
    A string.loadfromfile, savetofile és a
    stringlist.loadfromfile, savetofile helyett a értelemszerüen ennek a
    unitnak a megfelelő rutinjait kell használni.
*)
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

Procedure RedefTXTFile(var F : TextFile);
Procedure SaveStringList(SL : TStringList; Filenev : String);
Procedure LoadStringList(SL : TStringList; Filenev : String);
Procedure SaveStrings(SL : TStrings; Filenev : String);
Procedure LoadStrings(SL : TStrings; Filenev : String);


implementation


Function DevOpen(var F : TTextrec):Integer;
var S : String;
    M : word;
    N : Integer;
    FileStream : TFileStream;
begin
  with F do begin
    M := 0;
    if Mode = fmOutput then
          M := fmCreate or fmShareDenyWrite;
    if Mode = fmInput then
          M := fmOpenRead or fmShareDenyWrite;
    if Mode = fmInOut then
          M := fmOpenWrite or fmShareDenyWrite;
    S := copy(Name,1,260);
    if not FileExists(S) then begin
          Mode := fmOutput;
          M := fmCreate or fmShareDenyWrite;
    end;
    N := 0;
    repeat
      Try
        FileStream := TFilestream.create(S,M);
        Move(FileStream, Userdata, sizeof(Pointer));

        // 2007.05.17 - az alábbiak nélkül nem müködik jól az újra kiadott reset
        bufpos := 0; // 2007.05.17
        bufend := 0; // 2007.05.17

        Result := 0;
        N := 11000;
      Except
        //Application.processmessages;
        Result := 32;
        inc(N);
        //sleep(100);
        sleep(10); // 2007.05.17 - 1 századmpásodperc
        //Application.processmessages;
      end;
    until N > 600; // 0.01mp * 600 = 6mp
    Bufpos := 0;
    if Mode = fmInOut then begin
       Filestream.Position :=
         FileStream.seek(0,soFromEnd);
       Mode := fmOutput;
    end;
  end;
end;

Function DevInOut(var F : TTextrec):Integer;
var N : Integer;
    FileStream : TFileStream;
begin
  Move(F.Userdata, FileStream, sizeof(Pointer));
  if F.Mode = fmInput then begin
    Try
      F.BufPos := 0;
      N := FileStream.Read(F.Bufptr^, F.Bufsize);
      F.BufEnd := N;
      Result := 0;
    except
      F.BufEnd := 0;
      Result := 2;
    End;
  end else begin
    with F do begin
      Try
        FileStream.Write(BufPtr^, BufPos);
        Bufpos := 0;
        Result := 0;
      Except
        Result := 32;
      End;
    end;
  end;
end;

Function DevFlush(var F : TTextrec):Integer;
var  FileStream : TFileStream;
begin
  Move(F.Userdata, FileStream, sizeof(Pointer));
  with F do begin
    Try
      FileStream.Write(BufPtr^, BufPos);
      Bufpos := 0;
      Result := 0;
    Except
      Result := 32;
    End;
  end;
end;

Function DevClose(var F : TTextrec):Integer;
var FileStream : TFileStream;
begin
  Move(F.Userdata, FileStream, sizeof(Pointer));
  Try
    FileStream.Free;
    Result := 0;
  Except
    Result := 32;
  End;
end;

Procedure RedefTXTFile(var F : TextFile);
begin
  if (not fileexists('noredeftxtfile.ini')) then
    with TTextRec(F) do begin
      Mode := fmClosed;
      BufSize := sizeof(Buffer);
      BufPtr := @Buffer;
      OpenFunc := @DevOpen;
      InOutFunc := @DevInOut;
      FlushFunc := @DevFlush;
      CloseFunc := @DevClose;
    end;
end;

Procedure SaveStringList(SL : TStringList; Filenev : String);
var i : Integer;
    S : String;
    F : TFileStream;
    P : ^char;
begin
  F := TFilestream.create(Filenev, fmCreate or fmShareDenyWrite);
  for i := 0 to SL.count - 1 do begin
    S := SL[i] + #13#10;
    P := addr(S[1]);
    F.write(P^, Length(S));
  end;
  F.Free;
end;

Procedure LoadStringList(SL : TStringList; Filenev : String);
var S : String;
    TF : TextFile;
begin
  SL.clear;
  if FileExists(Filenev) then begin
     system.assign(TF, Filenev);
     RedefTXTFile(TF);
     system.reset(TF);
     while not system.eof(TF) do begin
       system.readLn(TF,S);
       SL.add(S);
     end;
     system.close(TF);
  end;
end;

Procedure SaveStrings(SL : TStrings; Filenev : String);
var i : Integer;
    S : String;
    F : TFileStream;
    P : ^char;
begin
  F := TFilestream.create(Filenev, fmCreate or fmShareDenyWrite);
  for i := 0 to SL.count - 1 do begin
    S := SL[i] + #13#10;
    P := addr(S[1]);
    F.write(P^, Length(S));
  end;
  F.Free;
end;

Procedure LoadStrings(SL : TStrings; Filenev : String);
var S : String;
    TF : TextFile;
begin
  SL.clear;
  if FileExists(Filenev) then begin
     system.assign(TF, Filenev);
     RedefTXTFile(TF);
     system.reset(TF);
     while not system.eof(TF) do begin
       system.readLn(TF,S);
       SL.add(S);
     end;
     system.close(TF);
  end;
end;


end.