We Keep Coding

Reimplement an algorithm to create a refine list

I'm trying to reimplement an algorithm to create a refine keywords list. I don't have the original source code, only the tool .exe file, so I only have the input and the expected output.
The problem here is that the output of my function doesn't match with the output of the original one. Here's the code that I'm using:
string[] inputLines = File.ReadAllLines("Input.txt");
Dictionary<string, int> keywordsCount = new Dictionary<string, int>();
List<string> refineList = new List<string>();
//Get Keywords Count
foreach (string fileName in inputLines)
{
string[] fileNameSplitted = fileName.Split('_');
for (int i = 0; i < fileNameSplitted.Length; i++)
{
string currentKeyWord = fileNameSplitted[i];
if (!string.Equals(currentKeyWord, "SFX", StringComparison.OrdinalIgnoreCase))
{
if (keywordsCount.ContainsKey(fileNameSplitted[i]))
{
keywordsCount[fileNameSplitted[i]] += 1;
}
else
{
keywordsCount.Add(fileNameSplitted[i], 1);
}
}
}
}
//Get final keywords
foreach (KeyValuePair<string, int> keyword in keywordsCount)
{
if (keyword.Value > 2 && keyword.Key.Length > 2)
{
refineList.Add(keyword.Key);
}
}
The input file:
SFX_AMB_BIRDSONG
SFX_AMB_BIRDSONG_MISC
SFX_AMB_BIRDSONG_SEAGULL
SFX_AMB_BIRDSONG_SEAGULL_BUSY
SFX_AMB_BIRDSONG_VULTURE
SFX_AMB_CAVES_DRIP
SFX_AMB_CAVES_DRIP_AUTO
SFX_AMB_CAVES_LOOP
SFX_AMB_DESERT_CICADAS
SFX_AMB_EARTHQUAKE
SFX_AMB_EARTHQUAKE_SHORT
SFX_AMB_EARTHQUAKE_STREAMED
SFX_AMB_FIRE_BURNING
SFX_AMB_FIRE_CAMP_FIRE
SFX_AMB_FIRE_JET
SFX_AMB_FIRE_LAVA
SFX_AMB_FIRE_LAVA_DEEP
SFX_AMB_FIRE_LAVA_JET1
SFX_AMB_FIRE_LAVA_JET2
SFX_AMB_FIRE_LAVA_JET3
SFX_AMB_FIRE_LAVA_JET_STOP
SFX_AMB_UNDW_BUBBLE_RELEASE
SFX_AMB_UNDW_BUBBLE_RELEASE_AUTO
SFX_AMB_WATER_BEACH1
SFX_AMB_WATER_BEACH2
SFX_AMB_WATER_BEACH3
SFX_AMB_WATER_CANALS
SFX_AMB_WATER_FALL_HUGE
SFX_AMB_WATER_FALL_NORMAL
SFX_AMB_WATER_FALL_NORMAL2
SFX_AMB_WATER_FALL_NORMAL3
SFX_AMB_WATER_FOUNTAIN
SFX_CS_LUX_PORTAL_LIGHTNING
SFX_CS_LUX_PORTAL_LIGHTNING1
SFX_CS_LUX_PORTAL_LIGHTNING2
SFX_CS_LUX_PRIEST_COWER
SFX_CS_LUX_PRIEST_MEDAL
SFX_CS_LUX_PRIEST_MEDITATE
SFX_CS_LUX_PRIEST_SCREAM
SFX_CS_LUX_PRIEST_SNIFF1
SFX_CS_LUX_PRIEST_SNIFF2
SFX_CS_LUX_PRIEST_SPIRITS
SFX_CS_LUX_PRIEST_SPIRITS2
SFX_CS_LUX_PRIEST_SPIRITS3
SFX_CS_LUX_PRIEST_SURPRISE
SFX_MON_BM05_TOO_WALK1
SFX_MON_BM05_TOO_WALK2
SFX_MON_BM06_SQU_WALK1
SFX_MON_BM06_SQU_WALK2
SFX_MON_BR06_HAL_ATTACK1
SFX_MON_BR06_HAL_ATTACK2
SFX_MON_BR06_HAL_DIE
SFX_MON_BR06_HAL_HIT
SFX_MON_BR06_HAL_IDLE
SFX_MON_BR06_HAL_IDLE_EATING
SFX_MON_BR06_HAL_LAND1
SFX_MON_BR06_HAL_LAND2
SFX_MON_BR06_HAL_SCRAPE
SFX_MON_BR06_HAL_SLAM
SFX_MON_BR06_HAL_SURPRISE
SFX_MON_BR06_HAL_WALK1
SFX_MON_BR06_HAL_WALK2
SFX_MON_BU01_MUM_ATTACK1
SFX_MON_BU01_MUM_ATTACK2
SFX_MON_BU01_MUM_DIE
SFX_MON_BU01_MUM_HIT
SFX_MON_BU01_MUM_IDLE_RETRIEVE
SFX_MON_BU01_MUM_IDLE_RETRIEVE_GROW
SFX_MON_BU01_MUM_SURPRISE
SFX_MON_BU01_MUM_WALK1
SFX_MON_BU01_MUM_WALK2
SFX_WATER_SPLASH_BIG
SFX_WATER_SPLASH_BIG1
SFX_WATER_SPLASH_BIG2
SFX_WATER_SPLASH_BIG3
SFX_WATER_SPLASH_MED1
SFX_WATER_SPLASH_MED2
SFX_WATER_SPLASH_MED3
SFX_WATER_SPLASH_MEDIUM
SFX_WATER_SPLASH_OUT
SFX_WATER_SPLASH_OUT1
SFX_WATER_SPLASH_OUT2
SFX_WATER_SPLASH_SMALL
And the expected output (from the original tool):
AMB
MON
WATER
LUX
BR06
HAL
SPLASH
PRIEST
FIRE
BU01
MUM
LAVA
BIRDSONG
WALK1
WALK2
JET
IDLE
EARTHQUAKE
FALL
SURPRISE
BIG
CAVES
What should I modify to make that my method matches with the original output?
Thanks in advance!
-------EDIT
I've done some new discoveries:
->It is a method of approximately 100-130 lines.
->Use the Visual Basic methods InStr, Len, Right and Left
->Discards the word "SFX", and all words less than 3 characters long.
->It uses a combobox as a temporary list where it puts all the words that
appear more than once, and from here it takes out some words, which are the ones that are shown in the combobox visible to the user.
->For the first test case, that I've published, this is the discarded words list:
UNDW
BM05
BM06
SEAGULL
DRIP
BUBBLE
PORTAL
TOO
SQU
OUT
AUTO
RELEASE
NORMAL
LIGHTNING
SPIRITS
ATTACK1
ATTACK2
DIE
HIT
RETRIEVE

