World of Ham Radio 1997/WOHR97_AmSoft_(1997-02-01).iso/amsoft/win95/source.zi_/CALLFIND.BAS

BASIC Source File | 1995-05-04 | 12KB | 400 lines

'AmSoft CallFind Program v1.01 (CALLFIND.COM - CALLFIND.BAS)
'Copyright (C)1995 Alan Freeman, KC5JGP
'Contact Pete DeVolpi KC3TL, AmSoft, World of Ham Radio CD-Rom [phone]
'for permission to use these routines & code for your software that reads the
'cd-rom database.

DEFINT A-Z
DECLARE SUB FindCall (Drive$, Search$, Record AS ANY, Index AS ANY, Record1 AS ANY)
DECLARE FUNCTION ConvCase$ (P$)
DECLARE FUNCTION Exist (File$)
DECLARE FUNCTION FCCDate$ (D$)
DECLARE FUNCTION ProperName$ (Work$)
DECLARE FUNCTION Trim$ (Work$)
CONST False = 0, True = NOT False

   TYPE IndexStructure          '16 bytes total
      Unknown  AS STRING * 4    'Unused
      RecPoint AS STRING * 4    'Record Pointer
      CallSign AS STRING * 7    'Call Sign
      Valid    AS STRING * 1    'CHR$(32) if it's a good record
   END TYPE
   DIM Index AS IndexStructure

   TYPE DataStructure           '131 bytes total
      Address2  AS STRING * 15  'Licensee's Address
      City      AS STRING * 20  'City
      State     AS STRING * 2   'State
      Zip       AS STRING * 10  'Zip code xxxxx-xxxx
      LicClass  AS STRING * 1   'N,T,P,G,A,E
      OldCall   AS STRING * 8   'Old call sign
      Fill      AS STRING * 1   'unused
      CallSign  AS STRING * 8   'Call Sign
      LastName  AS STRING * 20  'Last Name
      Suffix    AS STRING * 4   'Name Suffix Jr Sr III etc
      FirstName AS STRING * 11  'First Name
      Initial   AS STRING * 1   'Middle Initial
      ExpireDay AS STRING * 5   'License Expiration date
      Birthday  AS STRING * 5   'Licensee's Birthday
      Address1  AS STRING * 20  'Licensee's Address
   END TYPE
   DIM Record1 AS DataStructure

   TYPE DataStructure2          '131 bytes total
      CallSign  AS STRING * 8   'Call Sign
      LastName  AS STRING * 20  'Last Name
      Suffix    AS STRING * 4   'Name Suffix Jr Sr III etc
      FirstName AS STRING * 11  'First Name
      Initial   AS STRING * 1   'Middle Initial
      ExpireDay AS STRING * 5   'License Expiration date
      Birthday  AS STRING * 5   'Licensee's Birthday
      Address1  AS STRING * 20  'Licensee's Address
      Address2  AS STRING * 15  'Licensee's Address
      City      AS STRING * 20  'City
      State     AS STRING * 2   'State
      Zip       AS STRING * 10  'Zip code xxxxx-xxxx
      LicClass  AS STRING * 1   'N,T,P,G,A,E
      OldCall   AS STRING * 8   'Old call sign
      Fill      AS STRING * 1   'unused
   END TYPE
   DIM Record AS DataStructure2

   Cmd$ = UCASE$(COMMAND$)   'does user want help?
   Where = INSTR(Cmd$, "?")
   IF Where <> 0 THEN HelpMe = True

   Where = INSTR(Cmd$, "/LPT1")  'route to LPT1
   IF Where <> 0 THEN
      LPT1 = True
      Cmd$ = Trim$(LEFT$(Cmd$, Where - 1) + MID$(Cmd$, Where + 5))
   END IF

   Where = INSTR(Cmd$, "/LPT2")  'route to LPT2
   IF Where <> 0 THEN
      LPT2 = True
      Cmd$ = Trim$(LEFT$(Cmd$, Where - 1) + MID$(Cmd$, Where + 5))
   END IF

   Where = INSTR(Cmd$, "/EXPORT")  'route to file
   IF Where <> 0 THEN
      Export = True
      Cmd$ = Trim$(LEFT$(Cmd$, Where - 1) + MID$(Cmd$, Where + 7))
   END IF

   Where = INSTR(Cmd$, "/LABEL")  'format as a label
   IF Where <> 0 THEN
      Label = True
      Cmd$ = Trim$(LEFT$(Cmd$, Where - 1) + MID$(Cmd$, Where + 6))
   END IF

   Where = INSTR(Cmd$, "/")      'switch and alternate CD drive designation
   Where2 = INSTR(Cmd$, ":")
   IF Where <> 0 AND Where2 <> 0 THEN
      Drive$ = MID$(Cmd$, Where + 1, 2)
      Cmd$ = Trim$(LEFT$(Cmd$, Where - 1) + MID$(Cmd$, Where + 3))
   ELSE
      Drive$ = "D:"
   END IF

