Board index » delphi » Comparing strings by alphabetical order

Comparing strings by alphabetical order

Hi!

I hope that someone can solve my problem:
I wrote a program that uses strings and I want to sort them by the
alphabetical order but the function that I use, srtcomp, only compares
the length of one string with the other. I looked at the procedures and
functions in the strings unit but I couldn't find a function that do so.

Thanks

 

Re:Comparing strings by alphabetical order


Quote
Benny Hochner wrote:
> I hope that someone can solve my problem:
> I wrote a program that uses strings and I want to sort them by the
> alphabetical order but the function that I use, srtcomp, only compares
> the length of one string with the other. I looked at the procedures and
> functions in the strings unit but I couldn't find a function that do so.

This works for me under Turbo Pascal (real mode) and Borland Pascal
(protect mode):

var
  s1,s2: string;
begin
  ...
  if s1<s2 then writeln('s1 comes first')
  else writeln('s2 comes first');
  ...
end.

     - Rich

Re:Comparing strings by alphabetical order


Hi!

I hope that someone can solve my problem:
I wrote a program that uses strings and I want to sort them by the
alphabetical order but the function that I use, srtcomp, only compares
the length of one string with the other. I looked at the procedures and
functions in the strings unit but I couldn't find a function that do so.

Thanks

Re:Comparing strings by alphabetical order


Quote
Benny Hochner wrote:
> I hope that someone can solve my problem:
> I wrote a program that uses strings and I want to sort them by the
> alphabetical order but the function that I use, srtcomp, only compares
> the length of one string with the other. I looked at the procedures and
> functions in the strings unit but I couldn't find a function that do so.

This works for me under Turbo Pascal (real mode) and Borland Pascal
(protect mode):

var
  s1,s2: string;
begin
  ...
  if s1<s2 then writeln('s1 comes first')
  else writeln('s2 comes first');
  ...
end.

     - Rich

Re:Comparing strings by alphabetical order


Quote
> I hope that someone can solve my problem:
> I wrote a program that uses strings and I want to sort them by the
> alphabetical order but the function that I use, srtcomp, only compares
> the length of one string with the other. I looked at the procedures and
> functions in the strings unit but I couldn't find a function that do so.

The strings-unit isn't thought to handle normal Pascal-strings but PChars,
which are used to store C-Strings (ending with #00). If you're using
standard Pascal-strings you can simply compare them by using the '<' and
'>' operators:

VAR s1, s2: string;

begin
  write ('Enter the first string: ');
  readln (s1);
  write ('Enter the second string: ');
  readln (s2);
  if s1<s2 then
    begin
      {...}
    end else
    begin
      {...}
    end;
end.

    Bye,
      Ingo

Re:Comparing strings by alphabetical order


Quote
> I hope that someone can solve my problem:
> I wrote a program that uses strings and I want to sort them by the
> alphabetical order but the function that I use, srtcomp, only compares
> the length of one string with the other. I looked at the procedures and
> functions in the strings unit but I couldn't find a function that do so.

The strings-unit isn't thought to handle normal Pascal-strings but PChars,
which are used to store C-Strings (ending with #00). If you're using
standard Pascal-strings you can simply compare them by using the '<' and
'>' operators:

VAR s1, s2: string;

begin
  write ('Enter the first string: ');
  readln (s1);
  write ('Enter the second string: ');
  readln (s2);
  if s1<s2 then
    begin
      {...}
    end else
    begin
      {...}
    end;
end.

    Bye,
      Ingo

Re:Comparing strings by alphabetical order


In article <364DADDB.40269...@lobster.ls.huji.ac.il>,
Benny Hochner  <ben...@lobster.ls.huji.ac.il> wrote:
:I wrote a program that uses strings and I want to sort them by the
:alphabetical order but the function that I use, srtcomp, only compares

 72) Where to I find the different sorting source codes?

 151578 Oct 10 1998 ftp://garbo.uwasa.fi/pc/link/tsfaqp.zip
 tsfaqp.zip Common Turbo Pascal Questions and Timo's answers, linked

   All the best, Timo

....................................................................
Prof. Timo Salmi   Co-moderator of news:comp.archives.msdos.announce
Moderating at ftp:// & http://garbo.uwasa.fi/ archives 193.166.120.5
Department of Accounting and Business Finance  ; University of Vaasa
mailto:t...@uwasa.fi <http://www.uwasa.fi/~ts/>  ; FIN-65101,  Finland

Spam foiling in effect.  My email filter autoresponder will return a
required email password to users not yet in the privileges database.
Advice on spam foiling at http://www.uwasa.fi/~ts/info/spamfoil.html

Re:Comparing strings by alphabetical order


In article <364DADDB.40269...@lobster.ls.huji.ac.il>,
Benny Hochner  <ben...@lobster.ls.huji.ac.il> wrote:
:I wrote a program that uses strings and I want to sort them by the
:alphabetical order but the function that I use, srtcomp, only compares

 72) Where to I find the different sorting source codes?

 151578 Oct 10 1998 ftp://garbo.uwasa.fi/pc/link/tsfaqp.zip
 tsfaqp.zip Common Turbo Pascal Questions and Timo's answers, linked

   All the best, Timo

