
' Import the SDF file, desalt fragments and export to a new SDF file 

Const Title = "De-Salt SDF File."

Function Main As String
Dim Criterion, TempStr, SdfStr As String
Dim Form, CurPage As Object
Dim UserMess, UserTitleMess As String
Dim FileName, UserText As String
Dim Answer As Integer

  Main="Failed or nothing to do."
  CurPage = ActiveDocument.ActivePage
  FileName="Testfile.sdf"

  Form = ReadForm("Desalt.frm")
  Form.SetStrValue("Remark","         The process may take up to")
  Form.SetStrValue("MoreRemark","              1 min for 20 structures.")

  Do
    Form.SetStrValue("FileName", FileName)
    'Display form
    If Form.ExecForm Then
      FileName=Form.GetStrValue("FileName")
      Criterion=Form.GetStrValue("Criterion")
    Else 
      Exit Function
    End If
  
    If FileName = "" Then 
      FileName = "TestFile.sdf"
    Else
      If Right(FileName, 1) = "\" then 
        FileName = FileName + "TestFile.sdf"
      Else
        FileName = AddDefaultExtension(FileName, "SDF")
      End If
    End If
  
    If not FileExists(FileName) Then
      MessageBox("File  "+FileName+" was not found." + Chr(13)+ "Check the file name, please.","Title", MBB_OK)   
    Else
      UserText = FileName
      Exit Do
    End If
  Loop While True
  If not ImportFromSDFile(UserText, Criterion) Then Exit Function
  Main = "Completed." + Chr(13) + Chr(13) + "You can find the results in the same directory in the Newfile.sdf file."
End Function

Function FileExists(ByVal Dfname As String) As Boolean
Dim fname As String

  FileExists = FindFirst(Dfname, fname)

End Function

Function ImportFromSDFile(FName As String, Criterion As String) As Boolean
Dim NumRec as integer
Dim LineOfRec as string
Dim i, j as integer
Dim x, y, z as double
Dim NumAtoms, NumBonds, NumAdProp, ChiralFlag as integer
Dim AtomName as string
Dim ElNum as integer
Dim ElMass as double
Dim Atom as object
Dim Struct, Mol, Atoms, Conf, Diag as object
Dim NumAtom1, NumAtom2 as integer
Dim BondType as integer
Dim Atom1, Atom2, Bond as object
Dim MinDist as double
Dim TBox as object
const Delimiter = "$$$$"
Dim workpage, NewPage as object
Dim ACharge as integer
Dim NewAtoms as object
Dim TempStr, UserMess, UserText as string
Dim CHGStr as string
Dim BufferFileName as string

        ImportFromSDFile = false
        BufferFileName = GetTempFileName
	UserText = Criterion
	UserMess = UserText
        open FName Access read as #1
        open "NewFile.sdf" access write as #3
        NumRec = 0
