SY-26 US-English INDEXER [ Sort Method ] by Erdogan Tan

FILE: ADDRESS.BAS [ ADDRESS 417 Version 2.3 ]

Option Explicit

Type AddressRecord
     TypeChr As String * 1
     Code As String * 20
     Name As String * 40
     Address1 As String * 40
     Address2 As String * 40
     Ward As String * 15
     City As String * 15
     Country As String * 15
     Post As String * 5
     Telephone As String * 35
     Fax As String * 19
     Tax1 As String * 17
     Tax2 As String * 13
     Profession As String * 40
     Special As String * 40
     Previous As Integer
     Next As Integer
     Password As String * 7
     HiddenInfo As String * 146
End Type

Type IndexRecord
     First As Integer
     Last As Integer
End Type

Global Const KEY_UP = &H26
Global Const KEY_DOWN = &H28
Global Const KEY_PRIOR = &H21
Global Const KEY_NEXT = &H22
Global Const KEY_HOME = &H24
Global Const KEY_END = &H23
Global Const KEY_F1 = &H70
Global Const KEY_F2 = &H71
Global Const KEY_F3 = &H72
Global Const KEY_F4 = &H73
Global Const KEY_F5 = &H74
Global Const KEY_F6 = &H75
Global Const KEY_F7 = &H76
Global Const KEY_F8 = &H77
Global Const KEY_F9 = &H78
Global Const KEY_F10 = &H79
Global Const KEY_F11 = &H7A
Global Const KEY_F12 = &H7B
Global Const KEY_ESCAPE = &H1B
Global Address As AddressRecord
Global Index As IndexRecord
Global Table As String * 112
Global FileNo As Integer
Global LastRecord As Integer
Global ActiveRecord As Integer
Global IndexFileNo As Integer
Global IndexRecordNo As Integer
Global Telephone As Integer
Global Listed As Integer
Global LstFileNo As Integer
Global PrnTheDate As String
Global PrnDay As String

Public Sub Indexer()
Rem SY-26 INDEXER [ US English Alphabetical Sorter ] © Erdogan Tan - June 9, 2001
Rem "SORT Method 26" [ "SIRALAMA Yöntemi 26" in Turkish ]
Rem SY-26 INDEXER SUBROUTINE Version 1.0 [ 9-June-2001 ]
Dim SearchedRecordNo As Integer
Dim NextPointer As Integer
Dim ActiveCode As String
Dim SearchedCode As String
Get #FileNo, ActiveRecord, Address
ActiveCode = UCase(Trim$(Address.Code))
IndexRecordNo = Asc(Left$(ActiveCode, 1)) + 1
Get #IndexFileNo, IndexRecordNo, Index
If Index.First = 0 Or Index.Last = 0 Then
   Index.First = ActiveRecord
   Index.Last = ActiveRecord
   Put #IndexFileNo, IndexRecordNo, Index
   SearchedRecordNo = IndexRecordNo
ScanPrevIndexRecord:
   If SearchedRecordNo > 1 Then
      SearchedRecordNo = SearchedRecordNo - 1
      Get #IndexFileNo, SearchedRecordNo, Index
      If Index.Last > 0 Then
         NextPointer = Index.Last
         Get #FileNo, NextPointer, Address
         Address.Next = ActiveRecord
         Put #FileNo, NextPointer, Address
         Get #FileNo, ActiveRecord, Address
         Address.Previous = NextPointer
         Put #FileNo, ActiveRecord, Address
      Else
         GoTo ScanPrevIndexRecord
      End If
   Else
      Get #FileNo, ActiveRecord, Address
      Address.Previous = ActiveRecord
      Put #FileNo, ActiveRecord, Address
   End If
   SearchedRecordNo = IndexRecordNo
ScanNextIndexRecord:
   If SearchedRecordNo < 256 Then
      SearchedRecordNo = SearchedRecordNo + 1
      Get #IndexFileNo, SearchedRecordNo, Index
      If Index.First > 0 Then
         NextPointer = Index.First
         Get #FileNo, NextPointer, Address
         Address.Previous = ActiveRecord
         Put #FileNo, NextPointer, Address
         Get #FileNo, ActiveRecord, Address
         Address.Next = NextPointer
         Put #FileNo, ActiveRecord, Address
      Else
         GoTo ScanNextIndexRecord
      End If
   Else
      Get #FileNo, ActiveRecord, Address
      Address.Next = ActiveRecord
      Put #FileNo, ActiveRecord, Address
   End If
