Revelation

Dec 15 2006, 03:32 PM

Download here (Win32 executable packed in a rar).

Quote:

 

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    SG: TStringGrid;
    Memo1: TMemo;
    CheckBox1: TCheckBox;
    Memo2: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    CheckBox2: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure SGSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure SGSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: string);
    procedure UpdateText;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  CharsInCT, ReplacementChar, PlaceInSG: array[0..255] of integer;
  onlyalpha, onlyprintable, incpunct: boolean;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  i, rowpointer: integer;
begin
  onlyalpha := CheckBox1.Checked;
  onlyprintable := CheckBox2.Checked;

  SG.RowCount := 0; // reset the field

  for i := 0 to 255 do
  begin
    CharsInCT := 0;
    ReplacementChar := -1;
  end;

  for i := 1 to Length(Memo1.Text) do
  begin
    CharsInCT[Ord(Memo1.Text)] := CharsInCT[Ord(Memo1.Text)] + 1;
  end;

  rowpointer := 0;
  for i := 0 to 255 do
  begin
    if onlyalpha then
      if not (i in [65..90]) then
      Continue;

    if onlyprintable then
    begin
      if i <= 32 then // also exclude space
      Continue;
    end;

    if CharsInCT > 0 then
    begin
      if rowpointer + 1 > SG.RowCount then
        SG.RowCount := SG.RowCount + 1;

      PlaceInSG := rowpointer;
      Sg.Cells[0, rowpointer] := Chr(i);
      Sg.Cells[2, rowpointer] := IntToStr(CharsInCT);

      Inc(rowpointer); 
    end;
  end;

  Memo2.Text := Memo1.Text;

end;

procedure TForm1.UpdateText;
var
  i: integer;
  astring: string;
begin
  Memo2.Clear;
  astring := '';
  SetLength(astring, Length(Memo1.Text));
// FillChar(astring, 4999, #0);

  for i := 1 to Length(Memo1.Text) do
  begin
    if onlyalpha then
    if not (Ord(Memo1.Text) in [65..90]) then
    begin
      astring := Memo1.Text;
      Continue;
    end;

    if onlyprintable then
    if Ord(Memo1.Text) <= 33 then
    begin
      astring := Memo1.Text;
      Continue;
    end;

      if Sg.Cells[1, PlaceInSG[Ord(Memo1.Text)]] = '' then
        astring := Sg.Cells[0, PlaceInSG[Ord(Memo1.Text)]][1]
      else
        astring := Sg.Cells[1, PlaceInSG[Ord(Memo1.Text)]][1];
  end;

  Memo2.Text := astring;
end;

procedure TForm1.SGSelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
  if (ACol = 0) or (ACol = 2) then
    CanSelect := False;
end;

procedure TForm1.SGSetEditText(Sender: TObject; ACol, ARow: Integer;
  const Value: string);
begin
  if Length(Value) > 1 then
    SG.Cells[ACol, ARow] := Copy(Value, 1, 1);

  UpdateText;
end;

end.

insecure

Jan 12 2007, 02:08 AM

It is probably advisable to encourage best security practice by posting source code, rather than executables. Ideally in a cross-platform language, too. (C, C++, Pascal, Java, Perl, Python, PHP...) I know Delphi is a Pascal variant, but it's sufficiently variant that the source is of no direct use to me - I'd have to translate it.