L1:        open BufferFileName access write as #2
	   read #1, LineOfRec, 80
	   print #2, LineOfRec	
           read #1, LineOfRec, 80
	   print #2, LineOfRec	
           if DelSpace(LineOfRec) = "" then
		close #1
		close #3
		ImportFromSDFile = true
		exit function
	   end if
           read #1, LineOfRec, 80
	   print #2, LineOfRec	
           read #1, LineOfRec, 80
	   print #2, LineOfRec	
           NumRec = NumRec+1
           NumAtoms = Int(Val(Mid(LineOfRec, 1, 3)))
           NumBonds = Int(Val(Mid(LineOfRec, 4, 3)))
           NumAdProp = Int(Val(Mid(LineOfRec, 31, 3)))
           'MessageBox(Str(NumAtoms) + Chr(13) + Str(NumBonds) + Chr(13) + Str(NumAdProp), "Atoms, Bonds, AdProp = ", MBB_OK )
           ChiralFlag = Int(Val(Mid(LineOfRec, 25, 3)))
           'Read atoms
           Atoms = Assemblies.AddEmpty
           Conf = Atoms.Conformations.AddEmpty
           Mol = Atoms.Molecules.AddEmpty
           for i = 1 to NumAtoms
              read #1, LineOfRec, 80
	      print #2, LineOfRec	
              x = Val(Mid(LineOfRec, 1, 10))
              y = Val(Mid(LineOfRec, 11, 10))
              z = Val(Mid(LineOfRec, 21, 10))
              AtomName = DelSpace(Mid(LineOfRec, 31, 3))
              AtomProperties(AtomName, ElNum, ElMass)
              'MessageBox(Str(ElNum), "ElNum", MBB_OK)
              ACharge = GetTypeOfCharge(Int(Val(Mid(LineOfRec, 37, 3))))
              Atom = NewAtom(ElNum)
	      Atom.SetCharge(ACharge)
              Atoms.Add(Atom)
              Conf.SetAtomXYZ(Atom, x, y, z)
           next i

           'read bonds
           for i = 1 to NumBonds
              read #1, LineOfRec, 80
	      print #2, LineOfRec	
              NumAtom1 = Int(Val(Mid(LineOfRec, 1, 3)))
              NumAtom2 = Int(Val(Mid(LineOfRec, 4, 3)))
              'MessageBox(Str(NumAtom1) + Chr(13) + Str(NumAtom2), "NumAtoms 1 2 =", MBB_OK)
              BondType = SelectTypeBond(Int(Val(Mid(LineOfRec, 7, 3))))
              Atom1 = Atoms.Item(NumAtom1)
              Atom2 = Atoms.Item(NumAtom2)
              Bond = NewBond(Atom1, Atom2, BondType)
              Mol.Add(Bond)
           next i
		CHGStr = ""
		read #1, LineOfRec, 80
		'MessageBox(LineOfRec, "Line=", MBB_OK)
		print #2, LineOfRec
         	while Left(LineOfRec, 1) <> ">"
			if Left(LineOfRec,6) = "M  CHG" then
				CHGStr = Mid(LineOfRec, 7, 73)
				'Messagebox(Str(Len(CHGStr)), "CHGStr=", MBB_OK)
				if Int(Val(Mid(LineOfRec, 7, 3))) <> 0 then
					j = 11
					for i =1 to Int(Val(Mid(LineOfRec, 7, 3))) 
						Atom = Atoms.Item(Int(Val(Mid(LineOfRec, j, 4))))
						j = j+4
						Atom.GetCharge
						ACharge = Int(Val(Mid(LineOfRec, j, 4)))
						Atom.SetCharge(ACharge)
						j = j+4
					next i
				end if	
			end if	
            		read #1, LineOfRec, 80
			print #2, LineOfRec
         	wend
	
	Struct = Atoms.Structures.Derive(Mol, Conf)
	
	MinDist = GetMinBondLength(Conf, Mol)
	if GetMinBondLength(Conf, Mol) > 1.36 then SetBondLenth(Struct, Mol, 1.36)	
        read #1, LineOfRec, 80
	print #2, LineOfRec	
	while Left(LineOfRec, 4) <> "$$$$"
		read #1, LineOfRec, 80
	        print #2, LineOfRec	
	wend
	close #2
	DeSaltFragments(Atoms, UserText, NumRec, CHGStr, BufferFileName)
	DeleteFile(BufferFileName)
	Kill(Atoms)
	GOTO L1
end function

sub DeSaltFragments(MAtoms as object, ByVal Criterion as string, ByVal NumRec as integer, ByVal CHGStr as string, ByVal BufferFileName as string)
Dim Atoms, Mol, Struct as object
Dim Atom, Atom1, Bond as object
Dim Mass1(1000) as integer
Dim Mass2(1000) as integer
Dim n, i, j, ii, NStruct as integer
Dim ANum as integer
Dim P1, P2, Flag as integer
Dim NumAtoms(200) as integer
Dim StructWeight(200) as double
Dim NumDeSaltStruct, MaxEl as integer
Dim RecStr, DeSaltStr, CountStr as string
Dim MaxEl2 as double
Dim Tempstr, TempStr1 as string
Dim NumCHGAtoms as integer
Dim ShiftNumAtom, SNum as integer
	n = MAtoms.Count
	'MessageBox(Str(n), "Matoms.count", MBB_OK)
	for i = 1 to 200
		NumAtoms(i) = 0
		StructWeight(i) = 0.0
	next i	
	for i = 1 to 1000
		Mass1(i) = 0
		Mass2(i) = 0
		'MessageBox(Str(Mass1(i)) + Chr(13) + Str(Mass2(i)), "Mass", MBB_OK)
	next i
	Mol = MAtoms.Molecules.Item(1)
	'MessageBox(Str(Mol.Count), "Mol.count", MBB_OK)
	Atom = MAtoms.Item(1)
	ANum = 1
	NStruct = 1
	P1 = 1
	P2 = 1
	Mass1(P2) = ANum
	Mass2(P2) = NStruct
	P2 = P2+1
	StructWeight(NStruct) = StructWeight(NStruct) + Atom.GetMass + 1.0079*GetImplicitHNum(Atom, Mol)
	NumAtoms(NStruct) = NumAtoms(NStruct) + 1 + GetImplicitHNum(Atom, Mol) 
