Kirjautuminen

Haku

Tehtävät

Keskustelu: Koodit: Pascal: Parse String

User137 [16.04.2008 12:24:15]

#

ReadCustom() funktiolle annetaan string syötteenä teksti, erotin (joka voi olla ihan mikä vaan, kuinka monta kertaa peräkkäin tahansa sekä missä tahansa välissä) sekä taulukot johon tekstin tiedot erotellaan ja vielä lisäksi taulukko jossa on tieto kunkin alkion tyypistä. Mikäli tyyppi-lista on lyhyempi kuin data-listan pituus, käydään tyyppi-listaa läpi useamman kerran. Eli [crString,crInt] taulukkoa voisi käyttää lukemaan monia peräkkäisiä string,int jaksoja.

type
  TCustomRead = (crString, crInt, crSingle,
    crDouble, crByte, crWord, crShortInt, crSmallInt,
    crCardinal, crBool, crInt64);

{ ... }

function ReadCustom(const s,separator: string; const arr: array of pointer;
  const arrt: array of TCustomRead): integer;
var p,arrtl: integer; cur: string; defaultStr: boolean;
  procedure SetValue;
  begin
    if arr[p]=nil then exit;
    if defaultStr then string(arr[p]^):=cur
    else case arrt[p mod arrtl] of
      crString: string(arr[p]^):=cur;
      crInt: integer(arr[p]^):=strtointdef(cur,0);
      crSingle: single(arr[p]^):=strtofloat(cur);
      crDouble: double(arr[p]^):=strtofloat(cur);
      crByte: byte(arr[p]^):=strtointdef(cur,0);
      crWord: word(arr[p]^):=strtointdef(cur,0);
      crShortInt: shortint(arr[p]^):=strtointdef(cur,0);
      crSmallInt: smallint(arr[p]^):=strtointdef(cur,0);
      crCardinal: cardinal(arr[p]^):=strtointdef(cur,0);
      crBool: boolean(arr[p]^):=(cur<>'0') and (lowercase(cur)<>'false');
      crInt64: int64(arr[p]^):=strtoint(cur);
    end;
  end;
var ha,i,l: integer; c,cs: string;
begin
  ha:=high(arr);
  if ha<1 then begin
    result:=0; exit;
  end;
  defaultStr:=high(arrt)<1; arrtl:=length(arrt);
  p:=0; l:=length(separator); i:=1; cur:='';
  while i<=length(s) do begin
    c:=copy(s,i,1); cs:=copy(s,i,l);
    if cs=separator then begin
      if cur<>'' then begin
        SetValue; cur:=''; inc(p);
        if p>ha then break;
      end;
      inc(i,l-1);
    end else cur:=cur+c;
    inc(i);
  end;
  if cur<>'' then begin
    SetValue; inc(p);
  end;
  result:=p;
end;

Testiohjelma

procedure TForm1.FormCreate(Sender: TObject);
var i,i2: integer; si: single; s,text,text2: string;
begin
  s:='testi--900----8.514--testi2--200';

  // Taulukkoa ei tarvitse luoda lennosta mutta tämäkin
  // on mahdollista ja usein ehkä helpompaa

  ReadCustom(s,'--',[@text,@i,@si,@text2,@i2],
    [crString,crInt,crSingle]);

  edit1.Text:=format('%s,%d,%f,%s,%d',[text,i,si,text2,i2]);
end;

Palauttaa:

testi,900,8.51,testi2,200

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta