8245


<http://delphidabbler.com/tips/172>  
こちらのソースである、SuperSortを使って、文字列をソートしようとしました。  
すると、Delphi7,Lazarusでは正常にソートされるのに、Delphi4ではなぜかInvalid Pointer
Operationの実行時エラーが帰って来て、デバッグもできない状態です。

実際のコードはこれです。

[code]

    uses
      SuperSort;
    
    procedure TForm1.Button1Click;
    var 
      Srt: TSuperSort;
    begin
      Srt := TSuperSort.Create;
      Srt.SortStrings(Memo1.Lines,[],[srtIgnoreBlank]);
      Srt.Free;
    end;
    
[/code]

こちらのユニットのどこを直せばdelphi4でも動くようになりますか?  
よろしくお願い申し上げます。

[code]

    The unit.
    
    unit SuperSort;
    
    interface
    
    uses 
      Classes,SysUtils;
    
    // ==========================================================================
    // Class TSuperSort
    // Mike Heydon Nov 2002
    //
    // Sort class that implements Unix style sorts including ..
    //
    // SWITCHES
    // --------
    // -k [StartPos,EndPos]  - Keyfield to sort on. Start and End pos in string
    // -d [Field Delimiter]  - Delimter to use with -f switch. default = SPACE
    // -f [FieldNumber]      - Zero based field number delimeted by -d
    //
    // OPTIONS SET
    // ============
    // srtDescending         - Sort descending
    // srtIgnoreCase         - Ignore case when sorting
    // srtIgnoreBlank        - Ignore leading blanks
    // srtEvalNumeric        - Treat sort items as NUMERIC
    //
    // ==========================================================================
    
    type
      // Sort Options
      TSuperSortOptions = (
        srtDescending,srtIgnoreCase, srtIgnoreBlank,srtEvalNumeric
      );
      TSuperSortOptionSet = set of TSuperSortOptions;
    
      // ============
      // TSuperSort
      // ============
      TSuperSort = class(TObject)
      protected
        function GetKeyString(const Line : string) : string;
        procedure QuickSortStrA(SL : TStrings);
        procedure QuickSortStrD(SL : TStrings);
        procedure ResolveSwitches(Switches : array of string);
      private
        FSortTime : TDateTime;
        FIsSwitches,
        FIsPositional,
        FIsDelimited,
        FDescending,
        FIgnoreCase,
        FIgnoreBlank,
        FEvalDateTime,
        FEvalNumeric : boolean;
        FFieldNum,
        FStartPos,FEndPos : integer;
        FDelimiter : char;
      public
        procedure SortStrings(StringList : TStrings; Switches : array of string;
          Options : TSuperSortOptionSet = []);
        property SortTime : TDateTime read FSortTime;
      end;
    
    // --------------------------------------------------------------------------
    implementation
    
    const
      BLANK    = -1;
      EMPTYSTR = '';
    
    // ================================================
    // INTERNAL CALL
    // Resolve switches and set internal variables
    // ================================================
    
    procedure TSuperSort.ResolveSwitches(Switches : array of string);
    var
      i : integer;
      Sw,Data : string;
    begin
      FStartPos := BLANK;
      FEndPos := BLANK;
      FFieldNum := BLANK;
      FDelimiter := ' ';
      FIsPositional := false;
      FIsDelimited := false;
    
      for i := Low(Switches) to High(Switches) do
      begin
        Sw := trim(Switches[i]);
        Data := trim(copy(Sw,3,1024));
        Sw := UpperCase(copy(Sw,1,2));
    
        // Delimiter
        if Sw = '-D' then
        begin
          if length(Data) > 0 then FDelimiter := Data[1];
        end;
    
        // Field Number
        if Sw = '-F' then
        begin
          FIsSwitches := true;
          FIsDelimited := true;
          FFieldNum := StrToIntDef(Data,BLANK);
          Assert(FFieldNum <> BLANK,'Invalid -f Switch');
        end;
    
        // Positional Key
        if Sw = '-K' then
        begin
          FIsSwitches := true;
          FIsPositional := true;
          FStartPos := StrToIntDef(trim(copy(Data,1,pos(',',Data) - 1)),BLANK);
          FEndPos := StrToIntDef(trim(copy(Data,pos(',',Data) + 1,1024)),BLANK);
          Assert((FStartPos <> BLANK) and (FEndPos <> Blank),'Invalid -k Switch');
        end;
      end;
    end;
    
    // ====================================================
    // INTERNAL CALL
    // Resolve the Sort Key part of the string based on
    // the Switches parameters
    // ====================================================
    
    function TSuperSort.GetKeyString(const Line : string) : string;
    var
      Key : string;
      Numvar : double;
      DCount, i, DPos : integer;
      Tmp : string;
    begin
      // Default
      Key := Line;
      // Extract Key from switches -k takes precedence
      if FIsPositional then
        Key := copy(Key,FStartPos,FEndPos)
      else
        if FIsDelimited then
        begin
          DPos := 0;
          DCount := 0;
          for i := 1 to length(Key) do
          begin
            if Key[i] = FDelimiter then
             inc(DCount);
            if DCount = FFieldNum then
            begin
               if FFieldNum = 0 then
                 DPos := 1
               else
                 DPos := i + 1;
              break;
            end;
          end;
    
          if DCount < FFieldNum then
            // No such Field Number
            Key := EMPTYSTR
          else
          begin
            Tmp := copy(Key,DPos,4096);
            DPos := pos(FDelimiter,Tmp);
            if DPos = 0 then
              Key := Tmp
            else
              Key := copy(Tmp,1,DPos - 1);
           end;
        end;
    
      // Resolve Options
      if FEvalNumeric then
      begin
        Key := trim(Key);
        // Strip any commas
        for i := length(Key) downto 1 do
          if Key[i] = ',' then delete(Key,i,1);
        try
          Numvar := StrToFloat(Key);
        except
          Numvar := 0.0;
        end;
        Key := FormatFloat('############0.000000',Numvar);
        // Leftpad num string
        Key := StringOfChar('0',20 - length(Key)) + Key;
      end;
    
      // Ignores N/A for Numeric and DateTime
      if not FEvalNumeric and not FEvalDateTime then
      begin
        if FIgnoreBlank then Key := trim(Key);
        if FIgnoreCase then Key := UpperCase(Key);
      end;
    
      Result := Key;
    end;
    
    // ==============================================
    // INTERNAL CALL
    // Recursive STRING quick sort routine ASCENDING.
    // ==============================================
    
    procedure TSuperSort.QuickSortStrA(SL : TStrings);
    
      procedure Sort(l,r : integer);
      var
        i, j : integer;
        x, Tmp : string;
      begin
        i := l;
        j := r;
        x := GetKeyString(SL[(l + r) div 2]);
    
        repeat
          while GetKeyString(SL[i]) < x do
            inc(i);
          while x  < GetKeyString(SL[j]) do 
            dec(j);
          if i <= j then 
          begin
            Tmp := SL[j];
            SL[j] := SL[i];
            SL[i] := Tmp;
            inc(i);
            dec(j);
          end;
        until i > j;
    
        if l < j then
          Sort(l,j);
        if i < r then
          Sort(i,r);
      end;
    
    begin
      if SL.Count > 0 then 
      begin
        SL.BeginUpdate;
        Sort(0,SL.Count - 1);
        SL.EndUpdate;
      end;
    end;
    
    // ==============================================
    // INTERNAL CALL
    // Recursive STRING quick sort routine DECENDING
    // ==============================================
    
    procedure TSuperSort.QuickSortStrD(SL : TStrings);
    
      procedure Sort(l,r : integer);
      var 
        i, j : integer;
        x, Tmp : string;
      begin
        i := l;
        j := r;
        x := GetKeyString(SL[(l + r) div 2]);
    
        repeat
          while GetKeyString(SL[i]) > x do
            inc(i);
          while x  > GetKeyString(SL[j]) do
            dec(j);
          if i <= j then  
          begin
            Tmp := SL[j];
            SL[j] := SL[i];
            SL[i] := Tmp;
            inc(i);
            dec(j);
          end;
        until i > j;
    
        if l < j then
          Sort(l,j);
        if i < r then 
          Sort(i,r);
      end;
    
    begin
      if SL.Count > 0 then
      begin
        SL.BeginUpdate;
        Sort(0,SL.Count - 1);
        SL.EndUpdate;
      end;
    end;
    
    // ====================
    // Sort a stringlist
    // ====================
    
    procedure TSuperSort.SortStrings(StringList : TStrings;
      Switches : array of string; Options : TSuperSortOptionSet = []);
    var
      StartTime : TDateTime;
    begin
      StartTime := Now;
      FDescending := (srtDescending in Options);
      FIgnoreCase := (srtIgnoreCase in Options);
      FIgnoreBlank := (srtIgnoreBlank in Options);
      FEvalNumeric := (srtEvalNumeric in Options);
      ResolveSwitches(Switches);
    
      if FDescending then
        QuickSortStrD(StringList)
      else
        QuickSortStrA(StringList);
    
      FSortTime := Now - StartTime;
    end;
    
    end.
    
[/code]


CC BY-SA 3.0
2015-03-22T12:33:46.943
8236
2015-03-23T03:56:12.447
2015-03-22T15:16:05.917
3639
7602
question
ポインタ delphi
Delphi4にてInvalid Pointer Operation


こんにちは。

[code]

    procedure TSuperSort.ResolveSwitches(Switches : array of string);
    
[/code]

ResolveSwitches() メソッドのパラメータ Switches を **定数パラメータ** に変更してみてください。

[code]

    procedure TSuperSort.ResolveSwitches(const Switches : array of string);
    
[/code]


CC BY-SA 3.0
2015-03-23T03:56:12.447
8245
2015-03-23T03:56:12.447
3573
8236
answer