L1:     Atoms = Mol.AssocAtoms(Atom)
	'if Atoms.Count = 0 then MessageBox(Str(Atoms.Count), "", MBB_OK) 
	if Atoms.Count <> 0 then
		for i = 1 to Atoms.Count
			Atom1 = Atoms.Item(i)
			StructWeight(NStruct) = StructWeight(NStruct) + Atom1.GetMass + 1.0079*GetImplicitHNum(Atom1, Mol)
			NumAtoms(NStruct) = NumAtoms(NStruct) + 1 + GetImplicitHNum(Atom1, Mol)
			ANum = MAtoms.Index(Atom1)
			if not AtomInMass(ANum, Mass1, P1, P2) then
				Mass1(P2) = ANum
				Mass2(P2) = NStruct
				P2 = P2+1
			end if
		next i
	else
		'NStruct = NStruct+1
		P1 = P2
	end if
	if P1 < P2-1 then
		i = P1
		do
			Atom1 = MAtoms.Item(Mass1(i))
			Atoms = Mol.AssocAtoms(Atom1)
			if Atoms.Count <> 0 then
				for j = 1 to Atoms.Count
					Atom1 = Atoms.Item(j)
					ANum = MAtoms.Index(Atom1)		
					if not AtomInMass(ANum, Mass1, P1, P2) then
						Mass1(P2) = ANum
						Mass2(P2) = NStruct
						P2 = P2+1
						StructWeight(NStruct) = StructWeight(NStruct) + Atom1.GetMass + 1.0079*GetImplicitHNum(Atom1, Mol)
						NumAtoms(NStruct) = NumAtoms(NStruct) + 1 + GetImplicitHNum(Atom1, Mol)
					end if
				next j
			end if
			i = i+1
		loop while Mass1(i) <> 0
	end if
		' Find atom not in mass1
		Flag = 0
		for each Atom in MAtoms
			ANum = MAtoms.Index(Atom)
			
			if not AtomInMass(ANum, Mass1, 1, P2) then
				NStruct = NStruct+1
				'MessageBox(Str(ANum), "Atom not in mass", MBB_OK)
				P1 = P2
				Mass1(P2) = ANum
				Mass2(P2) = NStruct
				StructWeight(NStruct) = StructWeight(NStruct) + Atom.GetMass + 1.0079*GetImplicitHNum(Atom, Mol)
				NumAtoms(NStruct) = NumAtoms(NStruct) + 1 + GetImplicitHNum(Atom, Mol)
				P2 = P2+1
				Flag = 1
				exit for
			end if
		next Atom
		if Flag = 1 then GOTO L1
	open BufferFileName access read as #2
	if NStruct = 1 then
		do
			read #2, RecStr, 80
			print #3, RecStr
		loop while Left(RecStr, 4) <> "$$$$"
	else
		if Criterion = "A" or Criterion = "ATOMS" then
			NumDeSaltStruct = 0
			MaxEl = MaxElMass(NumAtoms, NStruct)
			for i = 1 to NStruct
				if NumAtoms(i) = MaxEl then
					NumDeSaltStruct = i
					exit for
				end if
			next i
		else
			MaxEl2 = 0.0
			for i = 1 to NStruct
				if StructWeight(i) >= MaxEl2 then MaxEl2 = StructWeight(i)
			next i
			NumDeSaltStruct = 0
			for i = 1 to NStruct
				
				if StructWeight(i)= MaxEl2 then
					NumDeSaltStruct = i
					exit for
				end if
			next i
		end if
		DeSaltStr = DeSaltMass(Mass1, Mass2, P2, NumDeSaltStruct)
		ShiftNumAtom = Int(Val(Left(DeSaltStr, 3)))-1
		'MessageBox(DeSaltStr, "DeSaltStr=", MBB_OK)
		CountStr = DeSaltAssembly(MAtoms, DeSaltStr)
		'MessageBox(CountStr, "CountStr=", MBB_OK)
		DeSaltSDFile(DeSaltStr, CountStr, CHGStr)
		RecStr = ""
		read #2, RecStr, 80
		while Left(RecStr, 1) <> ">"
			if Left(RecStr, 6) = "M  CHG" then
				'MessageBox(RecStr, "", MBB_OK)
				TempStr = "M  CHG"
				TempStr1 = ""
				'MessageBox(Mid(RecStr, 7, 3), "", MBB_OK)
				if Int(Val(Mid(RecStr, 7, 3))) <> 0 then
					'MessageBox(Mid(RecStr, 7, 3), "<> 0", MBB_OK)
					j = 11
					NumCHGAtoms = 0 
					for i =1 to Int(Val(Mid(RecStr, 7, 3)))
						'MessageBox(Str(Int(Val(Mid(RecStr, 7, 3)))), "<> 0", MBB_OK)
						if InStr(1, DeSaltStr, Mid(RecStr, j, 3)) <> 0 then
							'MessageBox(Mid(RecStr, j+1, 3), "Yes", MBB_OK)
							SNum = InStr(1, DeSaltStr, Mid(RecStr, j, 3)) Mod 3
							if SNum <> 0 then
								SNum = InStr(1, DeSaltStr, Mid(RecStr, j, 3))\3 + 1
							else
								SNum = InStr(1, DeSaltStr, Mid(RecStr, j, 3))\3
							end if
							TempStr1 = TempStr1 + AddSpaces(Str(SNum), 4) + Mid(RecStr, j+3, 4)
							j = j+8
							NumCHGAtoms = NumCHGAtoms+1
						end if
					next i
				end if
				if NumCHGAtoms <> 0 then
					RecStr = TempStr + AddSpaces(Str(NumCHGAtoms), 3) + TempStr1
					print #3, RecStr
				end if
			end if			
			
			read #2, RecStr, 80
		wend 
		print #3, ">  <Mol.Weight>"
		RecStr = Str(StructWeight(NumDeSaltStruct))
		print #3, RecStr
		Print #3, ""
		print #3, ">  <ID>"
		Print #3, Str(NumRec)
		Print #3, ""	
		print #3, "$$$$"
	end if
	close #2
	'Kill(Atoms)
end sub

function DeSaltAssembly(MAtoms as object, Inf as string) as string
Dim MMol, NewAtoms, Atom, Bond as object
Dim TempStr as string
Dim n, i as integer
Dim NumAtoms, NumBonds as integer
	i = 1
	MMol = MAtoms.Molecules.Item(1)
	NumBonds = 0
	NumAtoms = 0
L1:	n = Int(Val(Mid(Inf, i, 3)))
	if n <> 0 then
		NumAtoms = NumAtoms+1
		Atom = MAtoms.Item(n)
		for each Bond in MMol
	 		if Bond.Atom1 = Atom or Bond.Atom2 = Atom then
				Kill(Bond)
				NumBonds = NumBonds+1
			end if
		 next Bond
	i = i+3
	GOTO L1	
	else
		goto L2	
	end if	
L2:	TempStr = AddSpaces(Str(NumAtoms), 3) + AddSpaces(Str(NumBonds), 3)
	DeSaltAssembly = TempStr + "  0  0  0  0  0  0  0  0  0"
end function


function AddSpaces(ByVal s as string,ByVal n as integer)as string
Dim i as integer
Dim TempStr as string
	TempStr = ""
	for i = 1 to n-Len(s)
		TempStr = TempStr + " "
	next i
	AddSpaces = TempStr + s
end function

function DeSaltMass(ByRef M1() as integer, ByRef M2() as integer, ByVal n as integer, ByVal NumStruct as integer) as string
Dim i, j as integer
Dim Tempstr as string
Dim TempMass(n) as integer
	TempStr = ""
	j = 1
	for i = 1 to n
		if M2(i) = NumStruct then
			TempMass(j) = M1(i)
			j = j+1
		end if
	next i
	for i = j to n
		TempMass(i) = 0
	next i
	j = j-1
	ReorderMass(TempMass, j)
	for i = 1 to j
		 TempStr = TempStr + AddSpaces(Str(TempMass(i)), 3)
	next i
	'MessageBox(TempStr, "DeSaltMass=", MBB_OK)
	DeSaltMass = TempStr
end function

sub ReorderMass(ByRef M() as integer, ByVal N as integer)
Dim i as integer
Dim TempEl as integer
Dim A, B as integer
	if N = 1 then
		exit sub
	end if
	A = 1
	B = 1
	do
		B = A+1
		do 
			if M(B) < M(A) then
				TempEl = M(A)
				M(A) = M(B)
				M(B) = TempEl
			end if
			B = B+1
		loop while B <= N
		A = A+1
	loop while A < N
end sub

sub DeSaltSDFile(ByVal s as string, ByVal inf as string, ByVal CHGStr as string)
Dim RecStr, TempStr, tstr as string
Dim j, jj, i, ii, m, n, start, pos as integer
Dim NumBonds, NumAtoms as integer
Dim Mass(1000) as integer
	'Messagebox(s, "s=", MBB_OK)
	for i = 1 to 3
		read #2, RecStr, 80
		print #3, RecStr
	next i
	read #2, RecStr, 80
	print #3, inf
	for i = 1 to 1000
		Mass(i) = 0
	next i
	NumBonds = Int(Val(Mid(inf, 4, 3)))
	NumAtoms = Int(Val(Mid(inf, 1, 3)))
	i = 1
	j = 1
	m = 0
	do
		read #2, RecStr, 80
		if i = Int(Val(Mid(s, j, 3))) then
			pos = AtomInCHGStr(i, CHGStr)
			if pos <> 0 then
				TempStr = Left(RecStr, 36) + AddSpaces(Str(pos), 3) + "  0  0  0"
				print #3, TempStr
			else
				print #3, RecStr		
			end if
			j = j+3
			m = m+1		
		end if
		i = i+1
	loop while m <> NumAtoms
	i = 0
	if NumBonds <> 0 then
		j = 1
		for ii = 1 to NumAtoms
			Mass(ii) =  Int(Val(Mid(s, j, 3)))
			j = j+3
		next ii
		do
			read #2, RecStr, 80
			TempStr = ""
			if InStr(1, s, Mid(RecStr, 1, 3)) <> 0 and InStr(1, s, Mid(RecStr, 4, 3)) <> 0 then
				for jj = 1 to NumAtoms
					if Mass(jj) = Int(Val(Mid(RecStr, 1, 3))) or Mass(jj) = Int(Val(Mid(RecStr, 4, 3))) then
						TempStr = TempStr + AddSpaces(Str(jj), 3)
							
					end if
				next jj
				TempStr = TempStr + Mid(RecStr, 7, 12)
				'MessageBox(RecStr, "RecStr=", MBB_OK)
				print #3, TempStr
				i = i+1	
			end if
		loop while i < NumBonds
	end if
end sub 
 
function AtomInCHGStr(ByVal ANum as integer, ByVal s as string) as integer
Dim i, j, n as integer
Dim tstr as string
Dim Number as integer
	n = Int(Val(Left(s, 3)))
	AtomInCHGStr = 0
	tstr = ""
	if n <> 0 then
		j = 4
		for i = 0 to n-1
			tstr = Mid(s, j, 8)
			Number = Int(Val(Left(tstr,4)))
			if Number = ANum then
				'MessageBox( s + Chr(13) + tstr + Chr(13) + Left(tstr, 4) + Chr(13) + Str(ANum) + Chr(13), "", MBB_OK) 
				AtomInCHGStr = GetImplicitCharge(Int(Val(Right(tstr, 4))))
				exit for
			end if
			j = j + 8
			tstr = ""
		next i
	end if