HelpHere:
   IF NOT Exist(Drive$ + "callsign.dat") OR HelpMe THEN
      CLS
      IF NOT HelpMe THEN
         PRINT "AmSoft CDRom database not found on drive "; Drive$
         BEEP
         PRINT
      END IF
      PRINT "AmSoft CallFind Program v1.01"
      PRINT "(C)1995 Alan Freeman, KC5JGP."
      PRINT "     Syntax: CALLFIND {callsign} {/E:} {/EXPORT} {/LABEL} {/?}"
      PRINT
      PRINT "     /E: is the CDRom drivespec, if other than D: (default)"
      PRINT "     /EXPORT sends data to a file called CALLFIND.TXT"
      PRINT "     /LABEL  sends only the name/address data to screen or file."
      PRINT "     /LPT1 or /LPT2 sends the data to your printer."
      PRINT
      PRINT "     Example: CALLFIND KC5JGP /F: /EXPORT /LABEL"
      PRINT
      SYSTEM
   END IF

   IF Cmd$ <> "" THEN
      Search$ = Trim$(Cmd$)
   ELSE
      CLS
      INPUT ; "Enter Callsign: ", Search$
      IF Trim$(Search$) = "" THEN HelpMe = True: GOTO HelpHere
      PRINT
   END IF

   Search$ = UCASE$(Search$) 'capitalize
   IF Trim$(Search$) <> "" THEN
      CALL FindCall(Drive$, Search$, Record, Index, Record1)
   END IF

   IF (Export OR LPT1 OR LPT2) AND Search$ <> "" THEN
      FreeOne = FREEFILE

      IF LPT1 THEN
         File$ = "LPT1:"
      ELSEIF LPT2 THEN
         File$ = "LPT2:"
      ELSE
         File$ = "Callfind.TXT"
      END IF

      OPEN File$ FOR OUTPUT AS #FreeOne

      PRINT #FreeOne, Trim$(ConvCase$(Record.FirstName)) + CHR$(32);

      IF Trim$(Record.Initial) <> "" THEN
         PRINT #FreeOne, Record.Initial + CHR$(32);
      END IF
      PRINT #FreeOne, Trim$(ConvCase$(Record.LastName));

      IF Trim$(Record.Suffix) <> "" THEN
         PRINT #FreeOne, CHR$(32) + Trim$(ConvCase$(Record.Suffix));
      END IF
      PRINT #FreeOne, CHR$(44) + CHR$(32) + Record.CallSign

      PRINT #FreeOne, ConvCase$(Record.Address1)

      IF Trim$(Record.Address2) <> "" THEN
         PRINT #FreeOne, ConvCase$(Record.Address2)
      END IF
      PRINT #FreeOne, Trim$(ConvCase$(Record.City)) + CHR$(32);

      PRINT #FreeOne, Record.State + CHR$(32) + CHR$(32);

      PRINT #FreeOne, Record.Zip

      PRINT #FreeOne,

      IF NOT Label THEN
         SELECT CASE Record.LicClass
            CASE "N": Class$ = "Novice"
            CASE "T": Class$ = "Tech No-code"
            CASE "P": Class$ = "Tech-Plus HF"
            CASE "G": Class$ = "General"
            CASE "A": Class$ = "Advanced"
            CASE "E": Class$ = "Extra"
            CASE ELSE
         END SELECT

         PRINT #FreeOne, "License: "; Class$

         PRINT #FreeOne, "Expires: "; FCCDate$(Record.ExpireDay)

         PRINT #FreeOne, "Birth  : "; FCCDate$(Record.Birthday)

         IF Trim$(Record.OldCall) <> "" THEN
            PRINT #FreeOne, "OldCall: "; Record.OldCall
         END IF

         PRINT #FreeOne,
      END IF
   ELSEIF Export AND Search$ = "" THEN

      PRINT #FreeOne, "* * * Call Not Found * * *"

   END IF

   IF NOT Export AND Search$ <> "" THEN
      CLS
      PRINT Trim$(ConvCase$(Record.FirstName)) + CHR$(32);

      IF Trim$(Record.Initial) <> "" THEN
         PRINT Record.Initial + CHR$(32);
      END IF
      PRINT Trim$(ConvCase$(Record.LastName));

      IF Trim$(Record.Suffix) <> "" THEN
         PRINT CHR$(32) + Trim$(ConvCase$(Record.Suffix));
      END IF
      PRINT CHR$(44) + CHR$(32) + Record.CallSign

      PRINT ConvCase$(Record.Address1)

      IF Trim$(Record.Address2) <> "" THEN
         PRINT ConvCase$(Record.Address2)
      END IF
      PRINT Trim$(ConvCase$(Record.City)) + CHR$(32);

      PRINT Record.State + CHR$(32) + CHR$(32);

      PRINT Record.Zip

      PRINT

      IF NOT Label THEN
         SELECT CASE Record.LicClass
            CASE "N": Class$ = "Novice"
            CASE "T": Class$ = "Tech No-code"
            CASE "P": Class$ = "Tech-Plus HF"
            CASE "G": Class$ = "General"
            CASE "A": Class$ = "Advanced"
            CASE "E": Class$ = "Extra"
            CASE ELSE
         END SELECT
         PRINT "License: "; Class$
         PRINT "Expires: "; FCCDate$(Record.ExpireDay)
         PRINT "Birth  : "; FCCDate$(Record.Birthday)
         IF Trim$(Record.OldCall) <> "" THEN
            PRINT "OldCall: "; Record.OldCall
         END IF
         PRINT
      END IF
   ELSEIF NOT Export AND Search$ = "" THEN
      PRINT #FreeOne, "* * * Call Not Found * * *"
   END IF

   IF NOT Export THEN
      PRINT
      PRINT "AmSoft CallFind Program v1.01"
      PRINT "(C)1995 Alan Freeman, KC5JGP."
      PRINT
   END IF
   SYSTEM

