learn.pas

delphi 实现的 sscanf 函数

unit Learn;

interface

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

type
  TForm2 = class(TForm)
    OutMemo: TMemo;
    Label5: TLabel;
    DeFormatBtn: TButton;
    scanfBtn: TButton;
    ExitBtn: TButton;
    SaveBtn: TButton;
    SaveDlg: TSaveDialog;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    FormatBox: TComboBox;
    TypeBox: TListBox;
    InputBox: TComboBox;
    procedure Doit(Sender: TObject);
    procedure PrAbort(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SuggestBtnClick(Sender: TObject);
  private
    { Private declarations }
    FCounter : integer;
    FStr : string;
    FFmt : string;
    FSaved : boolean;
  public
    property  Str : string read FStr;
    property  Fmt : string read FFmt;
    property  Counter : integer read FCounter;
    property  Saved : boolean read FSaved;
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.DFM}
uses Scanf, scanf_c;

type TTypes = (
TShortInt,
TByte,
TSmallInt,
TWord,
TInteger,
TCardinal,
Tint64,
TSingle,
TDouble,
TReal,
TExtended,
TCurrency,
TPointer,
Tchar,
TarrChar,
TAnsiString,
TShortString,
TPChar
);

const TypeNames : array [TTypes] of string =
(
'ShortInt',
'Byte',
'SmallInt',
'Word',
'Integer',
'Cardinal',
'Int64 (Comp)',
'Single',
'Double',
'Real',
'Extended',
'Currency',
'Pointer',
'Char',
'Array of Char (limit 255)',
'AnsiString',
'ShortString',
'PChar (limit 255)'
 );

const TypeIFmts : array [TTypes] of string =
(
'%Hi', // TShortInt
'%Hi', // TByte
'%hi', // TSmallInt
'%hi', // TWord
'%i',  // TInteger
'%i',  // TCardinal
'%Li', // Tint64
'%hf', // TSingle
'%lf', // TDouble
'%Hf', // TReal
'%Lf', // TExtended
'%m',  // TCurrency
'%p',  // TPointer
'%c',  // Tchar
'%2551c', // TarrChar
'%ls', // TAnsiString
'%255hs', // TShortString
'%255s'   // TPChar
);

procedure TForm2.Doit(Sender: TObject);
var Res : integer;
    PStr, PFmt : PChar;
    EName, EMes : string;
    ScanName, Dum : string;
    ResPtr : pointer;
    PC : PChar;
    X : ShortString; // largest single variable;
    S : AnsiString absolute X;
    SS: ShortString absolute X;
    SI: single absolute X;
    D : double absolute X;
    i64 : int64 absolute X;
    ex : extended absolute X;
    r : real48 absolute X;
    Cu : currency absolute X;
    p : pointer absolute X;
    ch : char absolute X;
    b : byte absolute X;
    sh : shortint absolute X;
    sm : smallint absolute X;
    w : word absolute X;
    ca : cardinal absolute X;
    i : integer absolute X;

  procedure MakeReport(ResFmt : string; const ResRec : array of const);
  var iDum : integer;
  begin
    With OutMemo.Lines do begin
      Append(Format('----- Trial #%d ------',[Counter]));
      Append(Format('The input string was "%s"', [Str]));
      Dum:=         '%s stopped at  ';
      for iDum:=0 to (PStr-PChar(Str)) do Dum:=Dum+' ';
      Dum:=Dum+'^ (%d characters scanned)';
      Append(Format(Dum,[ScanName,PStr-PChar(Str)]));
      Append(Format('The format string was "%s"', [Fmt]));
      Dum:=         '%s stopped at   ';
      for iDum:=0 to (PFmt-PChar(Fmt)) do Dum:=Dum+' ';
      Dum:=Dum+'^ (%d characters scanned)';
      Append(Format(Dum,[ScanName,PFmt-PChar(Fmt)]));
      if (EMes <> '') then
        Append(Format('** An %s was raised with the message "%s" **', [EName, EMes]))
      else if Res >0 then begin
        Append(Format('%s returned %d',[ScanName,Res]));
        Append(Format(Format('%s value stored is %s',[TypeNames[TTypes(TypeBox.TopIndex)],ResFmt]),ResRec));
      end;
    end;
  end;

begin
  FSaved:=False;
  Inc(FCounter);
  EMes:='';
  FStr:=InputBox.Text;
  FFmt:=FormatBox.Text;
  PStr:=PChar(Str);
  PFmt:=PChar(Fmt);
  ResPtr:=@X;
  FillChar(X,SizeOf(X),#0);
  With InputBox do if Text <> Items[0] then Items.Insert(0, Text);
  With FormatBox do if Text <> Items[0] then Items.Insert(0, Text);
  try
    if (Sender=scanfBtn) then begin
      ScanName:='sscanf  ';
      Res:=scanf_core(PStr, PFmt, [ResPtr]);
    end else begin
      ScanName:='DeFormat';
      Res:=DeFormat_core(PStr, Length(Str), PFmt, Length(Fmt), [ResPtr], DecimalSeparator, ThousandSeparator);
    end;
  except
    on E:Exception do begin
      EMes:=E.Message;
      EName:=E.ClassName;
    end;
  end;
  PC:=@X;
  Case TTypes(TypeBox.TopIndex) of
    TShortInt : MakeReport('%d ($%x)',[sh,sh]);
    TByte : MakeReport('%d ($%x)',[b,b]);
    TSmallInt : MakeReport('%d ($%x)',[sm,sm]);
    TWord : MakeReport('%d ($%x)',[w,w]);
    TInteger : MakeReport('%d ($%x)',[i,i]);
    TCardinal : MakeReport('%d ($%x)',[ca,ca]);
    Tint64 : MakeReport(Int64ToStr(i64) + ' ('+Int64ToHex(i64)+')',[nil]);
    TSingle : MakeReport('%f',[si]);
    TDouble : MakeReport('%f',[d]);
    TReal : MakeReport('%f',[r]);
    TExtended : MakeReport('%f',[ex]);
    TCurrency : MakeReport('%m',[cu]);
    TPointer : MakeReport('%p',[p]);
    TChar : MakeReport('"%s"',[PC]);
    TArrChar : MakeReport('"%s"',[PC]);
    TAnsiString : MakeReport('"%s"',[S]);
    TShortString : MakeReport('"%s"',[SS]);
    TPChar : MakeReport('"%s"',[PC]);
  end;
end;

procedure TForm2.PrAbort(Sender: TObject);
begin
  Close;
end;

procedure TForm2.SaveBtnClick(Sender: TObject);
begin
  if SaveDlg.Execute then begin
    OutMemo.Lines.SaveToFile(SaveDlg.FileName);
    FSaved:=True;
  end;
end;

procedure TForm2.FormCreate(Sender: TObject);
var i : TTypes;
begin
  TypeBox.Items.Clear;
  for i:=Low(TTypes) to High(TTypes) do TypeBox.Items.Add(TypeNames[i]);
  TypeBox.TopIndex:=0;
end;

procedure TForm2.SuggestBtnClick(Sender: TObject);
begin
  FormatBox.SelText:=TypeIFmts[TTypes(TypeBox.TopIndex)];
  ActiveControl:=FormatBox;
end;

{$I examples.pas}
end.