Else
   SearchedRecordNo = Index.Last
   Get #FileNo, SearchedRecordNo, Address
   SearchedCode = UCase(Trim$(Address.Code))
   If ActiveCode >= SearchedCode Then
ChangeIndexLast:
      Index.Last = ActiveRecord
      Put #IndexFileNo, IndexRecordNo, Index
      If Address.Next = SearchedRecordNo Then
         Address.Next = ActiveRecord
         Put #FileNo, SearchedRecordNo, Address
         Get #FileNo, ActiveRecord, Address
         Address.Previous = SearchedRecordNo
         Address.Next = ActiveRecord
         Put #FileNo, ActiveRecord, Address
      Else
         NextPointer = Address.Next
         Address.Next = ActiveRecord
         Put #FileNo, SearchedRecordNo, Address
         If NextPointer = 0 Or NextPointer > LastRecord Then
            NextPointer = ActiveRecord
         Else
            Get #FileNo, NextPointer, Address
            Address.Previous = ActiveRecord
            Put #FileNo, NextPointer, Address
         End If
         Get #FileNo, ActiveRecord, Address
         Address.Previous = SearchedRecordNo
         Address.Next = NextPointer
         Put #FileNo, ActiveRecord, Address
      End If
      Exit Sub
   Else
      If Index.First = SearchedRecordNo Then
ChangeIndexFirst:
         Index.First = ActiveRecord
         Put #IndexFileNo, IndexRecordNo, Index
         If Address.Previous = SearchedRecordNo Then
            Address.Previous = ActiveRecord
            Put #FileNo, SearchedRecordNo, Address
            Get #FileNo, ActiveRecord, Address
            Address.Previous = ActiveRecord
            Address.Next = SearchedRecordNo
            Put #FileNo, ActiveRecord, Address
         Else
            NextPointer = Address.Previous
            Address.Previous = ActiveRecord
            Put #FileNo, SearchedRecordNo, Address
            If NextPointer = 0 Or NextPointer > LastRecord Then
               NextPointer = ActiveRecord
            Else
               Get #FileNo, NextPointer, Address
               Address.Next = ActiveRecord
               Put #FileNo, NextPointer, Address
            End If
            Get #FileNo, ActiveRecord, Address
            Address.Previous = NextPointer
            Address.Next = SearchedRecordNo
            Put #FileNo, ActiveRecord, Address
         End If
         Exit Sub
      End If
   End If
   SearchedRecordNo = Index.First
   Get #FileNo, SearchedRecordNo, Address
   SearchedCode = UCase(Trim$(Address.Code))
   NextPointer = Address.Next
   If ActiveCode < SearchedCode Then
      GoTo ChangeIndexFirst
   Else
NextRecordForChange:
      SearchedRecordNo = NextPointer
      Get #FileNo, SearchedRecordNo, Address
      SearchedCode = UCase(Trim$(Address.Code))
      NextPointer = Address.Next
      If ActiveCode < SearchedCode Then
         NextPointer = Address.Previous
         Address.Previous = ActiveRecord
         Put #FileNo, SearchedRecordNo, Address
         If NextPointer > 0 Or NextPointer <= LastRecord Then
            Get #FileNo, NextPointer, Address
            Address.Next = ActiveRecord
            Put #FileNo, NextPointer, Address
         Else
            NextPointer = ActiveRecord
         End If
         Get #FileNo, ActiveRecord, Address
         Address.Previous = NextPointer
         Address.Next = SearchedRecordNo
         Put #FileNo, ActiveRecord, Address
      Else
         If NextPointer <> SearchedRecordNo Then
            GoTo NextRecordForChange
         Else
            Address.Next = ActiveRecord
            Put #FileNo, SearchedRecordNo, Address
            Get #FileNo, ActiveRecord, Address
            Address.Previous = SearchedRecordNo
            Address.Next = ActiveRecord
            Put #FileNo, ActiveRecord, Address
         End If
      End If
   End If
End If
End Sub

FILE: SERVICE.FRM [ ADDRESS 417 Version 2.3 ]

Private Sub Rebuild()
Dim OldFileNo As Integer
Dim OldLastRecord As Integer
Dim Ascii As Integer
Dim PreviousPointer As Integer
Dim NextPointer As Integer
Close #FileNo
Close #IndexFileNo
If Dir("417ADRES.DAT") = "417ADRES.DAT" Then Kill "417ADRES.DAT"
Name "ADRES417.DAT" As "417ADRES.DAT"
If Dir("417ADRES.IND") = "417ADRES.IND" Then Kill "417ADRES.IND"
FileCopy "ADRES417.IND", "417ADRES.IND"
OldFileNo = FreeFile
RecordLenght = Len(Address)
Open "417ADRES.DAT" For Random As OldFileNo Len = RecordLenght
OldLastRecord = FileLen("417ADRES.DAT") / RecordLenght
FileNo = FreeFile
Open "ADRES417.DAT" For Random As FileNo Len = RecordLenght
IndexFileNo = FreeFile
Open "ADRES417.IND" For Random As IndexFileNo Len = 4
For IndexRecordNo = 1 To 256
    Index.First = 0
    Index.Last = 0
    Put #IndexFileNo, IndexRecordNo, Index
Next IndexRecordNo
LastRecord = 0
RecordNo = 1
GetNextRecord:
If RecordNo <= OldLastRecord Then
   frmService.Caption = " Record: " + Str$(RecordNo) + " / " + Str$(OldLastRecord)
   Get #OldFileNo, RecordNo, Address
   Ascii = Asc(Address.TypeChr)
   If Ascii < 48 Or Ascii > 57 Or Trim$(Address.Code) = "" Then
      RecordNo = RecordNo + 1
      GoTo GetNextRecord
   End If
   LastRecord = LastRecord + 1
   ActiveRecord = LastRecord
   Address.Previous = 0
   Address.Next = 0
   Put #FileNo, ActiveRecord, Address
   Indexer
   iboxCurrent.Text = ActiveRecord
   iboxPrevious.Text = Address.Previous
   iboxNext.Text = Address.Next
   iboxPointer.Text = ActiveRecord
   iboxCode.Text = Address.Code
   iboxType.Text = Address.TypeChr
   iboxCurrentCode.Text = Address.Code
   iboxCurrentName.Text = Address.Name
   PreviousPointer = Address.Previous
   NextPointer = Address.Next
   If PreviousPointer > 0 And PreviousPointer <= LastRecord Then
      Get #FileNo, PreviousPointer, Address
      iboxPreviousCode.Text = Address.Code
      iboxPreviousName.Text = Address.Name
   Else
      iboxPreviousCode.Text = "?"
      iboxPreviousName.Text = "?"
   End If
   If NextPointer > 0 And NextPointer <= LastRecord Then
      Get #FileNo, NextPointer, Address
      iboxNextCode.Text = Address.Code
      iboxNextName.Text = Address.Name
   Else
      iboxNextCode.Text = "?"
      iboxNextName.Text = "?"
   End If
   RecordNo = RecordNo + 1
   GoTo GetNextRecord
End If
Close #OldFileNo
RecordNo = ActiveRecord
frmService.Caption = "Rebuilding is OK..."
iboxPointer.SetFocus
End Sub

FILE: ADDRESS.FRM [ ADDRESS 417 Version 2.3 ]

Private Sub AlphabeticMovement(MovementType As Integer)
Dim PrevPointer As Integer
Dim NextPointer As Integer
Dim RndPointer As Integer
IndexRecordNo = Asc(Left$(LTrim$(Address.Code), 1)) + 1
MousePointer = 0
ErrorType = 0
If MovementType = 1 Then
   If AbcFirstRecord < 1 Then
      FindAbcFirstLast (1)
   End If
   If ErrorType > 0 Then GoTo Error
   RecordNo = AbcFirstRecord
   cmdPrevious.Enabled = False
   If AbcFirstRecord <> AbcLastRecord Then
      cmdNext.Enabled = True
   End If