I could finally get it!!
I could finally figure it out, I had to use OllyDbg,Numega SmartCheck, and VB Decompiler tools, a lot of patience and voilà.
Here is the code, I've done it in VB.Net due to similarity with VB6:
'Clear comboboxes
Combo2.Items.Clear()
Combo3.Items.Clear()
'Start refining
Dim listboxItemsCount As Integer = listbox_SfxItems.Items.Count - 1
'Split only six words
For numberOfIterations As Integer = 0 To 5
'Iterate listbox items
For sfxItemIndex As Integer = 0 To listboxItemsCount
'Iterate listbox items to find matches
For sfxItemIndexSub As Integer = 0 To listboxItemsCount
'Skip the line that we are checking in the previus loop
If sfxItemIndex = sfxItemIndexSub Then
Continue For
End If
'Get item from listbox
Dim currentSfx As String = listbox_SfxItems.Items(sfxItemIndex)
Dim wordToCheck As String = currentSfx
'Split words
If numberOfIterations > 0 Then
For wordIndex = 1 To numberOfIterations
If InStr(1, wordToCheck, "_", CompareMethod.Binary) Then
Dim wordLength As Integer = Len(wordToCheck) - InStr(1, wordToCheck, "_", CompareMethod.Binary)
wordToCheck = Microsoft.VisualBasic.Right(wordToCheck, wordLength)
End If
Next
End If
If InStr(1, wordToCheck, "_", CompareMethod.Binary) Then
Dim wordLength As Integer = InStr(1, wordToCheck, "_", CompareMethod.Binary) - 1
wordToCheck = Microsoft.VisualBasic.Left(wordToCheck, wordLength)
End If
'Find matches
If StrComp("SFX", wordToCheck) <> 0 Then
If Len(wordToCheck) > 2 Then
currentSfx = listbox_SfxItems.Items(sfxItemIndexSub)
If InStr(1, currentSfx, wordToCheck, CompareMethod.Binary) Then
'Get combo items count
Dim addNewItem As Boolean = True
For comboboxIndex As Integer = 0 To Combo2.Items.Count - 1
Dim comboWordItem As String = CType(Combo2.Items(comboboxIndex), ComboItemData).Name
'Check for duplicated
If InStr(1, comboWordItem, wordToCheck, CompareMethod.Binary) = 0 Then
Continue For
End If
'Update combo item with the word appearances count
currentSfx = CType(Combo2.Items(comboboxIndex), ComboItemData).Name
If StrComp(currentSfx, wordToCheck) = 0 Then
'Get current item data
Dim currentItemData As Integer = CType(Combo2.Items(comboboxIndex), ComboItemData).ItemData
'Update value
currentItemData += 1
CType(Combo2.Items(comboboxIndex), ComboItemData).ItemData = currentItemData
End If
'Don't add items in the combobox and quit loop
addNewItem = False
Exit For
Next
'Check if we have to add the new item
If addNewItem Then
Combo2.Items.Add(New ComboItemData(wordToCheck, 0))
End If
End If
End If
End If
Next
Next
Next
'Check final words
Combo3.Items.Add("All")
Combo3.Items.Add("HighLighted")
Dim quitLoop As Boolean = False
Do
If Combo2.Items.Count > 0 Then
Dim itemToRemove As Integer = -1
'Get max value from the remaining words
Dim maxWordAppearances As Integer = 0
For itemIndex As Integer = 0 To Combo2.Items.Count - 1
Dim itemData As Integer = CType(Combo2.Items(itemIndex), ComboItemData).ItemData
maxWordAppearances = Math.Max(maxWordAppearances, itemData)
Next
'Get the item with the max value
For index As Integer = 0 To Combo2.Items.Count - 1
Dim itemData As Integer = CType(Combo2.Items(index), ComboItemData).ItemData
If itemData = maxWordAppearances And itemToRemove = -1 Then
itemToRemove = index
End If
Next
'Remove and add items
Dim itemStringName As String = CType(Combo2.Items(itemToRemove), ComboItemData).Name
Combo3.Items.Add(itemStringName)
Combo2.Items.RemoveAt(itemToRemove)
'Check if we have to skip this loop
If maxWordAppearances <= 5 Then
quitLoop = True
End If
End If
Loop While quitLoop <> True
'Select the first item
Combo3.SelectedIndex = 0
Not sure if it could be optimized, but works as the original one, and outputs the same words with the same order.
If you want to test it, requires the following controls:
two comboboxes, Combo2 is the temporal one, and Combo3 the one that the user views. It also requires a listbox with the items to check.
The comboItemData class has been extracted from this site: https://www.elguille.info/colabora/puntonet/alvaritus_itemdataennet.htm
I've renamed Cls_lista to ComboItemData

