Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 6

Chapter 05 - Project EncDemo

Project Structure

EncDemo.dpr
program EncDemo;

uses
  Forms,
  EncForm in 'EncForm.pas' {FormEncode},
  EncodStr in 'EncodStr.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TFormEncode, FormEncode);
  Application.Run;
end.
EncForm.pas
unit EncForm;

interface

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

type
  TFormEncode = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Panel1: TPanel;
    BtnLoadPlain: TButton;
    BtnSaveEncoded: TButton;
    BtnLoadEncoded: TButton;
    Splitter1: TSplitter;
    procedure BtnSaveEncodedClick(Sender: TObject);
    procedure BtnLoadEncodedClick(Sender: TObject);
    procedure BtnLoadPlainClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormEncode: TFormEncode;

implementation

{$R *.DFM}

uses
  EncodStr;

procedure TFormEncode.BtnSaveEncodedClick(Sender: TObject);
var
  EncStr: TEncodedStream;
begin
  if SaveDialog1.Execute then
  begin
    EncStr := TEncodedStream.Create(
      SaveDialog1.Filename, fmCreate);
    try
      Memo1.Lines.SaveToStream (EncStr);
    finally
      EncStr.Free;
    end;
  end;
end;

procedure TFormEncode.BtnLoadEncodedClick(Sender: TObject);
var
  EncStr: TEncodedStream;
begin
  if OpenDialog1.Execute then
  begin
    EncStr := TEncodedStream.Create(
      OpenDialog1.FileName, fmOpenRead);
    try
      Memo2.Lines.LoadFromStream (EncStr);
    finally
      EncStr.Free;
    end;
  end;
end;

procedure TFormEncode.BtnLoadPlainClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
    Memo1.Lines.LoadFromFile (
      OpenDialog1.FileName);
end;

end.
EncodStr.pas
unit EncodStr;

interface

uses
  Classes;

type
  TEncodedStream = class (TFileStream)
  private
    FKey: Char;
  public
    constructor Create(const FileName: string; Mode: Word);
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    property Key: Char read FKey write FKey default 'A';
  end;

implementation

constructor TEncodedStream.Create(
  const FileName: string; Mode: Word);
begin
  inherited Create (FileName, Mode);
  FKey := 'A';
end;

function TEncodedStream.Write(const Buffer;
   Count: Longint): Longint;
var
  pBuf, pEnc: PChar;
  I, EncVal: Integer;
begin
  // allocate memory for the encoded buffer
  GetMem (pEnc, Count);
  try
    // use the buffer as an array of characters
    pBuf := PChar (@Buffer);
    // for every character of the buffer
    for I := 0 to Count - 1 do
    begin
      // encode the value and store it
      EncVal := ( Ord (pBuf[I]) + Ord(Key) ) mod 256;
      pEnc [I] := Chr (EncVal);
    end;
    // write the encoded buffer to the file
    Result := inherited Write (pEnc^, Count);
  finally
    FreeMem (pEnc, Count);
  end;
end;

function TEncodedStream.Read(var Buffer; Count: Longint): Longint;
var
  pBuf, pEnc: PChar;
  I, CountRead, EncVal: Integer;
begin
  // allocate memory for the encoded buffer
  GetMem (pEnc, Count);
  try
    // read the encoded buffer from the file
    CountRead := inherited Read (pEnc^, Count);
    // use the output buffer as a string
    pBuf := PChar (@Buffer);
    // for every character actually read
    for I := 0 to CountRead - 1 do
    begin
      // decode the value and store it
      EncVal := ( Ord (pEnc[I]) - Ord(Key) ) mod 256;
      pBuf [I] := Chr (EncVal);
    end;
  finally
    FreeMem (pEnc, Count);
  end;
  // return the number of characters read
  Result := CountRead;
end;



end.
EncForm.dfm
object FormEncode: TFormEncode
  Left = 189
  Top = 113
  Width = 598
  Height = 362
  Caption = 'Encoded Stream Demo'
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  PixelsPerInch = 96
  TextHeight = 13
  object Splitter1: TSplitter
    Left = 273
    Top = 41
    Width = 3
    Height = 294
    Cursor = crHSplit
    Beveled = False
  end
  object Memo1: TMemo
    Left = 0
    Top = 41
    Width = 273
    Height = 294
    Align = alLeft
    Lines.Strings = (
      'Memo1')
    ScrollBars = ssVertical
    TabOrder = 0
  end
  object Memo2: TMemo
    Left = 276
    Top = 41
    Width = 314
    Height = 294
    Align = alClient
    Lines.Strings = (
      'Memo2')
    ScrollBars = ssVertical
    TabOrder = 1
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 590
    Height = 41
    Align = alTop
    TabOrder = 2
    object BtnLoadPlain: TButton
      Left = 8
      Top = 8
      Width = 129
      Height = 25
      Caption = 'Load Plain...'
      TabOrder = 0
      OnClick = BtnLoadPlainClick
    end
    object BtnSaveEncoded: TButton
      Left = 144
      Top = 8
      Width = 129
      Height = 25
      Caption = 'Save Encoded...'
      TabOrder = 1
      OnClick = BtnSaveEncodedClick
    end
    object BtnLoadEncoded: TButton
      Left = 280
      Top = 8
      Width = 129
      Height = 25
      Caption = 'Load Encoded'
      TabOrder = 2
      OnClick = BtnLoadEncodedClick
    end
  end
  object OpenDialog1: TOpenDialog
    Filter = 'Text File (*.txt)|*.txt|Any file (*.*)|*.*'
    Left = 48
    Top = 80
  end
  object SaveDialog1: TSaveDialog
    Filter = 'Text File (*.txt)|*.txt|Any file (*.*)|*.*'
    Left = 112
    Top = 80
  end
end