FUNCTION ConvCase$ (Work$) STATIC
   Work$ = ProperName(Work$)
   IF INSTR(UCASE$(Work$), "POB") <> 0 THEN
      Where = INSTR(UCASE$(Work$), "POB")
      MID$(Work$, Where, 3) = "POB"
   END IF
   IF INSTR(UCASE$(Work$), "AFB") <> 0 THEN
      Where = INSTR(UCASE$(Work$), "AFB")
      MID$(Work$, Where, 3) = "AFB"
   END IF
   ConvCase$ = Work$
END FUNCTION

FUNCTION Exist (File$)
   Exist = False
   ON LOCAL ERROR GOTO NoFile
   FileNo = FREEFILE
   OPEN File$ FOR RANDOM ACCESS READ SHARED AS #FileNo
   CLOSE #FileNo
   Exist = True
   EXIT FUNCTION

NoFile:
   Exist = False

END FUNCTION

FUNCTION FCCDate$ (D$) STATIC
   Yr$ = LEFT$(D$, 2)
   Leap = 0
   IF VAL(Yr$) MOD 4 = 0 THEN Leap = 1
   D = VAL(MID$(D$, 3))

   M = 0 'Month
   DT = 0
   DO
      M = M + 1
      MT = VAL(MID$("312831303130313130313031", M * 2 - 1, 2))
      DT = DT + MT
      IF Leap AND M = 2 THEN DT = DT + 1
   LOOP WHILE DT < D

   IF DT >= D THEN
      DT = DT - MT
      IF Leap AND M = 2 THEN DT = DT - 1
   END IF

   D = (D - DT) 'Day
   D$ = RIGHT$(CHR$(48) + Trim$(STR$(M)), 2) + CHR$(47)
   D$ = D$ + RIGHT$(CHR$(48) + Trim$(STR$(D)), 2) + CHR$(47) + Yr$
   FCCDate$ = D$