Repeat_1:
   If RecordNo > LastRecord Or RecordNo < 1 Then
      ErrorType = 3
      GoTo Error
   End If
   Get #FileNo, RecordNo, Address
   PrevPointer = Address.Previous
   NextPointer = Address.Next
   AsciiType = Asc(Address.TypeChr)
   TypeNo = AsciiType - 48
   If RecordNo = AbcFirstRecord Or RecordNo = PrevPointer Then
      cmdPrevious.Enabled = False
   Else
      cmdPrevious.Enabled = True
      If RecordNo = AbcLastRecord Or RecordNo = NextPointer Then
         cmdNext.Enabled = False
      Else
         cmdNext.Enabled = True
      End If
   End If
   If AsciiType < 48 Or AsciiType > 57 Then
      If RecordNo = NextPointer Or RecordNo = AbcLastRecord Then
         ErrorType = 4
         GoTo Error
      End If
      RecordNo = NextPointer
      GoTo Repeat_1
   Else
      If TypeNo > 3 Then
         optPerson.Value = True
      Else
         optCompany.Value = True
      End If
      iboxCode.Text = Trim$(Address.Code)
      iboxName.Text = Trim$(Address.Name)
      iboxAddress1.Text = Trim$(Address.Address1)
      iboxAddress2.Text = Trim$(Address.Address2)
      iboxWard.Text = Trim$(Address.Ward)
      iboxCity.Text = Trim$(Address.City)
      iboxCountry.Text = Trim$(Address.Country)
      iboxPost.Text = Trim$(Address.Post)
      iboxTelephone.Text = Trim$(Address.Telephone)
      iboxFax.Text = Trim$(Address.Fax)
      iboxTax1.Text = Trim$(Address.Tax1)
      iboxTax2.Text = Trim$(Address.Tax2)
      iboxProfession.Text = Trim$(Address.Profession)
      iboxSpecial.Text = Trim$(Address.Special)
   End If
Else
   If MovementType = 4 Then
      If AbcLastRecord = 0 Or AbcLastRecord > LastRecord Then
         FindAbcFirstLast (4)
      End If
      If ErrorType > 0 Then GoTo Error
      RecordNo = AbcLastRecord
      cmdNext.Enabled = False
      If AbcLastRecord <> AbcFirstRecord Then
         cmdPrevious.Enabled = True
      End If
Repeat_4:
      If RecordNo < 1 Or RecordNo > LastRecord Then
         ErrorType = 5
         GoTo Error
      End If
      Get #FileNo, RecordNo, Address
      PrevPointer = Address.Previous
      NextPointer = Address.Next
      AsciiType = Asc(Address.TypeChr)
      TypeNo = AsciiType - 48
      If RecordNo = AbcLastRecord Or RecordNo = NextPointer Then
         cmdNext.Enabled = False
      Else
         cmdNext.Enabled = True
         If RecordNo = AbcFirstRecord Or RecordNo = PrevPointer Then
            cmdPrevious.Enabled = False
         Else
            cmdPrevious.Enabled = True
         End If
      End If
      If AsciiType < 48 Or AsciiType > 57 Then
         If RecordNo = PrevPointer Or RecordNo = AbcFirstRecord Then
            ErrorType = 6
            GoTo Error
         End If
         RecordNo = PrevPointer
         GoTo Repeat_4
      Else
         If TypeNo > 3 Then
            optPerson.Value = True
         Else
            optCompany.Value = True
         End If
         iboxCode.Text = Address.Code
         iboxName.Text = Address.Name
         iboxAddress1.Text = Address.Address1
         iboxAddress2.Text = Address.Address2
         iboxWard.Text = Address.Ward
         iboxCity.Text = Address.City
         iboxCountry.Text = Address.Country
         iboxPost.Text = Address.Post
         iboxTelephone.Text = Address.Telephone
         iboxFax.Text = Address.Fax
         iboxTax1.Text = Address.Tax1
         iboxTax2.Text = Address.Tax2
         iboxProfession.Text = Address.Profession
         iboxSpecial.Text = Address.Special
      End If
   Else
      If MovementType = 2 Or MovementType = 3 Then GoTo ForwardBackward
   End If
End If
GoTo Finish
ForwardBackward:
If RecordNo < 1 Then
   RecordNo = AbcFirstRecord
   Address.Previous = AbcFirstRecord
   ErrorType = 7
   GoTo Error
Else
   If RecordNo > LastRecord Then
      RecordNo = AbcLastRecord
      Address.Next = AbcLastRecord
      ErrorType = 8
      GoTo Error
   End If
End If
Get #FileNo, RecordNo, Address
If MovementType = 2 Then
   RndPointer = Address.Previous
Else
   RndPointer = Address.Next
