D7 falscher Compiler-Hinweis: Auf xxxx zugewiesener Wert ...

[p80286]

Auf besonderen Wunsch:

Delphi-Quellcode:

function Get_StringPosList(efile:f_str;suchstr:shortstring;casesensitive:boolean=true;useunicode:boolean=false):T_pPosListrec;
var
(* ***********************
 buffer überarbeiten!!!
 ****************************************** *)
  i              : integer;
  fPos           : longint;
  chkPos         : longint;
  iniok          : boolean;
  dname          : string;
  buffer         : array [1..maxbuff] of byte;
  Cbuffer        : array [1..maxbuff] of char absolute buffer;
  pufflen        : integer;
  lpos,
  lies,
  gelesen        : integer;
  UpCbuffer      : array [1..maxbuff] of char;
  UpCsuchstr     : shortstring;
  UniCsuchstr    : widestring;
  UpCUniCsuchstr : widestring;
  pPosListrec    : T_pPosListRec;
begin
  new(pPosListRec);
  pPosListrec^.Filename:=efile;
  setlength(pPosListrec^.Positions,1);
  pPosListrec^.Positions[0]:=0;
  chkPos :=0;
  UpCsuchstr    :=uppercase(suchstr);
  UniCsuchstr   :=suchstr;
  UpCUniCsuchstr:=UpCsuchstr;
  dname:=efile;
  filemode:=0;
//  count:=0;

  assign(edat,efile);
  {$I-}
  reset(edat,1);
  {$I+}
  if ioresult=0 then begin
    if casesensitive then begin
      if useunicode then
        iniok:=INITSUCHARR(@UniCsuchStr[1],length(UniCsuchstr)*2)
      else
        iniok:=INITSUCHARR(@SuchStr[1],length(SuchStr));
    end
    else begin
      if useunicode then
        iniok:=INITSUCHARR(@UpCUnicsuchstr[1],length(UpCUnicsuchstr)*2)
      else
        iniok:=INITSUCHARR(@UpCsuchstr[1],length(UpCsuchstr));
    end;
    if not iniok then begin
      FEHLER(9,' Initialisierungsfehler!');
      result:=pPosListrec;
      exit; {zurück zur Eingabe }
    end;

    lpos:=1;
    fpos:=-1;
    lies:=maxbuff;
    repeat
      blockread(edat,buffer[lpos],lies,gelesen);
      pufflen:=lpos-1+gelesen;
      if not casesensitive then
        for i:=lpos to lpos-1+gelesen do
          UpCbuffer[i]:=upcase(Cbuffer[i]);

      if (lpos-1+gelesen)>=length(such_str) then begin
        if casesensitive then begin
          if useunicode then
            fpos:=FINDEINARR(@buffer[1],lpos+gelesen-1,@UniCsuchstr[1],length(UniCsuchstr)*2)
          else
            fpos:=FINDEINARR(@buffer[1],lpos+gelesen-1,@such_str[1],length(such_str));
        end
        else begin
          if useunicode then
            fpos:=FINDEINARR(@UpCbuffer[1],lpos+gelesen-1,@UpCUniCsuchstr[1],length(UpCUniCsuchstr)*2)
          else
            fpos:=FINDEINARR(@UpCbuffer[1],lpos+gelesen-1,@UpCsuchstr[1],length(UpCsuchstr))
        end;

        if fpos=-1 then begin          {---------------------- nichts gefunden }
          move(buffer[lpos+gelesen-length(such_str)],buffer[1],byte(such_str[0]));
          move(UpCbuffer[lpos+gelesen-length(such_str)],UpCbuffer[1],byte(such_str[0]));
          lpos:=length(such_str)+1;
          lies:=maxbuff-length(such_str);
          chkPos:=chkPos+gelesen-lpos;
        end
        else begin   {-- gefunden ---------------------------}
          inc(fpos,1);                 { fpos gilt für 0-basierte arrays!}
          if fpos<=pufflen then begin
            setlength(pPosListrec^.Positions,pPosListrec^.Positions[0]+2);
            inc(pPosListrec^.Positions[0],1);
            pPosListrec^.Positions[pPosListrec^.Positions[0]]:=fpos+chkpos;
            if fpos>1 then begin         { für fpos=1 ist gibt es bei move einen Bereichsfehler und ist auch Blödsinn }
              chkpos:=chkpos+fpos-1;
              move(buffer[fpos],buffer[1],gelesen+lpos-1-(fpos-1));
              move(UpCbuffer[fpos],UpCbuffer[1],gelesen+lpos-1-(fpos-1));
              pufflen:=pufflen-(gelesen+lpos-1-(fpos-1));
              if gelesen=lies then       { Dateiende noch nicht erreicht}
                blockread(edat,buffer[maxbuff-(fpos-2)],fpos-1,gelesen)
              else
                gelesen:=0;              { Dateiende erreicht}
              pufflen:=pufflen+gelesen;
            end;
            {-- Der gefundene String steht auf pos1...}
            move(buffer[2],buffer[1],maxbuff-1);
            move(UpcBuffer[2],UpCbuffer[1],maxbuff-1);
            inc(Chkpos,1);
            lies:=1;
            lpos:=maxbuff-1;
            fpos:=0;
          end
          else
            fpos:=-1; { Abbruchbedingung }
        end;
      end;
    until eof(edat) and (fpos=-1) ;
    close(edat);
  end;
  result:=pPosListrec;
end;{-- Get_StringPosList -----------------------------------------------}

Und bitte nicht hauen, ich weis das es nicht schön ist, sonst hätt ich es auch nicht angepackt.

Gruß
K-H

Da fehlt noch was:

Delphi-Quellcode:

T_PosListrec= record
                   Filename : string[255];
                   Positions: array of Longint; {0 - Zähler,1..n Posdaten ; Longint dami Dateien>2Gig verarbeitbar sind }
                 end;
  T_pPoslistrec=^T_PosListrec;