.....................................................................
Prof. Timo Salmi   Co-moderator of news:comp.archives.msdos.announce
Moderating at ftp:// & http://garbo.uwasa.fi/ archives 193.166.120.5
Department of Accounting and Business Finance  ; University of Vaasa
mailto:t...@uwasa.fi <http://www.uwasa.fi/~ts/>  ; FIN-65101,  Finland

Spam foiling in effect.  My email filter autoresponder will return a
required email password to users not yet in the privileges database.
Advice on spam foiling at http://www.uwasa.fi/~ts/info/spamfoil.html

Re:Comparing strings by alphabetical order


In article <wgcid$$3cNG00$i364E1E9B$i5679$kbest$icom$3e$j00000...@gratisnet.com>,

Quote
Rich Pasco <Rich.Pa...@gn5.gratisnet.com> wrote:
>Benny Hochner wrote:

>> I hope that someone can solve my problem:
>> I wrote a program that uses strings and I want to sort them by the
>> alphabetical order but the function that I use, srtcomp, only compares
>> the length of one string with the other. I looked at the procedures and
>> functions in the strings unit but I couldn't find a function that do so.

>This works for me under Turbo Pascal (real mode) and Borland Pascal
>(protect mode):

>var
>  s1,s2: string;
>begin
>  ...
>  if s1<s2 then writeln('s1 comes first')
>  else writeln('s2 comes first');
>  ...
>end.

Well that strictly does not compare the alphabetical order. It compares
the ASCII order. It makes the difference between upper case and lower
case letters. Also if one uses various accented characters does not sort
them well.  Here is an unit that can be used to compare strings in the
alphabetical order specific to the country where the computer is. For
proper operation it requires Dos 3.3+ and works, at least on my computer,
both on real and protected modes. There was some job to make it work
in PM. Strangely much less work was needed to make the PM version work
under Dos Shell in Windows than under pure DOS.

Note one should only compare the result to zero, not to, say, -1 or
+1.

The unit has also a routine that converts the string to upper case. Note
you may lose accents with it, like => A on CP437.

Unit NatCmp;

interface

function Strcmp(s1,s2:string): integer;
function Upcasestr(s:string):string;
function StrcmpP(s1,s2:string):integer;  { Pascal version }

implementation

uses dos{$ifndef msdos},winapi{$endif};

type Tcollat=record
               size:word;
               table:array [char] of char;
             End;