end function

function AtomInMass(ByVal El as integer, ByRef Mass() as integer, ByVal n1 as integer, Byval n2 as integer) as boolean
Dim i as integer
	AtomInMass = false
	for i = n1 to n2
		if Mass(i) = El then
			AtomInMass = true
			exit function
		end if
	next i
end function

function MaxElMass(ByRef Mass() as integer, ByVal n as integer) as integer
Dim i as integer
Dim El as integer
	El = 0
	for i =1 to n
		if El <= Mass(i) then El = Mass(i)
	next i
	MaxElMass = El
end function

function GetImplicitHNum(Atom as Object, Mol as Object) as Integer
Dim AtomValence, HNum as Integer
Dim Bonds, Bond as Object
Dim N as Integer
	HNum = -1  ' we dont care about attached hydrogens if function returns -1
	AtomValence = GetValence(Atom.GetElNumber)
	if AtomValence > 0 then 
		Bonds = Mol.AssocBonds(Atom)
		N = 0
		for each Bond in Bonds 
			select case Bond.GetBondOrder
				case BO_SINGLE
					N = N + 1
				case BO_DOUBLE
					N = N + 2
				case BO_TRIPLE
					N = N + 3
				case BO_QUARTRY	
					N = N + 4
				case BO_AROMATIC	
					N = N + 1
			end select
		next Bond
		HNum = AtomValence - N + Atom.GetCharge
	end if
	GetImplicitHNum = HNum
end function

function GetTypeOfCharge(ByVal Charge as integer) as integer
Dim n as integer
	select case Charge
		case 1
			n = 3
		case 2
			n = 2
		case 3
			n = 1
		case 5
			n = -1
		case 6
			n = -2
		case 7
			n = -3
		case else
		n = 0
	end select
	GetTypeOfCharge = n
end function 

function GetImplicitCharge(ByVal Charge as integer) as integer
Dim n as integer
	select case Charge
		case 3
			n = 1
		case 2
			n = 2
		case 1
			n = 3
		case -1
			n = 5
		case -2
			n = 6
		case -3
			n = 7
		case else
		n = 0
	end select
	GetImplicitCharge = n
end function 

function GetValence(ByVal elnumber as integer) as integer

	select case elnumber
	case 1, 9, 17, 53
		GetValence=1
	case 8, 16, 34, 52
		GetValence=2
	case 5, 7, 15, 33
		GetValence=3
	case 6,14
		GetValence=4
	case else 
		GetValence=0
	end select
end function

function MinDouble(x1 as double, x2 as double) as double
	if x1 < x2 then MinDouble = x1
	MinDouble = x2
end function


sub SetBondLenth(Struct as object, Mol as object, ByVal Dist as double)
Dim CurBond as object
	for each CurBond in Mol
		Struct.SetBLen(CurBond.Atom1, CurBond.Atom2, Dist)
	next CurBond
end sub

function GetMinBondLength(Conf as Object, Mol as Object) as Double
Dim MinIsFound as Boolean
Dim MinDist, Dist as Double
Dim CurBond as Object
	MinIsFound = False
	MinDist = 0
	for each CurBond in Mol
		Dist = Conf.GetDist(CurBond.Atom1, CurBond.Atom2)
		if (not MinIsFound) or (Dist < MinDist) then MinDist = Dist
		MinIsFound = True
	next CurBond

	GetMinBondLength = MinDist
end function

function SelectTypeBond(ByVal Bond as integer) as integer
Dim TBond as integer
         select case Bond
                  case 1
                    TBond = BO_SINGLE
                  case 2
                    TBond = BO_DOUBLE
                  case 3
                    TBond = BO_TRIPLE
                  case 4
                    TBond = BO_AROMATIC
                  case else
                    TBond = BO_SINGLE
           end select
          SelectTypeBond = TBond
end function

