scanf_c.pas

delphi 实现的 sscanf 函数

  Marker:=Fmt; Temp:=0;
  while (Fmt^ >= '0') and (Fmt^ <= '9') do begin
    Temp:=Temp*10+Ord(Fmt^)-Ord('0');
    Inc(Fmt);
  end;
  If Fmt > Marker then if Temp > 0 then Width:=Temp else Exit;
  If Fmt^ <> #0 then Result:=Integer(GetSizeType(Fmt)) or NoAssign;
end;

procedure scCopyStr(Size : char; Dest : pointer; Src : PChar; Width : integer);
begin
  Case Size of
    'l' : SetString(AnsiString(Dest^), Src, Width);
    'h' : SetString(ShortString(Dest^), Src, Width);
    else begin
      Move(Src^, Dest^, Width);
      PChar(Dest)[Width]:=#0
    end;
  end;  
end;

function Scanf_core(var Buffer: PChar; var Format : PChar;
                    Pointers : array of Pointer)
                    : Integer;

var  // Many of these will be optimized out
  Width, Count, Index : cardinal;
  Buf, Fmt, Marker : PChar;
  {$IFDEF SCANF_EXCEPTIONS} FMarker : PChar; {$ENDIF}
  Temp : integer;
  FmtEnd : PChar absolute Format;
  SCR : TscRec;
  FType : integer absolute SCR;
  theSet : TCharSet;
  BSet : byte absolute theSet;
  Ptr : Pointer;

  function ScanToFormat : boolean;
  begin
    ScanToFormat:=False;
    while Fmt^ <> #0 do begin
      case Fmt^ of
        '%' : begin
                Inc(Fmt);
                if (Fmt^='%') then  // this is "%%", check for "%" in Buf
                   if (Buf^ <> '%') then Exit else begin
                     Inc(Buf); Inc(Fmt);
                   end
                else begin
                  ScanToFormat:=True; // Start of Fmt specifier found.
                  Exit;
                end;
              end;
         #1..#32 : begin  // Skip blank space in Buf and Fmt
                     while (Fmt^>#0) and (Fmt^ <=' ') do Inc(Fmt);
                     while (Buf^>#0) and (Buf^ <=' ') do Inc(Buf);
                   end;
         else begin
           {$IFNDEF SCANF_CASE_SENSITIVE}
             if Buf^ <> Fmt^ then Exit;
           {$ELSE}
             if UpCase(Buf^) <> UpCase(Fmt^) then Exit;
           {$ENDIF}
           Inc(Buf);
           Inc(Fmt);
         end;
       end;
    end;
  end;

begin
  Fmt:=Format; FmtEnd:=Fmt+Length(Fmt); Result:=0; Buf:=Buffer; Index:=0; // initialization
  {$IFDEF SCANF_EXCEPTIONS}
  try
  {$ENDIF}
  While ScanToFormat do   // ScanToFormat returns False if end of Buf or Fmt is reached
  With SCR do begin
    Width:=0;
    {$IFDEF SCANF_EXCEPTIONS} FMarker:=Fmt-1; {$ENDIF}
    FType:=scGetFType(Fmt,Width); // GetFType returns scIllegal on any error
    Ptr:=NIL;
    If (FType > 0) then begin
      if (Index <= cardinal(High(Pointers))) then Ptr:=Pointers[Index];
      if (Ptr=NIL) then begin // scanf aborts if assignment to NIL is requested
      {$IFDEF SCANF_EXCEPTIONS}
        raise EConvertError.CreateFmt(SArgumentMissing, [Copy(FMarker-1, 0, Fmt-FMarker+1)]);
      {$ENDIF}
        Break;
      end;
    end;
    Case Typ of
      scPChar, scFloat, scInteger, scCurrency : // Skip blank space for these formats
            while (Buf^ <> #0) and (Buf^ <= ' ') do Inc(Buf);
      scCharSet : begin
                    if not ParseSet(Fmt, FmtEnd, theSet) then FType:=scIllegal
                    else BSet:=BSet and $fe;  // Mask out #0
                  end;
      scChar : if Width = 0 then Inc(Width);
    end;
    if Buf^ = #0 then Break;
    if Width=0 then Width:=defWidth;
    Marker:=Buf;
    Case Typ of
      scNspec : Case Size of
                  'H': Byte(ptr^):=Buf-Buffer;
                  'h': Word(ptr^):=Buf-Buffer;
                  'l',#0 : LongWord(ptr^):=Buf-Buffer;
                  'L'   : int64(ptr^):=Buf-Buffer;
                end;
      scChar    : begin
                    for Count:=1 to Width do if (Buf^ <> #0) then Inc(Buf) else Break;
                    If (FType > 0) then Move(Marker^, ptr^, Buf-Marker);
                  end;
      scCharSet : begin
                    for Count:=1 to Width do if (Buf^ in theSet) then Inc(Buf) else Break;
                    if (FType > 0) then scCopyStr(Size, Ptr, Marker, Buf-Marker);
                  end;
      scPChar :   begin
                    for Count:=1 to Width do if (Buf^ > ' ') then Inc(Buf) else Break;
                    if (FType > 0) then scCopyStr(Size, Ptr, Marker, Buf-Marker);
                  end;
    scInteger :  begin
                   Temp:=NumScan(Buf, Width, FType, ptr,#0,#0);
                   if Temp <= 0 then begin
                   {$IFDEF SCANF_EXCEPTIONS}
                     raise EConvertError.CreateFmt(SInvalidInteger, [Copy(Marker, 1, Buf-Marker+1)]);
                   {$ENDIF}
                     Break;
                   end;
                   {$IFOPT Q+}
                   if (Temp and scOverflow) <> 0 then begin
                     raise EIntOverflow.Create(SOverflow + ' while scanning ' + Copy(Marker,1, Buf-Marker));
                     Break;
                   end;
                   {$ENDIF}
                 end;
    scFloat   : begin
                  if SizeType = scFloat then Size:='h';   // scanf default is single
                  Temp:=NumScan(Buf, Width, FType, ptr,'.',#0); // scan in C style
                  if Temp <=0 then begin
                  {$IFDEF SCANF_EXCEPTIONS}
                    raise EConvertError.CreateFmt(SInvalidFloat, [Copy(Marker, 1, Buf-Marker+1)]);
                  {$ENDIF}
                    Break;
                  end;
                  {$IFOPT Q+}
                  if (Temp and scOverflow) <> 0 then begin
                    raise EOverflow.Create(SOverflow + ' while scanning ' + Copy(Marker,1, Buf-Marker));
                    Break;
                  end;
                  {$ENDIF}
                end;
      else begin // scIllegal etc.
        {$IFDEF SCANF_EXCEPTIONS}
        raise EConvertError.CreateFmt(SInvalidFormat, [Copy(FMarker, 1, Fmt-FMarker+1)]);
        {$ENDIF}
        Break;
      end;
    end; { Case }
    If (FType > 0) then begin
      if (Typ <> scNSpec) then Inc(Result);  // NSpec does not count!
      Inc(Index);
    end;
  end; { While, With }
{$IFDEF SCANF_EXCEPTIONS}
 finally
{$ENDIF}
  Buffer:=Buf; Format:=Fmt;// return final positions
{$IFDEF SCANF_EXCEPTIONS}
    end;
{$ENDIF}
end;


function Scanf_stream(Inp : TStream; var Format : PChar;
                      Pointers : array of Pointer)
                      : Integer;

var
  Width, Count, Index : cardinal;
  Buf, Fmt : PChar;
  {$IFDEF SCANF_EXCEPTIONS} FMArker : PChar; {$ENDIF}
  NI, Pos, Marker : integer;
  Temp : integer;
  FmtEnd : PChar absolute Format;
  SCR : TscRec;
  FType : integer absolute SCR;
  theSet : TCharSet;
  BSet : byte absolute theSet;
  Ptr : Pointer;
  Mem : TMemoryStream;

  function GetCh : integer;
  begin
    if Inp.Read(NI, 1) < 1 then NI:=-1;
    Result:=NI;
  end;

  function ScanToFormat : boolean;
  begin
    ScanToFormat:=False;
    while Fmt^ <> #0 do begin
      Case Fmt^ of
        '%' : begin
                Inc(Fmt);
                  if (Fmt^='%') then begin // this is "%%", check for "%" in Buf
                     if (Char(GetCh) = '%') then Inc(Fmt);
                   end
                else begin
                  ScanToFormat:= (GetCh >=0); // Start of Fmt specifier found.
                  Exit;
                end;
              end;
         #1..#32 : begin  // Skip blank space in Buf and Fmt
                     while (Fmt^>#0) and (Fmt^ <=' ') do Inc(Fmt);
                     repeat until Char(GetCh) > ' ';
                     If NI < 0 then Break else Inp.Seek(-1,soFromCurrent) {UnGetCh};
                   end;
        else begin
           {$IFNDEF SCANF_CASE_SENSITIVE}
             if Char(GetCh) <> Fmt^ then Break;
           {$ELSE}
             if UpCase(Char(GetCh)) <> UpCase(Fmt^) then Break;
           {$ENDIF}
           Inc(Fmt);
        end;
      end;
    end;
  end;

begin
  NI:=0; Fmt:=Format; FmtEnd:=Fmt+Length(Fmt); Result:=0; Index:=0; // initialization
  Pos:=Inp.Position; Mem:=TMemoryStream.Create;
  {$IFDEF SCANF_EXCEPTIONS}
  try
  {$ENDIF}
  While ScanToFormat do   // ScanToFormat returns False if end reached.
                          // If True then next character in NI pending.
  With SCR do begin
    Width:=0;
    {$IFDEF SCANF_EXCEPTIONS} FMarker:=Fmt-1; {$ENDIF}
    FType:=scGetFType(Fmt,Width); // GetFType returns scIllegal on any error
    Ptr:=NIL;
    If (FType > 0) then begin
      if (Index <= cardinal(High(Pointers))) then Ptr:=Pointers[Index];
      if (Ptr=NIL) then begin // scanf aborts if assignment to NIL is requested
      {$IFDEF SCANF_EXCEPTIONS}
        raise EConvertError.CreateFmt(SArgumentMissing, [Copy(FMarker-1, 0, Fmt-FMarker+1)]);
      {$ENDIF}
        Break;
      end;
    end;
    Case Typ of
      scPChar, scFloat, scInteger, scCurrency : // Skip blank space for these formats
            while (Char(NI) <= ' ') do GetCh;
      scCharSet : begin
                    if not ParseSet(Fmt, FmtEnd, theSet) then FType:=scIllegal
                    else BSet:=BSet and $fe;  // Mask out #0
                  end;
      scChar : if Width = 0 then Inc(Width);
    end;
    if NI < 0 then Break;
    if Width=0 then Width:=defWidth;
    Marker:=Inp.Position;
    Mem.Position:=0;
    Case Typ of
      scNspec : Case Size of
                  'H': Byte(ptr^):=Marker-Pos;
                  'h': Word(ptr^):=Marker-Pos;
                  'l',#0 : LongWord(ptr^):=Marker-Pos;
                  'L'   : int64(ptr^):=Marker-Pos;
                end;
      scChar    : for Count:=1 to Width do begin
                    If (FType > 0) then begin PChar(Ptr)^:=Char(NI); Inc( PChar(Ptr)); end;
                    if GetCh < 0 then Break;
                  end;
      scCharSet : begin
                    for Count:=1 to Width do
                      if (Char(NI) in theSet) then begin
                        Mem.Write(NI,1); if GetCh < 0 then Break;
                       end else begin
                         Inp.Seek(-1,soFromCurrent) {UnGetCh}; Break;
                       end;
                    if FType > 0 then scCopyStr(Size, Ptr, Mem.Memory, Mem.Position);
                  end;
      scPChar :   begin
                    for Count:=1 to Width do
                      if (Char(NI) > ' ') then begin
                        Mem.Write(NI,1); if GetCh < 0 then Break;
                       end else begin
                         Inp.Seek(-1,soFromCurrent) {UnGetCh}; Break;
                       end;
                    if FType > 0 then scCopyStr(Size, Ptr, Mem.Memory, Mem.Position);
                  end;
     scInteger :  begin
                   for Count:=1 to Width do
                     if (Char(NI) in ['+','-','0'..'9']) then begin
                       Mem.Write(NI,1); if GetCh < 0 then Break;
                      end else begin
                        Inp.Seek(-1,soFromCurrent) {UnGetCh}; Break;
                      end;
                   Buf:=PChar(Mem.Memory);
                   Temp:=NumScan(Buf, Width, FType, ptr,#0,#0);
                   Inp.Seek(Buf-PChar(Mem.Memory)-Mem.Position, soFromCurrent);
                   if Temp <= 0 then begin
                   {$IFDEF SCANF_EXCEPTIONS}
                     raise EConvertError.CreateFmt(SInvalidInteger, [Copy(PChar(Mem.Memory), 1, Buf-PChar(Mem.Memory)+1)]);
                   {$ENDIF}
                     Break;
                   end;
                   {$IFOPT Q+}
                   if (Temp and scOverflow) <> 0 then begin
                     raise EIntOverflow.Create(SOverflow + ' while scanning ' + Copy(PChar(Mem.Memory), 1, Buf-PChar(Mem.Memory)));
                     Break;
                   end;
                   {$ENDIF}
                 end;
     scFloat   : begin
                  if SizeType = scFloat then Size:='h';   // scanf default is single
                  for Count:=1 to Width do
                    if (Char(NI) in['.','+','-','0'..'9','e','E']) then begin
                      Mem.Write(NI,1); if GetCh < 0 then Break;
                     end else begin
                       Inp.Seek(-1,soFromCurrent) {UnGetCh}; Break;
                     end;
                  Buf:=PChar(Mem.Memory);
                  Temp:=NumScan(Buf, Width, FType, ptr,'.',#0);
                  Inp.Seek(Buf-PChar(Mem.Memory)-Mem.Position, soFromCurrent);
                  if Temp <=0 then begin
                  {$IFDEF SCANF_EXCEPTIONS}
                    raise EConvertError.CreateFmt(SInvalidFloat, [Copy(PChar(Mem.Memory), 1, Buf-PChar(Mem.Memory)+1)]);
                  {$ENDIF}
                    Break;
                  end;
                  {$IFOPT Q+}
                  if (Temp and scOverflow) <> 0 then begin
                    raise EOverflow.Create(SOverflow + ' while scanning ' + Copy(PChar(Mem.Memory), 1, Buf-PChar(Mem.Memory)));
                    Break;
                  end;
                  {$ENDIF}
                end;
     else begin // scIllegal etc.
        {$IFDEF SCANF_EXCEPTIONS}
        raise EConvertError.CreateFmt(SInvalidFormat, [Copy(FMarker, 1, Fmt-FMarker+1)]);
        {$ENDIF}
        Break;
      end;
    end; { Case }
    If (FType > 0) then begin
      if (Typ <> scNSpec) then Inc(Result);  // NSpec does not count!
      Inc(Index);
    end;
    if (NI < 0) and (Result = 0) then Result:=scEOF;
  end; { While, With }
{$IFDEF SCANF_EXCEPTIONS}
 finally
{$ENDIF}
   Format:=Fmt; // return final position
   Mem.Free;    // clean up
{$IFDEF SCANF_EXCEPTIONS}
    end;
{$ENDIF}
end;

{ End of Scanf_c unit }
end.