How about taking it as a block of text, splitting on line endings or underscores and getting the unique remnants:
File.ReadAllText(path)
.Split(new[]{'\r','\n','_'},StringSplitOptions.RemoveEmptyEntries)
.Distinct();
Hang on.. maybe it's only words three plus length, that appear thrice or more:
File.ReadAllText(path)
.Split(new[]{'\r','\n','_'},StringSplitOptions.RemoveEmptyEntries)
.GroupBy(w => w)
.Where(g => g.Key.Length > 2 && g.Count() > 2)
.Select(g => g.Key)
If you have a fixed list of words to exclude you can do e.g. .Except(new[]{ "SFX", "..." }) on the end..

You can do it with plain LINQ, use a GroupBy and convert it to a dictionary. On that Dictionary you can add additional criteria where you e.g. check the minimum amount of occurrences. You don't need to worry about several if-else conditions and keeps it pretty readable:
string[] inputLines = File.ReadAllLines("Input.txt");
var output = inputLines
.SelectMany(s =>
s.Split('_')
.Where(w => w != "SFX")
)
.GroupBy(g => g)
.ToDictionary(s => s.Key, s => s.Count())
.Where(w => w.Key.Length > 2 && w.Value > 2);

I gave it a go. Can't figure out the ordering, and the performance is not top notch, but you get your required output selection for your one given example.
"SFX" could be excluded due to being (a) contained in all input items, or (b) the very first part of each input item, but I have kept it as a hard-coded string to exclude, in addition to "PORTAL". I really have no idea why "PORTAL" is excluded in the output.
Here, Input is a string[] with the example input provided in the question post.
var excludedWords = new[] { "SFX", "PORTAL" };
var feasibleWords = Input
.SelectMany(str => str.Split('_'))
.Where(word =>
word.Length > 2 &&
!excludedWords.Contains(word));
var repeatedWords = feasibleWords
.GroupBy(word => word)
.Where(gr => gr.Count() > 2)
.ToDictionary(
gr => gr.Key,
gr => gr.Count());
var serialWords = feasibleWords
.Except(repeatedWords.Keys)
.GroupBy(word => Regex.Replace(word, #"[\d]", string.Empty))
.Where(gr =>
gr.Contains(gr.Key) &&
gr.Count() > 3)
.ToDictionary(
gr => gr.Key,
gr => gr.Count());
var output = repeatedWords.Concat(serialWords)
.OrderByDescending(kvp => kvp.Value) // Doesn't add much value, but oh well
.Select(kvp => kvp.Key);
Console.Write(string.Join(Environment.NewLine, output));
Prints:
AMB
MON
WATER
LUX
BR06
HAL
SPLASH
FIRE
PRIEST
BU01
MUM
LAVA
BIRDSONG
FALL
WALK1
WALK2
IDLE
JET
BIG
CAVES
EARTHQUAKE
SURPRISE

.net how to remove the oldest data XY point and then add a new XY data point to chart

I'm using .Points.RemoveAt(0) to remove the oldest and
.AddXY to add the newest.
But chart is not working right. As I delete each oldest and add each newest (x-axis is time), I am not seeing the chart scroll to the left, as I expect.

Oops I answered with VBA, instead of C#. Well maybe you can do the same trick in C# by reading in the array of values, modifying it and writing it back to the chart.
I think you are trying to make something like this:
and here is the code I am using to do this:
Private Const MaxPoints As Long = 100
Private Sub CommandButton1_Click()
Dim i As Long, PI As Double
PI = 4 * Atn(1)
For i = 1 To 720 / 5
AddValueToChart 50# + 35# * Sin(5 * i * PI / 180)
DoEvents
Next i
End Sub
Public Sub AddValueToChart(ByVal x As Double)
Dim ch As Chart, list() As Variant
Set ch = Me.ChartObjects("Chart 1").Chart
Dim serlist As SeriesCollection
Set serlist = ch.SeriesCollection()
' If chart is empty then add a line with 100 points
If serlist.Count = 0 Then
serlist.NewSeries
ReDim list(1 To MaxPoints)
ch.SeriesCollection(1).Values = list
End If
Dim ser As Series
Set ser = ch.SeriesCollection(1)
' Get an array of values
list = ser.Values
Dim i As Long
For i = MaxPoints To 2 Step -1
' Shift points
list(i) = list(i - 1)
Next i
' Add a new point to the begining of the chart.
list(1) = x
' Assign the modified list as values of the series.
ser.Values = list
End Sub

Find similarities in a binary string

I am currently trying to write a function that would help me find similarities between binary strings. This sounds vague so I will explain with an example.
StringA : 10111010000
StringB : 10111010011
StringC : 10111101111
I want my program to be able to find any similarities (4 digits or more) occuring at the same index. In the above example, my function would return : 0-4 (because caracters 0 to 4 are identical in all three strings).
I am not looking for code, just a logical and optimal way of doing this.

String is Array of Char.
You should do Loop in which you would compare each char.
For Example: (I had to put example, sorry)
for(int i=0;i<=length;i++) \\length = array lenght
{
if(StringA[i]==StringB[i]) CounterA++; \\or something like this
}

method 1: split the strings into either an Array, or a List, then use LINQ to find the groupings within the list...
method 2: loop through each string, then through each character, then create a new string with the character length, and compare to the same substring on the other strings...

Assuming all three items are stored in their own respective variables, I would split all of the bits into an array. From there, I would iterate through one array (since all of the arrays are the same size) and match from there. This operation would be O(n) since you have to look at n items.

Pseudocode?
array := array[numbers]
for each binary number
for each binary number
if numbers have the same binary digit at current index
array[index] := array[index] + 1
end
end
end

Iterate each character in the string, if they match add to a counter:
private static int GetDifferences(string firstStr, string secondStr)
{
int val = 0;
char[] first = firstStr.ToCharArray();
char[] second = secondStr.ToCharArray();
for (int i = 0; i < first.Length; i++)
{
if (first[i] == second[i])
{
val++;
}
}
return val;
}
By no means perfect but should get you started

i'd split them into a list:
static void Main()
{
var a = "10111010000";
var b = "10111010011";
var c = "10111101111";
var aList = Split(a, 4); //Use a custom split method
var bList = Split(b, 4);
var cList = Split(c, 4);
Dictionary<int,string> hits = new Dictionary<int, string>();
for (int i = 0; i < aList.Count(); i++)
{
if(aList[i] == bList[i] && bList[i] == cList[i])
hits.Add(i,aList[i]);
}
}

Probably you could use Bitwise operators:
get XOR result from A/B (say:A^B) and A/C (say:A^C)
get NOT result of step 1: ~(A^B); ~(A^C)
get And result from step 2: (~(A^B))&(~(A^C))
get the 1 part from step 3.
e.g.:
1.
A^B=10111010000^
10111010011
=00000000011;
A^C=10111010000^
10111101111
=00000111111
2.
~(A^B)=~(00000000011)=11111111100;
~(A^C)=~(00000111111)=11111000000;
3.
(~(A^B))&(~(A^C)) =11111111100&
11111000000
=11111000000

If you were just wanting to get a true or false as to whether there is a minimum of 4 matching characters, you could do this:
Public Function StringsHaveMin4CharsInCommon(ByVal StringA As String, ByVal StringB As String, ByVal StringC As String) As Boolean
Dim bReturn As Boolean
Dim iCounter As Integer
For i As Integer = 0 To StringA.Length - 1
If StringA.SubString(i, 1) = StringB.SubString(i, 1) And StringB.SubString(i, 1) = StringC.SubString(i, 1) Then iCounter += 1
If iCounter = 4 Then
bReturn = True
Exit For
End If
Next i
Return bReturn
End Function
If you wanted to retrieve the matching array indices then you would need to add logic to the same procedure to add each matching index to an Integer array and return that array from the function as follows.
Public Function GetCommonIndices(ByVal StringA As String, ByVal StringB As String, ByVal StringC As String) As Integer()
Dim iReturn() As Integer
Dim iCounter As Integer = -1
For i As Integer = 0 To StringA.Length - 1
If StringA.SubString(i, 1) = StringB.SubString(i, 1) And StringB.SubString(i, 1) = StringC.SubString(i, 1) Then
iCounter += 1
ReDim Preserve iReturn(iCounter)
iReturn(iCounter) = i
End If
Next i
Return iReturn
End Function
The function will return Nothing if there are no matching indices.
The functions only test for the length of StringA so it will throw an error if either StringB or StringC is shorter than String A. I inferred that the strings that you will be testing will be pre-validated as being all equal in length.

Reading Specific Byte data From File

I have an 8mb file which contains some records.
I want to read a particular record from a particular place.
I have the starting and ending byte index of every record in the file.
My problem is how to use a file dialog box to select the particular file and make a function that reads the file and then stores a particular record in the textbox.
I also have a doubt on how to read all the records at one time in all the textboxes.

First,I need an index of my file values suppose product id =id09876543 location =india then index values of id09876543 is " 12 to 23 "
then i will pass 12 and 23 in function calling.
make a user define function called "read_value" pass the 2 argument in it in integer form and make function as string i.e. it will return value in string format.
call that function in your specific place where you want the answer.
like this.
1)
Public Function read_value(ByVal strat As Integer, ByVal end1 As Integer) As String
Dim fs As FileStream = New FileStream(f_name, FileMode.Open, FileAccess.Read)
Dim n As Integer = 0
Dim s As String = Nothing
Dim i As Integer = 0
Dim l As Long = strat
fs.Seek(l, SeekOrigin.Begin)
'Seek(strat)
For i = strat To end1
n = fs.ReadByte()
s = s + Convert.ToChar(n)
Next
Return s
End Function
Dim ofd1 As New OpenFileDialog
' Dim file_name As String
Try
If ofd1.ShowDialog = Windows.Forms.DialogResult.OK Then
f_name = ofd1.FileName
product_id_txt.Text = read_value(12, 23)
location_txt.Text = read_value(34, 50)
form.Show()
End If
Catch ex As Exception
MessageBox.Show("File Not Found")
End Try
Output of this code is
label----->Product Id: id09876543 <---- this is my text box value

converting from access to MARC and back

i have a access files with details about book and i need to take the details and turn them to a marc record and vice versa. how is the best way to do it?

I released the code for my MARC implementation in C#. To do the actual coding, you will need to refer to the Library of Congress's MARC page most likely.
http://sourceforge.net/projects/marclibrary/
If you use the library, please don't hesitate to provide me feedback!
Mark

I doubt that you'll find anything that will get you there in one jump. Your best bet is most likely going to involve reading the records from Access using your favorite data access technique and then pumping it into something that speaks MARC. I haven't used it, but the MARCNet project looks promising. The MARC format isn't that difficult to implement by hand (it's all just text flat-files at heart), but a lot depends on who you are going to end up talking to and how picky they are.