End If
If RndPointer < 1 Or RndPointer > LastRecord Then
   ErrorType = 9
   GoTo Error
End If
Get #FileNo, RndPointer, Address
AsciiType = Asc(Address.TypeChr)
TypeNo = AsciiType - 48
If AsciiType < 48 Or AsciiType > 57 Then
   ErrorType = 10
   GoTo Error
End If
If RndPointer = AbcFirstRecord Or Address.Previous = RndPointer Then
   If MovementType = 2 Then cmdPrevious.Enabled = False
Else
   cmdPrevious.Enabled = True
   If RndPointer = AbcLastRecord Or Address.Next = RndPointer Then
      If MovementType = 3 Then cmdNext.Enabled = False
   Else
      cmdNext.Enabled = True
   End If
End If
If TypeNo > 3 Then
   optPerson.Value = True
Else
   optCompany.Value = True
End If
iboxCode.Text = Address.Code
iboxName.Text = Address.Name
iboxAddress1.Text = Address.Address1
iboxAddress2.Text = Address.Address2
iboxWard.Text = Address.Ward
iboxCity.Text = Address.City
iboxCountry.Text = Address.Country
iboxPost.Text = Address.Post
iboxTelephone.Text = Address.Telephone
iboxFax.Text = Address.Fax
iboxTax1.Text = Address.Tax1
iboxTax2.Text = Address.Tax2
iboxProfession.Text = Address.Profession
iboxSpecial.Text = Address.Special
RecordNo = RndPointer
Finish:
If TypeNo = 0 Or TypeNo = 4 Then
    OptPrivate.Value = True
Else
   If TypeNo = 1 Or TypeNo = 5 Then
       OptCustomer.Value = True
   Else
       OptSupplier.Value = True
   End If
End If
PassIt:
If RecordSaved = False Then frmAddress.Caption = " ADDRESS 417 Version 2.3  Record :" + Str$(RecordNo) + " /" + Str$(LastRecord)
If RecordNo > 0 And RecordNo <= LastRecord Then
   ActiveRecord = RecordNo
   CodeChanged = False
   AddressCode = Address.Code
Else
   iboxCode.Text = ""
   iboxName.Text = ""
   iboxAddress1.Text = ""
   iboxAddress2.Text = ""
   iboxWard.Text = ""
   iboxCity.Text = ""
   iboxCountry.Text = ""
   iboxPost.Text = ""
   iboxTelephone.Text = ""
   iboxFax.Text = ""
   iboxTax1.Text = ""
   iboxTax2.Text = ""
   iboxProfession.Text = ""
   iboxSpecial.Text = ""
   frmAddress.Caption = " ADDRESS 417 Version 2.3"
End If
Search = False
NewRecord = False
RecordSaved = False
iboxCode.SetFocus
Exit Sub
Error:
If ErrorType > 0 Then
   MsgBox ("Error Number :" + Str$(ErrorType)), 48, "! ALPHABETICAL INDEXING ERROR !"
   If MovementType < 3 Then
      cmdPrevious.Enabled = False
   Else
      cmdNext.Enabled = False
   End If
   GoTo PassIt
End If
End Sub

Private Sub FindAbcFirstLast(MovementType As Integer)
If MovementType = 4 Then GoTo FindLastRecordPointer
IndexRecordNo = 1
NextIndexFirstRecord:
Get #IndexFileNo, IndexRecordNo, Index
If Index.First > 0 And Index.First <= LastRecord Then
   AbcFirstRecord = Index.First
Else
  If IndexRecordNo < 256 Then
     IndexRecordNo = IndexRecordNo + 1
     GoTo NextIndexFirstRecord
  Else
     AbcFirstRecord = 0
     ErrorType = 1
  End If
End If
If MovementType = 1 Then Exit Sub
FindLastRecordPointer:
IndexRecordNo = 256
PrevIndexLastRecord:
Get #IndexFileNo, IndexRecordNo, Index
If Index.Last > 0 And Index.Last <= LastRecord Then
   AbcLastRecord = Index.Last
Else
   If IndexRecordNo > 1 Then
      IndexRecordNo = IndexRecordNo - 1
      GoTo PrevIndexLastRecord
   Else
       AbcLastRecord = 0
       ErrorType = 2
   End If
End If
End Sub

***

Read sy-32.html for other SY-26/SY-32 snippets and Turkish based sort method.

Return to adres417.html