sub AtomProperties(elname as string, elnum as integer, fmass as double)
Dim s as string
  Select Case Ucase(elname)
        Case "H"
          elnum=1 : fmass=1.0079
        Case "D"
          elnum=1 : fmass=2.0100
        Case "T"
          elnum=1 : fmass=3.0200
        Case "HE"
          elnum=2 : fmass=4.0026
        Case "LI"
          elnum=3 : fmass=6.9410
        Case "BE"
          elnum=4 : fmass=9.0122
        Case "B"
          elnum=5 : fmass=10.8110
        Case "C"
          elnum=6 : fmass=12.0107
        Case "N"
          elnum=7 : fmass=14.0067
        Case "O"
          elnum=8 : fmass=15.9994
        Case "F"
          elnum=9 : fmass=18.9984
        Case "NE"
          elnum=10 : fmass=20.1797
        Case "NA"
          elnum=11 : fmass=22.9898
        Case "MG"
          elnum=12 : fmass=24.3050
        Case "AL"
          elnum=13 : fmass=26.9815
        Case "SI"
          elnum=14 : fmass=28.0855
        Case "P"
          elnum=15 : fmass=30.9738
        Case "S"
          elnum=16 : fmass=32.0660
        Case "CL"
          elnum=17 : fmass=35.4527
        Case "AR"
          elnum=18 : fmass=39.9480
        Case "K"
          elnum=19 : fmass=39.0983
        Case "CA"
          elnum=20 : fmass=40.0780
        Case "SC"
          elnum=21 : fmass=44.9559
        Case "TI"
            elnum=22 : fmass=47.8670
        Case "V"
            elnum=23 : fmass=50.9415
        Case "CR"
            elnum=24 : fmass=51.9961
        Case "MN"
            elnum=25 : fmass=54.9380
        Case "FE"
            elnum=26 : fmass=55.8450
        Case "CO"
            elnum=27 : fmass=58.9332
        Case "NI"
            elnum=28 : fmass=58.6934
        Case "CU"
            elnum=29 : fmass=63.5460
        Case "ZN"
            elnum=30 : fmass=65.3900
        Case "GA"
            elnum=31 : fmass=69.7230
        Case "GE"
            elnum=32 : fmass=72.6100
        Case "AS"
            elnum=33 : fmass=74.9216
        Case "SE"
            elnum=34 : fmass=78.9600
        Case "BR"
            elnum=35 : fmass=79.9040
        Case "KR"
            elnum=36 : fmass=83.8000
        Case "RB"
            elnum=37 : fmass=85.4678
        Case "SR"
            elnum=38 : fmass=87.6200
        Case "Y"
            elnum=39 : fmass=88.9058
        Case "ZR"
            elnum=40 : fmass=91.2240
        Case "NB"
            elnum=41 : fmass=92.9064
        Case "MO"
            elnum=42 : fmass=95.9400
        Case "TC"
            elnum=43 : fmass=98.0000
        Case "RU"
            elnum=44 : fmass=101.0700
        Case "RH"
            elnum=45 : fmass=102.9055
        Case "PD"
            elnum=46 : fmass=106.4200
        Case "AG"
            elnum=47 : fmass=107.8682
        Case "CD"
            elnum=48 : fmass=112.4110
        Case "IN"
            elnum=49 : fmass=114.8180
        Case "SN"
            elnum=50 : fmass=118.7100
        Case "SB"
            elnum=51 : fmass=121.7600
        Case "TE"
            elnum=52 : fmass=127.6000
        Case "I"
            elnum=53 : fmass=126.9045
        Case "XE"
            elnum=54 : fmass=131.2900
        Case "CS"
            elnum=55 : fmass=132.9054
        Case "BA"
            elnum=56 : fmass=137.3270
        Case "LA"
            elnum=57 : fmass=138.9055
        Case "CE"
            elnum=58 : fmass=140.1160
        Case "PR"
            elnum=59 : fmass=140.9076
        Case "ND"
            elnum=60 : fmass=144.2400
        Case "PM"
            elnum=61 : fmass=145.0000
        Case "SM"
            elnum=62 : fmass=150.3600
        Case "EU"
            elnum=63 : fmass=151.9640
        Case "GD"
            elnum=64 : fmass=157.2500
        Case "TB"
            elnum=65 : fmass=158.9253
        Case "DY"
            elnum=66 : fmass=162.5
        Case "HO"
            elnum=67 : fmass=164.9303
        Case "ER"
            elnum=68 : fmass=167.2600
        Case "TM"
            elnum=69 : fmass=168.9342
        Case "YB"
            elnum=70 : fmass=173.0400
        Case "LU"
            elnum=71 : fmass=174.9670
        Case "HF"
            elnum=72 : fmass=178.4900
        Case "TA"
            elnum=73 : fmass=180.9479
        Case "W"
            elnum=74 : fmass=183.8400
        Case "RE"
            elnum=75 : fmass=186.2070
        Case "OS"
            elnum=76 : fmass=190.2300
        Case "IR"
            elnum=77 : fmass=192.2170
        Case "PT"
            elnum=78 : fmass=195.0780
        Case "AU"
            elnum=79 : fmass=196.9666
        Case "HG"
            elnum=80 : fmass=200.5900
        Case "TL"
            elnum=81 : fmass=204.3833
        Case "PB"
            elnum=82 : fmass=207.2000
        Case "BI"
            elnum=83 : fmass=208.9804
        Case "PO"
            elnum=84 : fmass=209.0000
        Case "AT"
            elnum=85 : fmass=210.0000
        Case "RN"
            elnum=86 : fmass=222.0000
        Case "FR"
            elnum=87 : fmass=223.0000
        Case "RA"
            elnum=88 : fmass=226.0000
        Case "AC"
            elnum=89 : fmass=227.0000
        Case "TH"
            elnum=90 : fmass=232.0381
        Case "PA"
            elnum=91 : fmass=231.0359
        Case "U"
            elnum=92 : fmass=238.0289
        Case "NP"
            elnum=93 : fmass=237.0000
        Case "PU"
            elnum=94 : fmass=244.0000
        Case "AM"
            elnum=95 : fmass=243.0000
        Case "CM"
            elnum=96 : fmass=247.0000
        Case "BK"
            elnum=97 : fmass=247.0000
        Case "CF"
            elnum=98 : fmass=251.0000
        Case "ES"
            elnum=99 : fmass=252.0000
        Case "FM"
            elnum=100 : fmass=257.0000
        Case "MD"
            elnum=101 : fmass=258.0000
        Case "NO"
            elnum=102 : fmass=259.0000
        Case "LR"
            elnum=103 : fmass=262.0000
        Case "KU"
            elnum=104 : fmass=265.000
        Case else
            elnum=0 : fmass=0.0
  End Select
