1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
|
Public Function CreateTestClass(ClientValueIn As Variant, CWValueIn As Variant, Test As String) As Integer
Dim Veh As Vehicle
Dim Result As Integer
'
Set Veh = New Vehicle
Select Case Test
Case "BHP"
Result = Veh.BhpRank(ClientValueIn, CWValueIn)
Case "KW"
Result = Veh.KWRank(ClientValueIn, CWValueIn)
Case "Character"
Result = Veh.CharacterRank(ClientValueIn, CWValueIn)
Case "KWStr"
Result = Veh.KWStrRank(ClientValueIn, CWValueIn)
Case "BPStrRank"
Result = Veh.BhpStrRank(ClientValueIn, CWValueIn)
Case "Engine"
Result = Veh.EngineRank(ClientValueIn, CWValueIn)
Case "CC"
Result = Veh.CCRank(ClientValueIn, CWValueIn)
Case "Fuel"
Result = Veh.FuelRank(ClientValueIn, CWValueIn)
Case "NomCC"
Result = Veh.NomRank(ClientValueIn, CWValueIn)
Case "Doors"
Result = Veh.DoorRank(ClientValueIn, CWValueIn)
Case "Valves"
Result = Veh.ValveRank(ClientValueIn, CWValueIn)
End Select
CreateTestClass = Result
End Function
vehicle class
Option Compare Database
Private pBhp As Long
Private pCWCode As String
Private pKw As Long
Private pNomCC As Double
Public Property Get Bhp() As Long
Bhp = pBhp
End Property
Public Property Get Kw() As Long
Kw = pKw
End Property
Public Property Get NOMCC() As Double
NOMCC = pNomCC
End Property
Public Property Let Bhp(Value As Long)
pBhp = Value
End Property
Public Property Let Kw(Value As Long)
pKw = Value
End Property
Public Property Let NOMCC(Value As Double)
pNomCC = Value
End Property
Public Function EngineRank(Strclientengine As Variant, strcwengine As Variant) As Long
Dim StrClientEngineIn As String
Dim StrCWEngineIn As String
Dim BInstrFWD As Boolean
Dim BInstrRev As Boolean
Dim BCompareEng As Boolean
Dim counter As Long
Dim foutput As Long
Dim StrTypo As String
Dim intcount As Integer
Dim BHPin As Long
If IsNull(Strclientengine) = True Or IsNull(strcwengine) Then
'no data
Else
'get passed values
StrClientEngineIn = Strclientengine
StrCWEngineIn = strcwengine
'precedence
'rank on compare
'rank on instr
'rank on typo
'rank on partial
'*****************************************************************************
' check compare
'rank on compare
If StrComp(StrCWEngineIn, StrClientEngineIn, 1) = False Or StrComp(StrCWEngineIn, RegExpReplace(StrClientEngineIn, " "), 1) = False Then
counter = 10000
Else
counter = 0
'check instring
'****************************************************************************
If InStr(StrClientEngineIn, StrCWEngineIn) > 0 Then
counter = counter + 1000
Else
End If
If InStr(StrCWEngineIn, StrClientEngineIn) > 0 Then
counter = counter + 1000
Else
End If
'***************************************************************************
'check family
''forward instring cw to client
If FamilyInstr(StrCWEngineIn, StrClientEngineIn) = "" Then
Else
counter = counter + 100
End If
'***************************************************************************
'check typos
StrTypo = DecodeEngine(StrCWEngineIn, StrClientEngineIn)
If StrTypo = "typo" Then
counter = counter + 10
Else
' do nothing
End If
'****************************************************************************
' get character ranking score
intcount = CharacterRank(StrCWEngineIn, StrClientEngineIn)
counter = counter + intcount
'***************************************************************************
''***************************************************************************
''Technical test bhp
'If CurrentProject.AllForms("main").IsLoaded Then
'
'BHPIn = [Forms]![Main]![CALC BHP]
'
'
'Else
'
'
'End If
'end of compare
End If
End If
GetEngineRank = counter * 100
End Function
Public Function CharacterRank(StrEng1 As String, strEng2 As String) As Long
Dim sw As StopWatch
Dim lIndex As Long
Dim lLoopPosition As Long
Dim lCharacterPosition As Long
Dim iCounter As Long
Dim StrWantedCharacter As String
Dim StrTemp As String
'Set sw = New StopWatch
'sw.StartTimer
'relate to the shorter string as this length controls loops and instr direction
If Len(strEng2) < Len(StrEng1) Then
' swap them
strEng2 = strEng2 + StrEng1
StrEng1 = Left(strEng2, Len(strEng2) - Len(StrEng1))
strEng2 = Right(strEng2, Len(strEng2) - Len(StrEng1))
End If
'get the shortest len
lIndex = Len(StrEng1)
'strtemp becomes equal to the longest string as this is the one we want to shorten for each loop
StrTemp = strEng2
'loop around string
For lLoopPosition = 1 To lIndex
'get individual character starting at the beginning of the string
StrWantedCharacter = Mid(StrEng1, lLoopPosition, 1)
'get the position of our character from the longest string
lCharacterPosition = InStr(strEng2, StrWantedCharacter)
'character found in longest string
If InStr(StrTemp, StrWantedCharacter) <> 0 Then
'remove the character from the temp string
StrTemp = Replace(StrTemp, Mid(strEng2, lCharacterPosition, 1), "", , 1)
'increment the counter
iCounter = iCounter + 1
End If
Next lLoopPosition
'processtime = sw.EndTimer & " milliseconds"
'Debug.Print sw.EndTimer
'Debug.Print iCounter
CharacterRank = iCounter
End Function
Public Function NomRank(StrClient As String, CWNomIn As Double) As Integer
Dim ValueIn As Double
Dim StrReturnedFromClientString As String
If IsNull(CWNomIn) Then
ValueIn = 0
Else
ValueIn = CWNomIn
End If
StrReturnedFromClientString = GetCC(StrClient)
If StrComp(CStr(ValueIn), StrReturnedFromClientString, 1) = False Then
NomRank = 1
Exit Function
End If
NomRank = 0
End Function
Public Function KWRank(ClientIn As Variant, CWKWIn As Long, Optional varianceIn As Integer) As Integer
Dim ValueMin As Long
Dim ValueMax As Long
Dim ValueIn As Long
Dim ValueCWIn As Long
Dim A As Long
ValueCWIn = CWKWIn
If (varianceIn) = 0 Then
ValueMin = ValueCWIn - 5
ValueMax = ValueCWIn + 5
Else
ValueMin = ValueCWIn - varianceIn
ValueMax = ValueCWIn + varianceIn
End If
If ValueCWIn = ClientIn Then
KWRank = 2
Exit Function
Else
For A = ValueMin To ValueMax
If ClientIn = A Then
KWRank = 1
Exit Function
End If
Next A
End If
KWRank = 0
End Function
Public Function BhpRank(ClientIn As Variant, CalcBHP As Long, Optional varianceIn As Integer) As Integer
Dim ValueMin As Long
Dim ValueMax As Long
Dim ValueIn As Long
Dim ValueCWIn As Long
Dim A As Long
ValueCWIn = CalcBHP
If (varianceIn) = 0 Then
ValueMin = ValueCWIn - 5
ValueMax = ValueCWIn + 5
Else
ValueMin = ValueCWIn - varianceIn
ValueMax = ValueCWIn + varianceIn
End If
If ValueCWIn = ClientIn Then
BhpRank = 2
Exit Function
Else
For A = ValueMin To ValueMax
If ClientIn = A Then
BhpRank = 1
Exit Function
End If
Next A
End If
BhpRank = 0
End Function
Public Function ValveRank(ClientStr As Variant, CWCylindersIn As Integer)
Dim ValueIn As Integer
Dim ClientValveCount As Long
Dim CylinderCountIn As Long
If IsNull(CWCylindersIn) Then
ValueIn = 0
Else
CylinderCountIn = CWCylindersIn
End If
If IsNull([Forms]![main]![VALVES PER CYLINDER].Value) Then
ValueIn = 0
Else
ValueIn = [Forms]![main]![VALVES PER CYLINDER].Value * CylinderCountIn
ClientValveCount = GetNumValves(ClientStr)
End If
If ValueIn = ClientValveCount And ValueIn > 0 Then
ValveRank = 1
Exit Function
End If
ValveRank = 0
End Function
Function GetNumValves(text)
Dim pos As Integer
Do
pos = InStr(pos + 1, text, "V")
If pos > 2 Then
If Mid(text, pos - 2, 2) Like "##" Then
GetNumValves = Val(Mid(text, pos - 2, 2))
Exit Function
End If
End If
If pos > 1 Then
If Mid(text, pos - 1, 1) Like "#" Then
GetNumValves = Val(Mid(text, pos - 1, 1))
Exit Function
End If
End If
Loop While pos
GetNumValves = 0
End Function
Public Function FuelRank(StrClient, CWFuelIn As String) As Long
Dim ValueIn As String
If IsNull(CWFuelIn) Then
ValueIn = ""
Else
ValueIn = CWFuelIn
End If
If StrComp(Left(ValueIn, 1), StrClient, 1) = False Then
FuelRank = 1
Exit Function
End If
FuelRank = 0
End Function
Public Function DoorRank(ClientStr As String, CWDoorsIn As Integer) As Integer
Dim ValueIn As Integer
Dim ClientDoorCount As Long
If IsNull(CWDoorsIn) Then
ValueIn = 0
Else
ValueIn = CWDoorsIn
ClientDoorCount = GetDoors(ClientStr)
End If
If ValueIn = ClientDoorCount And ValueIn > 0 Then
DoorRank = 1
Exit Function
End If
DoorRank = 0
End Function
Public Function TransmissionRank(ClientStr As String, CWTransmissionIn As String)
Dim ValueIn As String
If IsNull(CWTransmissionIn) Then
ValueIn = ""
Else
ValueIn = CWTransmissionIn
End If
If StrComp(ValueIn, ClientStr, 1) = False Then
TransmissionRank = 1
Exit Function
End If
TransmissionRank = 0
End Function
Function GetDoors(ClientStr As String) As Integer
Dim regex As Object
Dim match As Object
Set regex = CreateObject("vbscript.regexp")
'filter for numerals and "d separated by space"
regex.Pattern = "[0-9]+ d"
'turn off case
regex.IgnoreCase = True
'create object
Set match = regex.Execute(ClientStr)
'set or get value
If match.Count > 0 Then GetDoors = Trim(Val(match(0)))
'kill object
Set regex = Nothing
End Function
Public Function CCRank(ClientIn As Variant, CWCCIn As Long, Optional varianceIn As Integer) As Integer
Dim ValueMin As Long
Dim ValueMax As Long
Dim ValueIn As Long
Dim ValueCWIn As Long
Dim A As Long
ValueCWIn = CWCCIn
If (varianceIn) = 0 Then
ValueMin = ValueCWIn - 5
ValueMax = ValueCWIn + 5
Else
ValueMin = ValueCWIn - varianceIn
ValueMax = ValueCWIn + varianceIn
End If
If ValueCWIn = ClientIn Then
CCRank = 2
Exit Function
Else
For A = ValueMin To ValueMax
If ClientIn = A Then
CCRank = 1
Exit Function
End If
Next A
End If
CCRank = 0
End Function
Public Function BhpStrRank(StrClient As String, CWBhp As Long, Optional variance As Integer)
Dim StrCientln As String
Dim ValueMin As Long
Dim ValueMax As Long
Dim ValueCWIn As Long
Dim A As Long
Dim B As Long
Dim StrTemp As String
Dim StrTemp2 As String
Dim StrArray() As String
Dim counter As Integer
Dim teststr As String
If IsNull(ValueCWIn) Then
ValueCWIn = 0
Else
ValueCWIn = CWBhp
End If
If (varianceIn) = 0 Then
ValueMin = ValueCWIn - 5
ValueMax = ValueCWIn + 5
Else
ValueMin = ValueCWIn - varianceIn
ValueMax = ValueCWIn + varianceIn
End If
If IsNull(ValueCWIn) = True Or ValueCWIn = 0 Then
Else
If Len(StrClient) <= 0 Or IsNull(StrClient) Then
KWStrRank = 0
Exit Function
Else
If ValueCWIn = StrClient Then
BhpStrRank = 2
Exit Function
Else
StrTemp = SplitNumeralandText(StrClient)
StrTemp2 = RegExpReplace(StrTemp, "[^0-9]", " ")
StrArray = Split(StrTemp2)
For A = LBound(StrArray()) To UBound(StrArray())
For B = ValueMin To ValueMax
If (StrComp(StrArray(A), CStr(B), 1) = False) Then
BhpStrRank = 1
Exit Function
End If
Next B
Next A
End If
End If
End If
BhpStrRank = 0
End Function
Public Function KWStrRank(StrClient As String, CWKw As Long, Optional variance As Integer)
Dim StrCientln As String
Dim ValueMin As Long
Dim ValueMax As Long
Dim ValueCWIn As Long
Dim A As Long
Dim B As Long
Dim StrTemp As String
Dim StrTemp2 As String
Dim StrArray() As String
Dim counter As Integer
Dim teststr As String
If IsNull(ValueCWIn) Then
ValueCWIn = 0
Else
ValueCWIn = CWKw
End If
If (varianceIn) = 0 Then
ValueMin = ValueCWIn - 5
ValueMax = ValueCWIn + 5
Else
ValueMin = ValueCWIn - varianceIn
ValueMax = ValueCWIn + varianceIn
End If
If IsNull(ValueCWIn) = True Or ValueCWIn = 0 Then
Else
If Len(StrClient) <= 0 Or IsNull(StrClient) Then
KWStrRank = 0
Exit Function
Else
If ValueCWIn = StrClient Then
KWStrRank = 2
Exit Function
Else
StrTemp = SplitNumeralandText(StrClient)
StrTemp2 = RegExpReplace(StrTemp, "[^0-9]", " ")
StrArray = Split(StrTemp2)
For A = LBound(StrArray()) To UBound(StrArray())
For B = ValueMin To ValueMax
If (StrComp(StrArray(A), CStr(B), 1) = False) Then
KWStrRank = 1
Exit Function
End If
Next B
Next A
End If
End If
End If
KWStrRank = 0
End Function
Public Function getTechDetail(StrClient As String, TechSpec As String, Optional variance As Integer) As Integer
'Dim StrCientln As String
'Dim ValueMin As Long
'Dim ValueMax As Long
'Dim ValueIn As Long
'Dim A As Long
'Dim B As Long
'Dim StrTemp As String
'Dim StrTemp2 As String
'Dim StrArray() As String
'Dim counter As Integer
'Dim teststr As String
If StrClient = "" Or "0" Then
Else
If (variance) = 0 Then variance = 5
If IsNull(ValueIn) = True Or ValueIn = 0 Then
Else
If Len(StrClient) <= 0 Or IsNull(StrClient) Then
getTechDetail = 0
Exit Function
Else
If ValueIn = StrClient Then
getTechDetail = 2
Exit Function
Else
StrTemp = SplitNumeralandText(StrClient)
StrTemp2 = RegExpReplace(StrTemp, "[^0-9]", " ")
StrArray = Split(StrTemp2)
ValueMin = ValueIn - variance
ValueMax = ValueIn + variance
For A = LBound(StrArray()) To UBound(StrArray())
For B = ValueMin To ValueMax
If (StrComp(StrArray(A), CStr(B), 1) = False) Then
getTechDetail = 1
Exit Function
End If
Next B
Next A
End If
End If
End If
End If
getTechDetail = 0
End Function
Public Function BodyRank(ClientStr As String)
Dim ValueIn As String
If IsNull([Forms]![main]![Common Body Alias CW].Value) Then
ValueIn = ""
Else
ValueIn = [Forms]![main]![Common Body Alias CW].Value
End If
If StrComp(ValueIn, ClientStr, 1) = False Then
BodyRank = 1
Exit Function
End If
BodyRank = 0
End Function
|
