Here is a classic routine for finding duplicates. It has not been tested with
null fields.
// ----------------------------------------------------
// Method: DuplicatesToSet
// Search the current selection for duplicate values in a
field.
//
// INPUT1: Pointer - to field to examine
//
// INPUT2: Text - name of Set to contain duplicates or ""
// The selection will not be changed when a non blank
string is passed.
// In this case the calling method will handle the created
Set.
// Pass an empty string to make this method change the
selection
// to show any duplicates found.
//
// INPUT3: Boolean - True = Sort the array
// Can be False if the selection is already sorted on $1->
//
// {INPUT4}: Boolean - True = Highlight only the duplicate copies
// useful for deleting the duplicates after the procedure
//
// OUTPUT: Longint - Number of records in the set
// ----------------------------------------------------
If (Count parameters>0)
C_POINTER($1; $field; $table)
C_TEXT($2; $DupSet)
C_LONGINT($i; $size; $type)
C_LONGINT($0)
C_BOOLEAN($addFirst; $sortArray; $hilightAll; $4)
$field:=$1
If ($2#"")
$DupSet:=$2
Else
$DupSet:="$DupSet"
End if
$sortArray:=$3
If (Count parameters>3)
$hilightAll:=Not($4)
Else
$hilightAll:=True
End if
ARRAY LONGINT($aFound; 0)
ARRAY LONGINT($aRecs; 0)
$table:=Table(Table($field))
$type:=Type($field->)
Case of // create an array of the correct TYPE, faster than using
pointers
: ($type=Is alpha field) | ($type=Is string var) | ($type=Is
text)
ARRAY TEXT($afieldT; 0)
SELECTION TO ARRAY($table->; $aRecs; $field->; $afieldT)
$type:=1
: ($type=Is longint) | ($type=Is integer) | ($type=Is real) |
($type=Is integer 64 bits) //| ($type=Is Time)
ARRAY REAL($afieldN; 0)
SELECTION TO ARRAY($table->; $aRecs; $field->; $afieldN)
$type:=2
: ($type=Is date)
ARRAY DATE($afieldD; 0)
SELECTION TO ARRAY($table->; $aRecs; $field->; $afieldD)
$type:=3
: ($type=Is boolean)
ARRAY BOOLEAN($afieldB; 0)
SELECTION TO ARRAY($table->; $aRecs; $field->; $afieldB)
$type:=4
: ($type=Is time)
ARRAY LONGINT($afieldL; 0)
SELECTION TO ARRAY($table->; $aRecs; $field->; $afieldL)
$type:=5
Else
$type:=-1
End case
$size:=Size of array($aRecs)
If ($sortArray)
Case of
: ($type=1)
SORT ARRAY($afieldT; $aRecs)
: ($type=2)
SORT ARRAY($afieldN; $aRecs)
: ($type=3)
SORT ARRAY($afieldD; $aRecs)
: ($type=4)
SORT ARRAY($afieldB; $aRecs)
: ($type=5)
SORT ARRAY($afieldL; $aRecs)
End case
End if
$addFirst:=True // add a record to the duplicate array only once
Case of // Search for duplicates
: ($type=1)
For ($i; 2; $size)
If ($aFieldT{$i}=$aFieldT{$i-1})
If ($addFirst & $hilightAll)
APPEND TO ARRAY($aFound;
$aRecs{$i-1})
End if
APPEND TO ARRAY($aFound; $aRecs{$i})
$addFirst:=False
Else
$addFirst:=True
End if
End for
: ($type=2)
For ($i; 2; $size)
If ($aFieldN{$i}=$aFieldN{$i-1})
If ($addFirst & $hilightAll)
APPEND TO ARRAY($aFound;
$aRecs{$i-1})
End if
APPEND TO ARRAY($aFound; $aRecs{$i})
$addFirst:=False
Else
$addFirst:=True
End if
End for
: ($type=3)
For ($i; 2; $size)
If ($aFieldD{$i}=$aFieldD{$i-1})
If ($addFirst & $hilightAll)
APPEND TO ARRAY($aFound;
$aRecs{$i-1})
End if
APPEND TO ARRAY($aFound; $aRecs{$i})
$addFirst:=False
Else
$addFirst:=True
End if
End for
: ($type=4)
For ($i; 2; $size)
If ($aFieldB{$i}=$aFieldB{$i-1})
If ($addFirst & $hilightAll)
APPEND TO ARRAY($aFound;
$aRecs{$i-1})
End if
APPEND TO ARRAY($aFound; $aRecs{$i})
$addFirst:=False
Else
$addFirst:=True
End if
End for
: ($type=5)
For ($i; 2; $size)
If ($aFieldL{$i}=$aFieldL{$i-1})
If ($addFirst & $hilightAll)
APPEND TO ARRAY($aFound;
$aRecs{$i-1})
End if
APPEND TO ARRAY($aFound; $aRecs{$i})
$addFirst:=False
Else
$addFirst:=True
End if
End for
End case
CREATE SET FROM ARRAY($table->; $aFound; $DupSet)
$0:=Records in set($DupSet)
If ($2="") // If no set name was passed, just show the duplicates
USE SET($DupSet)
CLEAR SET($DupSet)
ORDER BY($table->; $field->) // and sort
End if
End if
**********************************************************************
4D Internet Users Group (4D iNUG)
New Forum: https://discuss.4D.com
Archive: http://lists.4d.com/archives.html
Options: https://lists.4d.com/mailman/options/4d_tech
Unsub: mailto:[email protected]
**********************************************************************