end sub

function DelSpace(BYVal s as string) as string
Dim SLet as string
Dim i as integer
Dim TempStr as string
        TempStr = ""
        for i = 1 to Len(s)
           SLet = Mid(s, i, 1)
           if SLet <> " " then TempStr = TempStr + SLet
        next i
        DelSpace = TempStr
end function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
function AddDefaultExtension(ByVal FileName As String, ByVal DefExt As String) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LIB0.BAS PROCEDURE                                                  '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If FileName doesn't have extension then add defext extension to it  '
'                                                                     '
' ENTER                                                               '
'     FileName     suppiled file name                                 '
'     DefExt       default file extension                             '
' EXIT                                                                '
'     returns file name appended with extension, if necessary         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Dim PointPos, BackslashPos As Integer
  PointPos = RInStr(FileName, ".")
  If PointPos = 0 Then
    AddDefaultExtension = FileName + "." + DefExt
  Else
    BackslashPos = RInStr(FileName, "\")
    If BackslashPos > PointPos Then 
      AddDefaultExtension = FileName + "." + DefExt
    Else
      AddDefaultExtension = FileName
    End If
  End If
End Function

' Returns the rightmost position of substring SubStr inside string S, 0 if S doesn't contain SubStr
Function RInStr(ByVal S As String, ByVal SubStr As String) As Integer
Dim I As Integer

  I = 0
  Do 
    RInStr = I
    I = InStr(I + 1, S, SubStr)
  Loop While I <> 0

End Function