FWIW, here is some code I wrote ten years ago I used process MARC and put them into an access database.
It's been a LONG time since I looked at this, but I would imagine this could be a start:
'IMPORTANT NOTE: The Marc Record's directory (this is a feature located within a Marc
' Record used to parse the record) uses option base 0 to list
' its positions for the varying fields. (See http://lcweb.loc.gov/marc)
' For example, in "Chumbawumba" the letter "C" would be in the zero position
' On the other hand, VB's Instr() function uses option base 1 to
' determine positions in a variable. ("C" is in position 1).
' Code has been adjusted to reflect this difference.
Option Explicit
Option Base 0
Const Marc21_Blank = " " 'Chr(32) Hex 20
Const Marc21_Delimiter = "" 'Chr(31) Hex 1F
Const Marc21_FieldTerminator = "" 'Chr(30) Hex 1E
Const Marc21_RecordTerminator = "" 'Chr(29) Hex 1D
Const Marc21_FillChar = "|" 'Chr(124) Hex 7C
Const Marc21_DirLength = 12 'Length of 1 direcotry Entry (option base 1)
Const Marc21_DirLengthOfFieldPos = 3 'Where the "Length of Field" number can be found in
'one directory entry (by MARC definition)
Const Marc21_DirLengthOfFieldLength = 4 'The physical length of the "Length of Field" entry
'Found in the directory
Const Marc21_DirStartingPos = 7 'Where the "Length of Field" number can be found in
'one directory entry (by MARC definition)
Const Marc21_DirStartingPosLength = 5 'The physical length of the "Length of Field" entry
'Found in the directory
Const Marc21_DirTagLength = 3 'The physical length of the "Length of Field" entry
Const Marc21_LdrLength = 24 'Length of Leader (option base 1)
Const Marc21_PositionAdjustment = 1 'Adjustment constant for Marc record (see note at top of module)
Const Marc21_FieldTerminatorPos = 1 'Represents a place for field terminator
Const Marc21_MaxControlFieldTagValue = 9 'Tags for control fields range from "001" to "009"
Const Marc21_IndicatorLength = 1 'Length of indicator
Const Marc21_MovePastIndicators = 3 'After indicators are stored in a variable field
'we should move past them to the new starting position
'This new position will be a delimeter for a variable field
Const Marc21_MovePastSubfieldCode = 2 'Used to move past the delimeter and subfield code in a varible field
'Const Marc21_FieldCount = 1 'Number of fields in Directory (option base 0)
Dim mrsLeaders As Recordset 'Recordset storing Leaders from the Marcs Imported
Dim mrsTags As Recordset 'Recordset storing the Tags
Dim mrsFields As Recordset 'Recordset storing the different variable fields in the data
'***********************************************************************************************************************
' PROCEDURE: ProcessRecord_S
'
' PURPOSE: From the text file passed, this sub will parse the Marc records
' and individually send them to the subsequent modules for further parsing
'
'PARAMETERS: sFile -- contains full path and filename of text file passed
'
'
' Date: Name: Description:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 03/06/01 Ray Initial Creation
'***********************************************************************************************************************
Sub ProcessRecord_S(sFile As String)
Dim iFreeFile As Integer
Dim vMarc As Variant
Dim lRTPos As Long
Dim sMarcRecord As String
Dim dbMarc As Database
Set dbMarc = OpenDatabase("D:\Marc21\marc21.mdb")
'Made these recordsets modular because I step into two functions saving the information.
'In addition, the text file could hold thousands of records (that's a lot of loops).
Set mrsLeaders = dbMarc.OpenRecordset("Select * From NewLeaders")
Set mrsTags = dbMarc.OpenRecordset("Select * From NewTags")
Set mrsFields = dbMarc.OpenRecordset("Select * From NewFields")
lRTPos = 0 'Initialize
iFreeFile = FreeFile 'Get an available Free file number
Open sFile For Input As #iFreeFile 'Open the text file.
vMarc = Input$(LOF(iFreeFile), iFreeFile) 'Not sure what the limit is, but I have
Close #iFreeFile 'tested data as big as 10 megs.
Do Until vMarc = "" 'Going to loop till the variant is turned into an empty string
lRTPos = InStr(vMarc, Marc21_RecordTerminator) 'Since there can be more than one MarcRecord, we will use the position of the
'Record Terminator (RT) to determine where the Marc Record ends
sMarcRecord = Left(vMarc, lRTPos - 1) 'Record minus RT
If Not SaveRecord_F(sMarcRecord) Then
MsgBox "Saving Marc Record Failed"
Exit Sub
End If
vMarc = Mid(vMarc, lRTPos + 1)
Loop
End Sub
'***********************************************************************************************************************
' PROCEDURE: SaveRecord_F
'
' PURPOSE: Saves tags and indicators (if applicable) to the Tag table
'
'PARAMETERS: sMarcRecord -- Marc Record passed (this string can be up to 99,999 characters long)
'
'
' Date: Name: Description:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 03/06/01 Ray Initial Creation
'***********************************************************************************************************************
Function SaveRecord_F(sMarcRecord As String)
Dim sLeader As String * 24
Dim sDirectory As String 'Whole Directory
Dim sVarFields As String 'All Control and Data Fields
Dim lDirectoryEnd As Long 'Position where Directory ends
Dim lDataEntries As Long 'Determines number of Field Entries
Dim lFieldLength As Long
Dim lStartingPosition As Long
Dim lLeaderID As Long
Dim lTagID As Long
Dim sField As String
Dim sDirectoryEntry() As String
Dim bControl As Boolean
Dim lCurDirEntry As Long
Const Marc21_FLP = 4 'Field Length position relative to directory
sLeader = Left(sMarcRecord, Marc21_LdrLength) 'Set Leader
lDirectoryEnd = InStr(Marc21_LdrLength + 1, sMarcRecord, Marc21_FieldTerminator) - Marc21_FieldTerminatorPos 'Set position for end of Directory (excluding FT)
sDirectory = Mid(sMarcRecord, Marc21_LdrLength + 1, lDirectoryEnd - Marc21_LdrLength) 'Set Directory minus field terminator
'Set Variable Fields by taking end of directory position, adding one
'for the FT position and then adding another "1" to mark the beginning of the
'vfields
sVarFields = Mid(sMarcRecord, lDirectoryEnd + Marc21_FieldTerminatorPos + 1)
lDataEntries = Len(sDirectory) 'Get Length of Directory
'Make sure Directory Length Matches with Marc21 Records
If lDataEntries Mod Marc21_DirLength <> 0 Then
MsgBox "Directory Entries are messed up"
Exit Function
End If
'Add Leader to Leader Table
mrsLeaders.AddNew
lLeaderID = mrsLeaders!LeaderID 'Need this newly assigned ID to process info below
mrsLeaders!leader = sLeader
mrsLeaders.Update
'Get Number of Directory Entries for this Marc Record
lDataEntries = lDataEntries / Marc21_DirLength
'Store Tag information and, while still looping, store Variable Field Info pertaining
'to TagID pertaining to Leader
For lCurDirEntry = 0 To lDataEntries - 1
'Starting Position of Field Entry
lStartingPosition = Val(Mid(sDirectory, lCurDirEntry * Marc21_DirLength + Marc21_DirStartingPos + Marc21_PositionAdjustment, Marc21_DirStartingPosLength))
'Field length in directory relative to current record
lFieldLength = Val(Mid(sDirectory, (lCurDirEntry * Marc21_DirLength) + Marc21_DirLengthOfFieldPos + Marc21_FieldTerminatorPos, Marc21_DirLengthOfFieldLength))
mrsTags.AddNew
mrsTags!LeaderID = lLeaderID
'According to MARC, the tag within a directory starts at position zero, so we adjust it by one for the MID function
mrsTags!Tag = Mid(sDirectory, lCurDirEntry * Marc21_DirLength + Marc21_PositionAdjustment, Marc21_DirTagLength)
'Set indicators for Data Fields (non-control fields)
If Val(mrsTags!Tag) > Marc21_MaxControlFieldTagValue Then
mrsTags!Indicator1 = Mid(sVarFields, lStartingPosition + 1, Marc21_IndicatorLength)
mrsTags!Indicator2 = Mid(sVarFields, lStartingPosition + 2, Marc21_IndicatorLength)
lStartingPosition = lStartingPosition + Marc21_MovePastIndicators
lFieldLength = lFieldLength - Marc21_MovePastIndicators 'Adjust field length accordingly
bControl = False
Else
lStartingPosition = lStartingPosition + Marc21_PositionAdjustment 'Adjusted b/c Marc21's defines positions of fields based on position zero. VB uses base 1. Imagine that.
bControl = True
End If
lTagID = mrsTags!TagID
'mrsTags!FieldDesc = Mid(sVarFields, lStartingPosition + 1, lFieldLength - 1) 'Directory Entry - Field Termintor (FT)
mrsTags.Update
'Only Get field pertaining to Direcotry Entry Just Saved
sField = Mid(sVarFields, lStartingPosition, lFieldLength)
SaveFields_F sField, lTagID, bControl 'Adding and Subtracting two is accounting for indicators
Next lCurDirEntry
SaveRecord_F = True
End Function
'***********************************************************************************************************************
' PROCEDURE: SaveFields_F
'
' PURPOSE: Saves the variable data and control fields to its respective table
'
'PARAMETERS: sField -- The data which must be filtered
' lTagID -- The unique identifier related to the records about to be stored
' bControl -- Optional. Let's sub know if data is a control field or not
'
'
' Date: Name: Description:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 03/06/01 Ray Initial Creation
'***********************************************************************************************************************
Function SaveFields_F(sField As String, lTagID As Long, Optional bControl As Boolean)
Dim lDelimeterPos As Long
If Not bControl Then 'Not a control Field
If Left(sField, 1) = Marc21_Delimiter Then
sField = Mid(sField, 2) 'Move past delimeter
Else
'All non-control fields should start with delimeters
MsgBox "This entry didn't start out with a delimeter", vbOKOnly, "Uh Oh"
Exit Function
End If
lDelimeterPos = InStr(1, sField, Marc21_Delimiter)
Do Until lDelimeterPos = 0
'Store new subfield code and field description
mrsFields.AddNew
mrsFields!TagID = lTagID
mrsFields!SubFieldCode = Left(sField, 1)
mrsFields!FieldDesc = Mid(sField, Marc21_MovePastSubfieldCode, lDelimeterPos - Marc21_MovePastSubfieldCode) 'Start at position two b/c of subfield code. Subtract by 2 b/c of where started
mrsFields.Update
sField = Mid(sField, lDelimeterPos + 1)
'Get new delimeter position
lDelimeterPos = InStr(1, sField, Marc21_Delimiter)
Loop
If sField <> "" Then
mrsFields.AddNew
mrsFields!TagID = lTagID
mrsFields!SubFieldCode = Left(sField, 1)
mrsFields!FieldDesc = Mid(sField, Marc21_MovePastSubfieldCode)
mrsFields.Update
End If
Else
If sField <> "" Then
If Right(sField, 1) = Marc21_FieldTerminator Then
sField = Mid(sField, 1, Len(sField) - Marc21_FieldTerminatorPos)
End If
mrsFields.AddNew
mrsFields!TagID = lTagID
mrsFields!FieldDesc = sField
mrsFields.Update
End If
End If
End Function
The access database I created (and used) can be found here.