Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Delphi 2009 Handbook

Project: ReaderWriter.dproj

Project Structure

ReaderWriter.dpr
program ReaderWriter;

uses
  Forms,
  ReaderWriter_MainForm in 'ReaderWriter_MainForm.pas' {FormReaderWriter};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFormReaderWriter, FormReaderWriter);
  Application.Run;
end.
ReaderWriter_MainForm.pas
unit ReaderWriter_MainForm;

interface

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

type
  TFormReaderWriter = class(TForm)
    btnWrite: TButton;
    btnRead: TButton;
    btnWriteAndRead: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Memo1: TMemo;
    Label3: TLabel;
    btnXmlCorrect: TButton;
    btnXmlUnbalanced: TButton;
    btnClassic: TButton;
    procedure btnWriteClick(Sender: TObject);
    procedure btnReadClick(Sender: TObject);
    procedure btnWriteAndReadClick(Sender: TObject);
    procedure btnXmlCorrectClick(Sender: TObject);
    procedure btnXmlUnbalancedClick(Sender: TObject);
    procedure btnClassicClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormReaderWriter: TFormReaderWriter;

implementation

{$R *.dfm}

uses
  Generics.Collections;

type
  TTrivialXmlWriter = class
  private
    fWriter: TTextWriter;
    fNodes: TStack<string>;
  public
    constructor Create (aWriter: TTextWriter);
    destructor Destroy; override;
    procedure WriteStartElement (const sName: string);
    procedure WriteEndElement;
    procedure WriteString (const sValue: string);
  end;


procedure TFormReaderWriter.btnWriteAndReadClick(Sender: TObject);
var
  sw: TStringWriter;
  sr: TStringReader;
  theString: string;
begin
  sw := TStringWriter.Create;
  try
    sw.WriteLine ('Hello, world');
    sw.WriteLine ('Have a nice day');
    sw.WriteLine (Left);
    theString := sw.ToString;
  finally
    sw.Free;
  end;

  sr := TStringReader.Create(theString);
  try
    while sr.Peek <> -1 do
      Memo1.Lines.Add (sr.ReadLine);
  finally
    sr.Free;
  end;
end;

procedure TFormReaderWriter.btnWriteClick(Sender: TObject);
var
  sw: TStreamWriter;
begin
  sw := TStreamWriter.Create('test.txt', False, TEncoding.UTF8);
  try
    sw.WriteLine ('Hello, world');
    sw.WriteLine ('Have a nice day');
    sw.WriteLine (Left);
  finally
    sw.Free;
  end;
end;

procedure TFormReaderWriter.btnXmlCorrectClick(Sender: TObject);
var
  sw: TStringWriter;
  txw: TTrivialXmlWriter;
  theString: string;
begin
  sw := TStringWriter.Create;
  try
    txw := TTrivialXmlWriter.Create (sw);
    try
      txw.WriteStartElement('book');
        txw.WriteStartElement('title');
          txw.WriteString('Delphi 2009 Handbook');
        txw.WriteEndElement;
        txw.WriteStartElement('author');
          txw.WriteString('Marco Cantù');
        txw.WriteEndElement;
      txw.WriteEndElement;
    finally
       txw.Free;
    end;
    theString := sw.ToString;
  finally
    sw.Free;
  end;

  Memo1.Lines.Text := theString;
end;

procedure TFormReaderWriter.btnXmlUnbalancedClick(Sender: TObject);
var
  sw: TStringWriter;
  txw: TTrivialXmlWriter;
  theString: string;
begin
  sw := TStringWriter.Create;
  try
    txw := TTrivialXmlWriter.Create (sw);
    try
      txw.WriteStartElement('book');
        txw.WriteStartElement('title');
          txw.WriteString('Delphi 2009 Handbook');
//        txw.WriteEndElement;
        txw.WriteStartElement('author');
          txw.WriteString('Marco Cantù');
//        txw.WriteEndElement;
//      txw.WriteEndElement;
    finally
       txw.Free;
    end;
    theString := sw.ToString;
  finally
    sw.Free;
  end;

  Memo1.Lines.Text := theString;end;