END FUNCTION

SUB FindCall (Drive$, Search$, Record AS DataStructure2, Index AS IndexStructure, Record1 AS DataStructure)

   Handle = FREEFILE
   OPEN Drive$ + "AMSOFT_C.IDX" FOR RANDOM ACCESS READ SHARED AS #Handle LEN = LEN(Index)
   MaxRecs& = LOF(Handle) / 16&
   PrevRec& = 0&
   LastRec& = 0&

FindInIndex:
   SearchRec& = INT((MaxRecs& - LastRec&) / 2) + LastRec&

GetIndex:
   GET #Handle, SearchRec&, Index
   IF Index.Valid <> CHR$(32) THEN
      SearchRec& = SearchRec& + 1
      GOTO GetIndex
   END IF
   Found$ = Trim$(Index.CallSign)
   IF Search$ = Found$ OR ABS(SearchRec& - PrevRec&) < 25 THEN
      GOTO FoundInIndex
   END IF
   PrevRec& = SearchRec&
   IF Found$ > Search$ THEN
      MaxRecs& = PrevRec&
   ELSE
      LastRec& = PrevRec&
   END IF
   GOTO FindInIndex

FoundInIndex:
   Fetch& = CVL(Index.RecPoint)
   CLOSE #Handle

SlideDatabase:
   Handle = FREEFILE
   OPEN Drive$ + "CALLSIGN.DAT" FOR RANDOM ACCESS READ SHARED AS #Handle LEN = 131' LEN(Record)
   GET #Handle, Fetch& + 3, Record1
   Found$ = Trim$(Record1.CallSign)
   IF Found$ = Search$ THEN Place& = Fetch& + 3: GOTO FoundIt
   IF Found$ > Search$ THEN
      DO
         Fetch& = Fetch& - 1
         GET #Handle, Fetch& + 3, Record1
         Found$ = Trim$(Record1.CallSign)
         IF Search$ >= Found$ THEN Place& = Fetch& + 3: GOTO FoundIt
      LOOP
   ELSE
      DO
         Fetch& = Fetch& + 1
         GET #Handle, Fetch& + 3, Record1
         Found$ = Trim$(Record1.CallSign)
         IF Search$ <= Found$ THEN Place& = Fetch& + 3: GOTO FoundIt
      LOOP
   END IF

FoundIt:
   CLOSE #Handle
   IF Search$ <> Found$ THEN
      Search$ = "": EXIT SUB
   END IF
   Handle = FREEFILE
   OPEN Drive$ + "CALLSIGN.DAT" FOR BINARY ACCESS READ SHARED AS #Handle LEN = LEN(Record)
   SEEK #Handle, ((Place& - 1) * 131) + 58
   GET #Handle, , Record
   CLOSE #Handle
END SUB

FUNCTION ProperName$ (Work$)
   ProperName$ = ""
   FOR X = 1 TO LEN(Work$)
      Letter$ = MID$(Work$, X, 1)
      IF Last$ = CHR$(32) OR X = 1 THEN
         MID$(Work$, X, 1) = UCASE$(Letter$)
      ELSE
         IF ASC(Letter$) > 64 AND ASC(Letter$) < 91 THEN
            Letter$ = CHR$(ASC(Letter$) + 32)
            MID$(Work$, X, 1) = Letter$
         END IF
      END IF
      Last$ = Letter$
   NEXT
   ProperName$ = Work$
END FUNCTION

FUNCTION Trim$ (Work$)
   Trim$ = LTRIM$(RTRIM$(Work$))
END FUNCTION