この発言に対し以下のコメントが寄せられています

#01409　ぜえた          さん　RE:ファイル以外に Readln, Writelnを使い




　こんにちは、ぜえた です。

ファイルや標準入出力には Readlnや Writelnといった便利なプロシージャが
使えますが、文字列や TStringsオブジェクトには使えません。
しかし、Object Pascalではユーザが独自のテキストファイルデバイスドライ
バを定義できるので、これを利用することによって、どのようなオブジェクト
に対しても Readlnといったプロシージャが利用できるようになります。

ここでは文字列に対しての実装例を示します。Printersユニットにはプリンタ
、「Insade Delphi」(アスキー出版局)には TStringsオブジェクトに対しての
実装が載っています。
詳しくは「Object Pascal言語リファレンス」を参照してください。




//使用例
procedure TForm1.Button1Click(Sender: TObject);
var
  F: TextFile;
  N1, N2, N3: Integer;
begin
  AssignString(F, '  123  456  789');
  Reset(F);
  Read(F, N1, N2, N3);
  CloseFile(F);

  AssignString(F, '');
  Rewrite(F);
  Write(F, N3, N2, N1);
  Caption := GetString(F);
  CloseFile(F);
end;


// StrDev ユニット
unit StrDev;

interface

uses SysUtils;

procedure AssignString(var F: TextFile; const S: string);
function GetString(const F: TextFile): string;

implementation

type
  PUserData = ^TUserData;
  TUserData = record
    TextStr: string;
    StrPos: Integer;
  end;

function GetString(const F: TextFile): string;
begin
  Result := PUserData(@TTextRec(F).UserData)^.TextStr;
end;

function StrIgnore(var F: TTextRec): Integer;
begin
  Result := 0;
end;

function StrIn(var F: TTextRec): Integer;
var
  Len: Integer;
begin
  with F, PUserData(@UserData)^ do begin
    Len := Length(TextStr);
    BufEnd := BufSize;
    if StrPos + BufEnd > Len then
      BufEnd := Len - StrPos;
    Move(TextStr[StrPos+1], BufPtr^, BufEnd);
    Inc(StrPos, BufEnd);
    BufPos := 0;
  end;
  Result := 0;
end;

function StrOut(var F: TTextRec): Integer;
var
  Len: Integer;
begin
  with F, PUserData(@UserData)^ do begin
    Len := Length(TextStr);
    BufEnd := BufPos;
    if StrPos + BufEnd > Len then
      SetLength(TextStr, StrPos + BufEnd);
    Move(BufPtr^, TextStr[StrPos+1], BufEnd);
    Inc(StrPos, BufEnd);
    BufPos := 0;
  end;
  Result := 0;
end;

function StrClose(var F: TTextRec): Integer;
begin
  Finalize(PUserData(@TTextRec(F).UserData)^);
  Result := 0;
end;

function StrOpen(var F: TTextRec): Integer;
begin
  with F, PUserData(@UserData)^ do begin
    BufPos := 0;
    BufEnd := 0;
    case Mode of
      fmInput: begin
        InOutFunc := @StrIn;
        FlushFunc := @StrIgnore;
        CloseFunc := @StrClose;
        StrPos := 0;
      end;
      fmOutput: begin
        InOutFunc := @StrOut;
        FlushFunc := @StrOut;
        CloseFunc := @StrClose;
        StrPos := 0;
      end;
      fmInOut: begin
        Mode := fmOutput;
        InOutFunc := @StrOut;
        FlushFunc := @StrOut;
        CloseFunc := @StrClose;
        StrPos := Length(TextStr);
      end;
    else
      Result := 1;
      Exit;
    end;
  end;
  Result := 0;
end;

procedure AssignString(var F: Text; const S: string);
begin
  FillChar(F, SizeOf(TTextRec), 0);
  with TTextRec(F) do begin
    Handle := -1;
    Mode := fmClosed;
    BufSize := SizeOf(Buffer);
    BufPtr := @Buffer;
    OpenFunc := @StrOpen;
    Initialize(PUserData(@UserData)^);
    PUserData(@UserData)^.TextStr := S;
  end;
end;

end.

                                                    ぜえた (QZC05100)
 


Original document by ぜえた          氏 ID:(QZC05100)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。