procedure TFormReaderWriter.btnClassicClick(Sender: TObject);
var
  fs: TFileStream;
  str: AnsiString;
begin
  if FileExists ('test.txt') then
    fs := TFileStream.Create('test.txt', fmCreate)
  else
    fs := TFileStream.Create('test.txt', fmOpenReadWrite);
  try
    str := 'Hello, world';
    fs.write (str[1], Length (str));
    str := sLineBreak;
    fs.write (str[1], Length (str));
    str := IntToStr (Left);
    fs.write (str[1], Length (str));
  finally
    fs.Free;
  end;
end;

procedure TFormReaderWriter.btnReadClick(Sender: TObject);
var
  sr: TStreamReader;
begin
  sr := TStreamReader.Create('test.txt', True);
  try
    while not sr.EndOfStream do
      Memo1.Lines.Add (sr.ReadLine);
  finally
    sr.Free;
  end;
end;

{ TTrivialXmlWriter }

constructor TTrivialXmlWriter.Create(aWriter: TTextWriter);
begin
  fWriter := aWriter;
  fNodes := TStack<string>.Create;
end;

destructor TTrivialXmlWriter.Destroy;
begin
  while fNodes.Count > 0 do
    WriteEndElement;
  fNodes.Free;
  inherited;
end;

procedure TTrivialXmlWriter.WriteEndElement;
begin
  fWriter.Write('</' + fNodes.Pop + '>');
end;

procedure TTrivialXmlWriter.WriteStartElement(const sName: string);
begin
  fWriter.Write('<' + sName + '>');
  fNodes.Push (sname);
end;

procedure TTrivialXmlWriter.WriteString(const sValue: string);
begin
  fWriter.Write(sValue);
end;

end.
ReaderWriter_MainForm.pas.dfm
object FormReaderWriter: TFormReaderWriter
  Left = 0
  Top = 0
  Caption = 'ReaderWriter'
  ClientHeight = 376
  ClientWidth = 577
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 32
    Top = 16
    Width = 39
    Height = 13
    Caption = 'Streams'
  end
  object Label2: TLabel
    Left = 200
    Top = 16
    Width = 33
    Height = 13
    Caption = 'Strings'
  end
  object Label3: TLabel
    Left = 360
    Top = 21
    Width = 19
    Height = 13
    Caption = 'XML'
  end
  object btnWrite: TButton
    Left = 32
    Top = 40
    Width = 129
    Height = 25
    Caption = 'btnWrite'
    TabOrder = 0
    OnClick = btnWriteClick
  end
  object btnRead: TButton
    Left = 32
    Top = 80
    Width = 129
    Height = 25
    Caption = 'btnRead'
    TabOrder = 1
    OnClick = btnReadClick
  end
  object btnWriteAndRead: TButton
    Left = 200
    Top = 40
    Width = 121
    Height = 25
    Caption = 'btnWriteAndRead'
    TabOrder = 2
    OnClick = btnWriteAndReadClick
  end
  object Memo1: TMemo
    Left = 32
    Top = 128
    Width = 441
    Height = 217
    TabOrder = 3
  end
  object btnXmlCorrect: TButton
    Left = 360
    Top = 40
    Width = 113
    Height = 25
    Caption = 'btnXmlCorrect'
    TabOrder = 4
    OnClick = btnXmlCorrectClick
  end
  object btnXmlUnbalanced: TButton
    Left = 360
    Top = 80
    Width = 113
    Height = 25
    Caption = 'btnXmlUnbalanced'
    TabOrder = 5
    OnClick = btnXmlUnbalancedClick
  end
  object btnClassic: TButton
    Left = 479
    Top = 126
    Width = 90
    Height = 25
    Caption = 'btnClassic'
    TabOrder = 6
    OnClick = btnClassicClick
  end
end
HTML file generated by PasToWeb, a tool by Marco Cantù
Copyright 2008 Marco Cantù