type Tupcase=record
              size:word;
              table:array [#128..#255] of char;
             End;

var collatptr:^Tcollat;
    upcaseptr:^Tupcase;

{$ifdef msdos}
    ftable:record
              info:byte;
              ptr:pointer;
           End;
{$else}

const StackSize=200;

var regs:record   { for int 31h, ax=300h, simulate RM interrupt }

           rDI,f1,rSI,f2,rBP,f3,f4,f5,rBX,f6,rDX,f7:word;
           rCX,f8,rAX,f9:word;
           flags,rES,rDS,rFS,rGS,rIP,rCS,rSP,rSS:word;
         End;

   FtableSeg,FtableSel:word;

 {RM Segment and PM selector of Ftable (and 200 byte RM stack).
  The offset of Ftable is zero }

{$endif}

{ nro=2, get the upcase ptr, nro=6, get the collat ptr }

Function GetPtr(nro:byte):pointer; assembler;
  asm
  {$ifdef msdos}
  mov bx,$ffff
  mov dx,$ffff
  mov ax,ds
  mov es,ax
  mov di,offset ftable
  mov cx,5
  mov ah,$65
  mov al,nro
  mov ftable.info,al
  int 21h
  mov ax,word ptr [ftable+1]
  mov dx,word ptr [ftable+3]
  {$else}
  mov regs.rbx,$ffff
  mov regs.rdx,$ffff
  mov ax,FtableSeg
  mov regs.res,ax
  mov regs.rdi,0                 { load the register structure }
  mov regs.rcx,5
  mov ax,Ftableseg
  mov regs.rss,ax
  mov regs.rsp,Stacksize
  pushf
  pop regs.flags
  mov ah,$65
  mov al,nro
  mov regs.rax,ax

  mov es,FtableSel
  mov es:[0],al
  mov bx,21h                   { bl:=int no, bh:=0 }
  mov ax,ds                    { es:di -> regs }
  mov es,ax
  mov di,offset regs
  mov ax,300h                  { simulate the int 21h call }
  int 31h

  mov es,FtableSel
  mov bx,word ptr es:[3]
  mov ax,2                    { Convert the segment into a selector }
  int 31h
  mov dx,ax
  mov ax,word ptr es:[1]
  {$endif}
End;

{ Create dummy tables for DOS versions before 3.30 }

Procedure MakeTables;
var c:char;
begin
  new(upcaseptr);
  with upcaseptr^ do
    for c:=#128 to #255 do table[c]:=c;
  new(collatptr);
  with collatptr^ do
    for c:=#0 to #255 do table[c]:=upcase(c);
End;

function StrcmpP(s1,s2:string):integer;
var x:integer;
    l,i:word;
begin
  l:=length(s1);
  if l>length(s1) then l:=length(s2);
  with collatptr^ do
    for i:=1 to l do
      if s1[i]<>s2[i] then begin
         x:=ord(table[s1[i]])-ord(table[s2[i]]);
         if x<>0 then begin
            strcmpp:=x;
            exit;
         End;
      End;
  strcmpp:=length(s2)-length(s1);
End;

function Strcmp(s1,s2:string): integer; assembler;
var s:string;
         asm
         push ds
         lds si,s1
         cld
         mov cl,[si]
         xor ch,ch
         inc cx
         mov ax,ss      { copy s1 to s. We need three segments: }
         mov es,ax      { s1, s2, and the collatptr, so by copying }
         lea di,s       { one can use SS for one and DS&ES for the  }
         rep movsb      { others . Otherwise one would have to mess }
         pop ds         { with segments inside the loop }

         push ds
         lds dx,collatptr
         add dx,2

         les di,s2
         lea si,s

         mov cl,es:[di]
         cmp cl,ss:[si]
         jb @ok
         mov cl,ss:[si]
@ok:     inc si
         inc di

@loop:
         segss
         repe cmpsb
         je @done

         mov bl,ss:[si-1]
         xor bh,bh
         add bx,dx           { get the char for s[i] }
         mov al,[bx]

         mov bl,es:[di-1]
         xor bh,bh           { get the ptr to char for s2[i] }
         add bx,dx

         cmp al,[bx]
         jb @less
         ja @greater
         or cx,cx
         jnz @loop

@done:   mov di,word ptr s2
         mov al,byte ptr s
         cmp al,es:[di]
         jb @less
         mov ax,0
         je @out

@greater:
         mov ax,1
         jmp @out

@less:   mov ax,-1
@out:    pop ds
         end;

function Upcasestr(s:string):string;
var i:integer;
begin
  with upcaseptr^ do
    for i:=1 to length(s) do if s[i]>=#128 then s[i]:=table[s[i]]
                                           else s[i]:=upcase(s[i]);
  upcasestr:=s;
End;

var x:longint;

begin
  if swap(dosversion)<$330 then MakeTables
  else begin
    {$ifndef msdos}
    fillchar(regs,sizeof(regs),0);
    x:=globaldosalloc(5+stacksize);  { allocate space for ftable and}
    if x=0 then runerror(255);       { real mode stack }
    FtableSeg:=x shr 16;
    FtableSel:=x and 65535;
    {$endif}
    Collatptr:=GetPtr(6);
    Upcaseptr:=GetPtr(2);
    {$ifndef msdos}
    GlobalDosFree(FtableSel);
    {$endif}
  End;
End.

------------------------------------------------------------------------

Here is a routine that can be used to test it:

{$r+}
uses natcmp;

Var a:array[32..255] of char;
    i,j:word;
    c:char;
    s:array[1..255] of string[60];
    s2:string;
    n,max:word;
    k:word;

begin
  for i:=32 to 255 do a[i]:=chr(i);
  for i:=1 to 255 do s[i]:='';
  for i:=33 to 255 do
    for j:=32 to i-1 do
      if strcmp(a[i],a[j])<0 then begin
         c:=a[i];
         a[i]:=a[j];
         a[j]:=c;
      End;
  j:=1;
  for i:=32 to 255 do begin
     if (i>32) and (strcmp(a[i],a[i-1])>0) then inc(j);
     s[j]:=s[j]+a[i];
  end;
  writeln;
  max:=0;
  for i:=1 to j do if length(s[i])>max then max:=length(s[i]);

  fillchar(s2,sizeof(s2),32);
  s2[0]:=#255;
  inc(max,2);
  n:=80 div max;

  k:=j+1;
  while (k>1) and (length(s[k-1])=1) do dec(k);

  for i:=1 to k-1 do begin
     write(copy(s[i]+s2,1,max));
     if (i mod n=0) and (80 mod max>0) then writeln;
  end;
  writeln;
  writeln;
  Writeln('Rest in order:');
  for i:=k to j do write(s[i]);

  writeln;
end.

Not that even that comparison is perfect. Here it sorts W after V when
they should be equated in Finnish sort.

Osmo

Other Threads