Code Speed - Which Functions Are Faster?

Speed Tips - A Place To Post Variations Of Code That You Notice Work Faster!
Ok I started this post because i am always seeing that people are clowning on people for using code that eats up processor power so now there is a place to list all of the faster vairiations of coding so that it is less confusing.

Example of how to post variations:

This Code is for making a if statement:
Fast:

Code:
If x = y then
...
else
...
endif


Slow:

Code:
iif(x = y, ...(TRUE ARGUMENTS)..., ...(FALSE ARGUMENTS)...)

---

Need For Speed: Faster Pset
I am recreating a mosaic-like image from a small pic ala "point" and then "pset" (used hand-in-hand with drawwidth) the pixels into a bigger picturebox.

but it took me about .25 secs (that's quite a LONG time!) just to do that on a 30x20 pixels pic. I found out the lag comes from "pset"

Any faster workaround for this?

thanks.

---

RESOLVED - Processing Speed, Which Is Faster
Hello all,

I'm working on a program that needs to reference data from a database constantly. Because of the amount of data i can not use numerous arrays.

So my question is...
Which of the following is faster?

1. Ask Access to find the data for me

OR

2. get my program to search through it's recordsets till it finds the data needed

Thanks

MTB



Edited by - mtbTiming on 2/9/2005 2:50:34 PM

---

How To Make MS Access Process Speed Faster...??
How to make MS Access process speed faster...??

I have a databse table that contain alot of record, when I click view all it take very long time to load it....? Can it solve?

---

Finding Directories Faster. {search,speed}
Hello,
I am using the following code to find directories on a computer, for a search type program and to find the directories it takes a long time and i was wondering if there is any way in which i can speed it up.
Thanks Justin.

FileOpen(1, "music_catalogger/search_files/directory_name.txt" , OpenMode.Input)
Do Until EOF(1)
System.Convert.ToDecimal(counter.Text)
Seek(1, counter.Text)
myValue = LineInput(1)
ContentItem = Dir(myValue, FileAttribute.Directory)
Do Until ContentItem = ""
If IO.Directory.Exists(myValue + ContentItem) = False Then
Else
If IO.Directory.Exists(myValue + ContentItem) = True Then
FileClose(1)
Dim myChar As Char
If myValue = "" Then
Else
myChar = myValue.Chars(0)
If myChar = "C" Then
sWriter = IO.File.AppendText("music_catalogger/search_files/d irectory_name.txt")
sWriter.WriteLine(myValue + ContentItem + "")
sWriter.Close()
Else
If myChar = "" Then
End If
End If
End If
End If
FileOpen(1, "music_catalogger/search_files/directory_name.txt" , OpenMode.Input)
End If
ContentItem = Dir()
Loop
counter.Text = counter.Text + System.Convert.ToDecimal("1")
Loop
counter.Text = "1"
FileClose(1)

---

Faster Connection Or Faster Code!!!
I have attached the executable of a program i made. It contains a few web browser controls and i was wondering if it is possible to make it run faster. The code is basically as follows exept in a larger scale(note this is not from the acctual code it just shows how it works).
Code:webbrowser1.navigte"www.webpage.com"
webbrowser2.navigate "www.webpage2.com"
Would i need better code or a faster connection for this program to run quicker?

---

Are Directx's Drawing Functions Faster Than The API's?
I'm thinking on making a little paint program, kinda like a copy of MSPaint. However, I'm wondering, are the directx drawing functions faster than the API's, like setpixel, getpixel, polygon, etc? I might make this a directx paint program, or a normal program with a picturebox. Also, I'm kind of leaned toward directx because it can easily stretch images and can have backbuffers and stuff.

---

Speed Of Trigonometric Functions
Is there any signifigant speed increase by using an array that stores the Sin and Cos of all angles from 0 to 359 (increment of 1) over simply calling Sin() and Cos() whenever I need it, assuming I will be calling them many times during my game loop?

---

Speed Question, Calling Functions
Quick question, is there any differnce in program speed if I use:

Function "variable1","variable2"
-or-
Call Function("variable1","variable2")

---

Faster Code
When calling a function or sub is it faster to use 'call' or not?
Also does anyone have some other tips on making code faster?

---

I Want My Code To Become Faster
hi, how to become my code faster?

this is my code:


VB Code:
Private Sub cmdFeed_Click()Dim ln As IntegerFor ln = 1 To Len(txtMobileNumber.Text)Select Case Mid(txtMobileNumber.Text, ln, 1)Case "0"thex ("1F 00 10 D1 00 06 00 01 46 00 01 0A 03 97")pause (100)thex ("1F 00 10 D1 00 06 00 01 47 00 01 0C 04 97")pause (100)Case "1"thex ("1F 00 10 D1 00 06 00 01 46 00 01 01 03 9C")pause (100)thex ("1F 00 10 D1 00 06 00 01 47 00 01 0C 04 97")pause (100)Case "2"thex ("1F 00 10 D1 00 06 00 01 46 00 01 02 03 9F")pause (100)thex ("1F 00 10 D1 00 06 00 01 47 00 01 0C 04 97")pause (100)Case "3"thex ("1F 00 10 D1 00 06 00 01 46 00 01 03 03 9E")pause (100)thex ("1F 00 10 D1 00 06 00 01 47 00 01 0C 04 97")pause (100)End SelectNext lnEnd Sub

---

Faster Code?
It's probably the getString that's taking so long. Test and see if you program downloads the file fast and then you will know that it is getString slowing things down. If it is then you must use regular expressions to do the search... they are fast as hell.

I posted something on regex's on here so search the forums for it or here is a link to something that will get you started... http://msdn.microsoft.com/library/de...ting051099.asp

To use regex's go to Project > References in the vb menu and select Microsoft VBScript 5.5.

Hope this helps.

---

Which Code Is Faster?
which code is faster between these code 1 and code 2?

Code 1:
Dim rst As New ADODB.Recordset
rst.Open "product", conn, adOpenKeyset, adLockOptimistic, _ adCmdTable
rst.Find "code = '" & Text1.Text & "'"

Code 2:
Dim rst As New ADODB.Recordset
rst.Open "select * from product where code = '" & Text1.Text "'", _ conn, adOpenKeyset, adLockOptimistic, adCmdTable


and which is faster between this code:

rst.Addnew
rst!code = Text1.Text
rst!name = Text2.Text
....
....
rst.Update

with SQL Commands (INSERT, UPDATE, DELETE)?
thx

---

Faster Code
Hi all
I am just curious about which control loops or statements in vb
perform better in terms of speed.
e.g Heavy nesting of if ...endif, do.. loop might slow the
application.
Which variable types are more faster?
I heard int are slower than long.
Is there any method to compare the speed of execution ( any utility? ) and test memory leaks?
Thanks in advance.

---

Faster Code?
Here’s the question – I have need of code that essentially scans a text file for a number of key words. If the words are found in the text, the they are replaced. I have coded as follows :

Ret = instr(1, TextString, “Word one”,1)
If ret then
Do
‘ code here to replace word and do other things
Ret = instr(1, TextString, “Word one”,1)
loop while ret
end if

Ret = instr(1, TextString, “Word two”,1)
If ret then
Do
‘ code here to replace word and do other things
Ret = instr(1, TextString, “Word two”,1)
loop while ret
end if

etc … thru word twenty.

Execution is slow. Any ideas of using a case statement, or speeding this up?
Thanks,
Bob.

---

How Can I Make This Code Faster?
Code:
Public Sub imgFindEdges(hDestDC As Long, xDst As Long, yDst As Long, _
nWidth As Long, nHeight As Long, hSrcDC As Long, xSrc As Long, _
ySrc As Long, Tolerance As Integer)

Dim bSrc() As Byte, bDst() As Byte
Dim tSA As SAFEARRAY2D, tSADst As SAFEARRAY2D
Dim cDib As New cDIBSection, cDIBDst As New cDIBSection
cDib.Create nWidth, nHeight
cDIBDst.Create nWidth, nHeight
BitBlt cDib.hDC, 0, 0, nWidth, nHeight, hSrcDC, xSrc, ySrc, vbSrcCopy
BitBlt cDIBDst.hDC, 0, 0, nWidth, nHeight, hSrcDC, xSrc, ySrc, vbSrcCopy
With tSA
.cbElements = 1
.cDims = 2
.Bounds(0).cElements = cDib.Height
.Bounds(1).lLbound = 0
.Bounds(1).cElements = cDib.BytesPerScanLine
.pvData = cDib.DIBSectionBitsPtr
End With
With tSADst
.cbElements = 1
.cDims = 2
.Bounds(0).cElements = cDIBDst.Height
.Bounds(1).lLbound = 0
.Bounds(1).cElements = cDIBDst.BytesPerScanLine
.pvData = cDIBDst.DIBSectionBitsPtr
End With
CopyMemory ByVal VarPtrArray(bSrc()), VarPtr(tSA), 4
CopyMemory ByVal VarPtrArray(bDst()), VarPtr(tSADst), 4

Dim X As Long
Dim Y As Long
Dim xEnd As Long
Dim yEnd As Long
Dim fR As Double
Dim fB As Double
Dim fG As Double
Dim equal As Boolean
xEnd = cDib.BytesPerScanLine() - 3
yEnd = cDib.Height - 1
For X = 0 To xEnd - 6 Step 3
For Y = 0 To yEnd - 2
For yy = 0 To 2
equal = True
For xx = 0 To 8 Step 3
If yy = 0 And xx = 0 Then
fB = bSrc(X + xx, Y + yy)
fG = bSrc(X + xx + 1, Y + yy)
fR = bSrc(X + xx + 2, Y + yy)
Else
If bSrc(X + xx, Y + yy) < fB - Tolerance Or bSrc(X + xx, Y + yy) > fB + Tolerance _
Or bSrc(X + xx + 1, Y + yy) < fG - Tolerance Or bSrc(X + xx + 1, Y + yy) > fG + Tolerance _
Or bSrc(X + xx + 2, Y + yy) < fR - Tolerance Or bSrc(X + xx + 2, Y + yy) > fR + Tolerance Then
equal = False
End If
End If
Next xx
Next yy
If equal Then
bDst(X + 3, Y + 1) = 255
bDst(X + 4, Y + 1) = 255
bDst(X + 5, Y + 1) = 255
End If
Next Y
Next X
BitBlt hDestDC, xDst, yDst, nWidth, nHeight, cDIBDst.hDC, 0, 0, vbSrcCopy
CopyMemory ByVal VarPtrArray(bSrc), 0&, 4
CopyMemory ByVal VarPtrArray(bDst), 0&, 4
End Sub

This sub currently takes about 5000ms to complete on a large image when compiled. If the contents of the For loops is removed (the maths) and the For loops left in place the sub only takes about 700ms. I am hoping some of you will be able to think of some faster ways of doing the maths held within the For loops.

Thanks for your time
Jonny

---

Which Code Excute Faster?
I am using vb6 and sql server 2000.

I have code like this:

Code:
strSQl = "SELECT * FROM Customer WHERE CustomerID ='" & strCustID & "' "
strSQl =strSQl & " AND CustomerID_DT ='" & rcsPtsToCTrak!customerid & "'"

Set rcsTracking = New ADODB.Recordset
rcsTracking.Open strSQl, ConnTracking, adOpenKeyset, adLockOptimistic



Or

Code:
rcsTracking.MoveFirst
rcsTracking.Find "CustomerID_DT ='" & rcsPtsToCTrak!customerid & "'"



The records are about 70K. Which code excute faster?

Thanks.

---

Can This Code Be Made Faster?
Hello, below is the code somebody gave me a while ago to read frames from an AVI video and find out which type they are. It reads the first 500 frames (2 - 2,5mb) of an AVI video and then reads certain bits to get the frame type.

The problem is that it takes 1 - 2 seconds to get the information, while my app gets a lot more information from an AVI video and does it all in 2 or 3/10th of a second. This means the app gets a lot slower only to get this little bit of information.

Does anybody know how to make this code faster (if possible) ?

You can test it out yourself. Add a commandbutton (Command1) and a ListView (Listview1).



VB Code:
Option Explicit Dim searchBytes(0 To 3) As ByteDim sBVOP As StringDim sSVOP As StringDim itemx As ListItem Private Sub Command1_Click()  Dim p As Long, c As Long, FileName As String, strBits As String  Dim BitsArr() As Boolean      On Error GoTo LastLine        sBVOP = "No"    sSVOP = "No"        With CommonDialog1        .Flags = cdlOFNExplorer + cdlOFNHideReadOnly        .Filter = "AVI Files (*.avi)|*.avi"        .DialogTitle = "Select avi file"        .InitDir = App.Path        .CancelError = True        .ShowOpen        If Not .FileName = "" Then                    FileName = .FileName         ListView1.ListItems.Clear        End If    End With   Open FileName For Binary As #1                           'Open the file  ReDim sourcebytes(1 To 1000000) As Byte                  'Size a byte array to hold the file  Get #1, , sourcebytes                                    'Get the file contents  Close #1  p = InStrB(sourcebytes, searchBytes)                     'Search for the first match  Do Until c > 499                                          'Continue while we have a match    c = c + 1                                              '  Increment the count            ByteToBits CByte(sourcebytes(p + 4)), BitsArr()    strBits = BitsToString(BitsArr())          '======================================================        Set itemx = ListView1.ListItems.Add(, , c)    itemx.SubItems(1) = strBits      '======================================================            If Left(strBits, 2) = "10" Then sBVOP = "Yes"    If Left(strBits, 2) = "10" Then itemx.ListSubItems(1).ForeColor = vbGreen    If Left(strBits, 2) = "11" And Right(strBits, 2) = "11" Then sSVOP = "Yes"    If Left(strBits, 2) = "11" Then itemx.ListSubItems(1).ForeColor = vbRed     p = InStrB(p + 4, sourcebytes, searchBytes)            '  Search for the next match  Loop                                                     'Loop MsgBox "B-VOP: " & sBVOP & vbCrLf & vbCrLf & "S(GMC)-VOP: " & sSVOP, vbInformation, "Output" LastLine:End Sub  Private Sub Form_Load()  searchBytes(0) = 0        'initial the array of bytes to what we're looking for  searchBytes(1) = 0  searchBytes(2) = 1  searchBytes(3) = 182     With ListView1        .ColumnHeaders.Add , , "#", 400        .ColumnHeaders.Add , , "Bits", 3700        .HideSelection = True        .FullRowSelect = True        .LabelEdit = lvwManual        .View = lvwReport    End With End Sub  Private Sub ByteToBits(ByteNum As Byte, BitsArr() As Boolean)On Error Resume Next    Dim ind0 As IntegerReDim BitsArr(7)ind0 = 7    Do        BitsArr(ind0) = ByteNum Mod 2 = 1        ByteNum = ByteNum 2        ind0 = ind0 - 1    Loop Until ByteNum = 0End Sub  Private Function BitsToString(BitsArr() As Boolean) As StringDim str0 As String, i As Integerstr0 = ""    For i = 0 To 7    If BitsArr(i) Then str0 = str0 & "1" Else str0 = str0 & "0"    NextBitsToString = str0End Function

---

Can I Have A Faster Shutdown Code ?
peace be with you

i hear abut that code it's make the shuting down very fast

thanks

---

Is There Any Faster Code For Saving Files ?
Hi Guys,

I have a codes for saving a result files to my own extension ".cpd", and the filename will get from "windows system time". There are no problem, but is there any faster code for this ?
is it possible to save from the excel directly to our own extension without screwing up the contents ?

here is the code:

Code:
Sub saving_files()

current_date = Date
current_date = FormatDateTime(current_date, vbLongDate)

current_time = Time
current_time = FormatDateTime(current_time, vbShortTime)
Mid(current_time, 3, 1) = "-"


Workbooks("Converter.xls").Worksheets("temp").Select
Cells.Copy
Worksheets.Application.Workbooks.Add

temporary_for_saving = ActiveWorkbook.Name
temporary_sheet_for_saving = ActiveSheet.Name

Workbooks(temporary_for_saving).Activate
Sheets(temporary_sheet_for_saving).paste

ActiveWorkbook.SaveAs Filename:=("result_file" & " " & current_date & " " & current_time), _
FileFormat:=xlTextWindows
temporary_sheet_for_saving = ActiveWorkbook.Name
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True

len_temporary_sheet_for_saving = Len(temporary_sheet_for_saving)
sheet_for_saving = Mid(temporary_sheet_for_saving, 1, len_temporary_sheet_for_saving - 4)
OldName = temporary_sheet_for_saving: NewName = sheet_for_saving & ".cpd"
Name OldName As NewName

End Sub

---

Make My *program* Faster - Not My Code
I read a few hundred to thousand items into an array, then print that to a listview. The problem is that it takes a few seconds to load the array, then almost a minute to add them to the listview. How do I stop the LV from redrawing until I'm done to same a LOT of time? (I assume this is what I need to do to reduce the time needed to add the files to the list).

---

How To Make This Code Perform Faster
i am using this the following to populate an combo box with names of the items from the db
[code]
Sub ItemsFill()
sql = "Select ItemDesc from ItemMasterAll order by ItemDesc"
IRs.Open sql, CON, adOpenForwardOnly, adLockReadOnly
Do Until IRs.EOF
CItemDesc.AddItem IRs!Itemdesc
IRs.MoveNext
Loop
IRs.Close
End Sub[code]

As the table contains >10000 records it is taking lot of time to populate the combo box. How can i make it perform faster

---

Need Faster Code (very Large String)
Code:

Private Sub ConvertKP_Route(ByVal s As String)
Dim t As Integer, tt As Integer, ttt As Integer, tttt As Integer
WriteIni TempProgramFile, "INFO", "1", " SystemPrinter# : 0 TO 40"
WriteIni TempProgramFile, "INFO", "2", " KP_Group# : 0 TO 9"
For t = 1 To 32
For tt = 1 To 4
For ttt = 1 To 10
DoEvents
WriteIni TempProgramFile, "KP_Routing_Reg_" & AddZeros(t, 2) & "_Period_" & CStr(tt) & "_Route_" & AddZeros(ttt, 2), "SystemPrinter#", Left$(s, 2)
s = Mid$(s, 3)
For tttt = 1 To 9
WriteIni TempProgramFile, "KP_Routing_Reg_" & AddZeros(t, 2) & "_Period_" & CStr(tt) & "_Route_" & AddZeros(ttt, 2), "KP_Group#" & CStr(tttt), Left$(s, 2)
s = Mid$(s, 3)
Next tttt
Next ttt
Next tt
Next t
FixIniFile TempProgramFile
End Sub
the length of "s" is 25776

---

Tips To Make My Code Faster *RESOLVED*
I have written a function that returns data seperated by commas depending on column no. passed e.g Csv_Str("hello,world",2) would return "world"

Here is the code, does anyone have any tips on making this faster?


Code:

'***********************************************************************
'| Name Csv_Str
'| Description Returns data seperated by commas depending on column no. passed
'| e.g Csv_Str("hello,world",2) would return "world"
'| Passed Args string, column
'| Rtned Args column string
'***********************************************************************

Public Function Csv_Str(ByVal str As String, ByVal Column As Long) As String

Dim a As Long
Dim count As Long
Dim start_pos As Long
Dim start_str As Boolean
Dim end_pos As Long

On Error GoTo CatchError

If Column = 1 Then
start_str = True
End If

start_pos = 1
count = 2

For a = 1 To Len(str)

'** find first comma ***
If start_str = False Then
If Mid(str, a, 1) = "," Then
If count = Column Then
start_pos = a + 1
start_str = True
End If
count = count + 1
End If
Else

'** find next comma ****

If Mid(str, a, 1) = "," Then
end_pos = a
Exit For
End If
End If
Next

If end_pos = 0 Then end_pos = Len(str) + 1

If (end_pos > start_pos) And (end_pos <= Len(str) + 1) And (start_str = True) Then
Csv_Str = Mid(str, start_pos, end_pos - start_pos)
Else
Csv_Str = ""
End If


Exit Function

CatchError:

MsgBox err.number & " " & err.Description, , "Csv_str"

End Function

---

Speed Of Code
hi guys, its been a while since ive been here so i got deleted from the database - so im making my first post again

i have some code in excel that places all of the values of an array into an area of a worksheet, i then want the sheet to change the interior color of the cells depending on thei value, array1 is the array with the old values, array2 is the array with the new values. i wrote this code to do the job:


Code:
Application.ScreenUpdating = False
For i = 1 To 99999
For j = 1 To 99999
Cells(i, j) = Array2(i, j)
If Array1(i, j) = 0 And Array2(i, j) = 1 Then
Cells(i, j).Interior.ColorIndex = 1
Else
If Array1(i, j) = 1 Array2(i, j) = 0 Then
Cells(i, j).Interior.ColorIndex = 2
End If
End If
Next j
Next i

Application.ScreenUpdating = True
the problem is that this code takes a very long time to run, and i would like to find a more efficient way of doing this. i know i can put the values of array2 into the cells very quickly with the code:

Code:
With Range(Cells(1, 1), Cells(99999, 99999))
.Value = Array2
End With
but this doesnt change the color of the cells which i need to do.

Thanks alot for any help

---

Code Speed
If I Then A = Y Else A = X
or A =iif(I,Y,X) faster

also
do
loop until x

or
dowhile (Not x)
loop

---

Can I Speed This Code Up?
It's a bit long, but it does work. I am just looking to see if there's something new I can learn that would speed this up. I dont wanna put anyone out by writing code for me; I got what I needed from this and am just curious if there's something I could do, in theory, that could speed it up. Of course, if you want to write code you can

I needed to find a combinations of the number's 1 or 2 that could fit into 25 weeks. (e.g. 1,1,1,1,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,2,1,1,1,1,1,1) I went through *every* combination first, then I applied some parameters on it. The combination must have 17 1's and 8 2's, and cannot have more than 2 consecutive 2's.

I had no concept of how many combos this would create (33 + mil). My results show a little over 31k combos that I can use with the parameters. This is all bearing on, of course, if my code is correct.

I forgot who I got the code from, but I got it from here, so i am indirectly crediting the original poster. It was someone who had a similar design to get all of the combos in a poker game, but i cant find the post!


Code:
Dim w1, w2, w3, w4, w5, w6, w7, w8, w9, w10, w11, w12, w13, w14, w15, w16, w17, _
w18, w19, w20, w21, w22, w23, w24, w25 As Integer
Dim cntCombo As Long
Dim count2 As Long, count1 As Long
Dim x As Integer
Dim weeks(0, 25)
Dim consec2 As Integer
Dim cntTotal As Long

Screen.MousePointer = vbHourglass

For w1 = 1 To 2
weeks(0, 1) = w1
For w2 = 1 To 2
weeks(0, 2) = w2
For w3 = 1 To 2
weeks(0, 3) = w3
For w4 = 1 To 2
weeks(0, 4) = w4
For w5 = 1 To 2
weeks(0, 5) = w5
For w6 = 1 To 2
weeks(0, 6) = w6
For w7 = 1 To 2
weeks(0, 7) = w7
For w8 = 1 To 2
weeks(0, 8) = w8
For w9 = 1 To 2
weeks(0, 9) = w9
For w10 = 1 To 2
weeks(0, 10) = w10
For w11 = 1 To 2
weeks(0, 11) = w11
For w12 = 1 To 2
weeks(0, 12) = w12
For w13 = 1 To 2
weeks(0, 13) = w13
For w14 = 1 To 2
weeks(0, 14) = w14
For w15 = 1 To 2
weeks(0, 15) = w15
For w16 = 1 To 2
weeks(0, 16) = w16
For w17 = 1 To 2
weeks(0, 17) = w17
For w18 = 1 To 2
weeks(0, 18) = w18
For w19 = 1 To 2
weeks(0, 19) = w19
For w20 = 1 To 2
weeks(0, 20) = w20
For w21 = 1 To 2
weeks(0, 21) = w21
For w22 = 1 To 2
weeks(0, 22) = w22
For w23 = 1 To 2
weeks(0, 23) = w23
For w24 = 1 To 2
weeks(0, 24) = w24
For w25 = 1 To 2
weeks(0, 25) = w25
cntTotal = cntTotal + 1
x = 1
Do Until x > 25
If weeks(0, x) = 2 Then consec2 = consec2 + 1 Else consec2 = 0
If consec2 > 2 Then Exit Do

x = x + 1
'Next x
Loop

If consec2 <= 2 Then
'count em
For x = 1 To 25
If weeks(0, x) = 1 Then count1 = count1 + 1 Else count2 = count2 + 2
If count2 > 8 Then x = 25
Next x



If count1 = 17 Then
'good combo

'write it
' If cntCombo < 100 Then
' Form1.txtData = Form1.txtData & _
' w1 & ", " & w2 & ", " & w3 & ", " & w4 & ", " & w5 & ", " & w6 & ", " & w7 & ", " & _
' w8 & ", " & w9 & ", " & w10 & ", " & w11 & ", " & w12 & ", " & w13 & ", " & w14 & ", " & _
' w15 & ", " & w16 & ", " & w17 & ", " & w18 & ", " & w19 & ", " & w20 & ", " & w21 & ", " & _
' w22 & ", " & w23 & ", " & w24 & ", " & w25 & vbCrLf
' End If
cntCombo = cntCombo + 1
End If

count1 = 0: count2 = 0:


End If
consec2 = 0
Next w25
Next w24
Next w23
Next w22
Next w21
Next w20
Next w19
Next w18
Next w17
Next w16
Next w15
Next w14
Next w13
Next w12
Next w11
Next w10
Next w9
Next w8
Next w7
Next w6
Next w5
Next w4
Next w3
Next w2
Next w1

Screen.MousePointer = vbDefault
MsgBox FormatNumber(cntCombo, 0) & " good combinations " & vbCrLf & "out of " & _
FormatNumber(cntTotal, 0)
End Sub

---

How To Speed My Code
Sir,
i am writing a program to convert text in my richtext box to another format.

For a = 1 To Len(frmEditor.RichText1.Text)
If Mid(frmEditor.txtMain.Text, a, 1) = "s" And Mid(frmEditor.txtMain.Text, a + 1, 1) = "s" And Mid(frmEditor.txtMain.Text, a + 2, 1) = "{" Then
txt = txt & "GR"
ElseIf Mid(frmEditor.txtMain.Text, a, 1) = "s" And Mid(frmEditor.txtMain.Text, a + 1, 1) = "s" Then
txt = txt & "LM"
ElseIf Mid(frmEditor.txtMain.Text, a, 1) = "s" And Mid(frmEditor.txtMain.Text, a + 1, 1) = "s" Then
txt = txt & "MT"
....................
..................
........................
...................
Else
txt = txt & Mid(frmEditor.txtMain.Text, a, 1)
Endif


above is an abstract of my code. what my problem is when converting large text it takes very much time. how can my speed up my program? i wan to check one character by character. please help....

raman

---

Anyway To Speed Up This Code...
Hi,

i have coded this function to solve an anagram. Pretty simple however it takes a long time to solve a word when its pretty long in length.


VB Code:
Option explicitDim Lettersinputted As StringDim word As StringDim temp As StringDim randomlen As IntegerDim temp2 As StringDim i As Integer Function Solve()Lettersinputted = "ecnednopserroc"word = "correspondence"temp = ""Do Until temp2 = word        For i = 1 To Len(Lettersinputted)            randomlen = Int(Rnd * Len(Lettersinputted)) + 1            temp = temp + Mid(Lettersinputted, randomlen, 1)        Next i    temp2 = temp    Debug.Print temp2    temp = ""LoopMsgBox "Solved"temp2 = ""End Function


Any ideas on how to speed it up? cheers.

---

Help With Code Speed
Hi all,

Does anyone know how I can make this code go faster (esp. the for...next loop) and still have the same functionality. It uses 2 listboxes. It copies any row that has the XText$ contained somewhere in it, to the other list box.

Dim S As String
Dim I As Integer
Dim J As Integer
Dim bytQQ As Byte 'Byte max is 255
Dim bytRR As Byte 'Byte max is 255
bytQQ = 1 'variable is quicker than number in a loop
bytRR = 0 'variable is quicker than number in a loop
J = List1.ListCount - 1 'variable is quicker than number in a loop
S = LCase(XText)

For I = bytRR To J
If InStr(bytQQ, LCase(List1.List(I)), S, vbTextCompare) > bytRR Then List2.AddItem List1.List(I)
Next

Thanx in advance for assistance/suggestions.

---

Speed This Code Up!?
VB Code:
rst.Open "SELECT s.SeatID, Column, Row, Undercover, st.Status FROM SeasonSeat as s INNER JOIN SeatStatus as st on s.seatid = st.seatid WHERE Bay = '" & cBay.bay & "' AND st.SeasonID = " & currentSeason.mlSeasonID, db.cnn        Dim column As Integer    Dim row As Integer        For row = 1 To flxSeats.Rows - 1        flxSeats.row = row        For column = 1 To flxSeats.Cols - 1            flxSeats.ColWidth(column) = 350            rst.Filter = "Column = '" & columnHeaders(column) & "' AND Row = '" & rowHeaders(row) & "'"            flxSeats.col = column            flxSeats.CellAlignment = flexAlignCenterBottom            If rst.EOF = False And rst.BOF = False Then                flxSeats.Text = columnHeaders(column)                Select Case IIf(IsNull(rst!status), "", UCase(rst!status))                    Case "SOLD"                        flxSeats.CellBackColor = lblColour(mC_SOLD).BackColor                    Case "AVAILABLE"                        flxSeats.CellBackColor = lblColour(mC_AVAILABLE).BackColor                    Case "AWAITING RENEWAL"                        flxSeats.CellBackColor = lblColour(mC_AWAITINGRENEWAL).BackColor                    Case "ON HOLD"                        flxSeats.CellBackColor = lblColour(mC_ONHOLD).BackColor                    Case "NOT FOR SALE"                        flxSeats.CellBackColor = lblColour(mC_NOTAVAILABLE).BackColor                        flxSeats.Text = ""                    Case "COMPLIMENTARY"                        flxSeats.CellBackColor = lblColour(mC_COMPLIMENTARY).BackColor                   Case ""                        flxSeats.CellBackColor = lblColour(mC_NOTAVAILABLE).BackColor                        flxSeats.Text = ""                    Case Else                        flxSeats.CellBackColor = lblColour(mC_NOTAVAILABLE).BackColor                        flxSeats.Text = ""                End Select                seatIDS(faIndex(row, column)) = rst!seatID                If rst!Undercover = 1 Then                    flxSeats.CellFontUnderline = True                    flxSeats.CellFontBold = True                Else                    flxSeats.CellFontUnderline = False                    flxSeats.CellFontBold = False                End If            Else                flxSeats.CellBackColor = lblColour(mC_NOTAVAILABLE).BackColor                flxSeats.Text = ""           End If        Next column    Next row


basically it creates a spreadsheet of a seating map, with different colour coded status' of seats.
but it takes a long time to run... so if any of u performance nuts know a trick or 2, post!

thanks

---

Code Speed!
if you are using an array in your code, does it effect the spped of the compiled code if you say:

VB Code:
dim var(7)           'dim var(0 to 7)dim var(1 to 8)

each has 8 elements, the base is just different. does it matter at all?

---

CPU Speed Code
Hi All,

Does any one have, or know where I can get VB code to calculate the actual speed of a CPU.

I have been looking all over the place and have not found code that does this.

There are API calls to get all other information but not CPU speed.
What I am looking for is code that calculates the speed.

Any help will be greatly appreciated.
Thanks

---

Speed Up The Code
The Code below is for exporting an entire database to an XML file. It takes a database then each table by table from the database and then selects each record by record and then each field by field .....it takes a lot of time when the table contains a lot of records and columns ...Any idea to speed up the code...This is the structure of the XML file.


<Data>
<Table Table_Name="Table1">
<Record No="1">
<Field1>value</Field1>
...................................
...................................
...................................
<Fieldn>value</Fieldn>
<Record No="2">
<Field1>value</Field1>
...................................
...................................
...................................
<Fieldn>value</Fieldn>
...........................................
...........................................
<Record No="n">
<Field1>value</Field1>
...................................
...................................
...................................
<Fieldn>value</Fieldn>
</Table>
<Table Table_Name="Table2">
..................................................
..................................................
..................................................
</Table>
</Data>














Private ObjXMLDoc As DOMDocument
Private ObjXMLTab As IXMLDOMElement
Private ObjXMLRec As IXMLDOMElement
Private ObjXMLFld As IXMLDOMElement
Public Function gfWritetoXML(sFilename As String, Tables As Collection, Property1 As Collection, Property2 As Collection, Property3 As Collection)
Dim iloop As Long, jloop As Long, Count As Long
Dim objrec As Recordset
Dim item As Variant
Dim strsql As String
Dim Sdolar As String
Dim strFldName As String
psInitializeXML sFilename
Set objrec = New Recordset
objrec.ActiveConnection = objDB
jloop = 0
frmProgress.pbarStatus.Max = Tables.Count
frmProgress.pbarStatus.Min = 0
frmProgress.Refresh
frmProgress.pbarStatus.Value = 0
frmProgress.lblCaption.Caption = "Precessing Tables"
For Each item In Tables
DoEvents
frmProgress.pbarStatus.Value = frmProgress.pbarStatus.Value + 1
DoEvents
frmProgress.Refresh
frmProgress.lblCaption.Caption = "Precessing Table " & item & "...."
jloop = jloop + 1
Set ObjXMLTab = ObjXMLDoc.createElement("Table")
ObjXMLTab.setAttribute "Table_Name", item
If Property1.item(jloop) = 1 Then
ObjXMLTab.setAttribute "Delete_Table", "Y"
Else
ObjXMLTab.setAttribute "Delete_Table", "N"
End If
If Property2.item(jloop) = 1 Then
ObjXMLTab.setAttribute "Update_Data", "Y"
Else
ObjXMLTab.setAttribute "Update_Data", "N"
End If
ObjXMLDoc.documentElement.appendChild ObjXMLTab
strsql = "select * from " & item & " " & Property3.item(jloop)
objrec.open strsql, , adOpenForwardOnly, adLockReadOnly
If Not (objrec.EOF = True And objrec.BOF = True) Then
Do While Not objrec.EOF
DoEvents
Set ObjXMLRec = ObjXMLDoc.createElement("Record")
ObjXMLRec.setAttribute "Record_Number", objrec.AbsolutePosition
ObjXMLTab.appendChild ObjXMLRec
DoEvents
For iloop = 0 To objrec.Fields.Count - 1
DoEvents
If InStr(objrec.Fields(iloop).Name, "$") <> 0 Then
strFldName = Mid(objrec.Fields(iloop).Name, InStr(objrec.Fields(iloop).Name, "$") + 3)
Sdolar = "Y"
Else
strFldName = objrec.Fields(iloop).Name
Sdolar = ""
End If
DoEvents
Set ObjXMLFld = ObjXMLDoc.createElement(strFldName)
If Sdolar <> vbNullString Then ObjXMLFld.setAttribute "DolarField", Sdolar
If objrec.Fields(iloop).Type = 205 Then
ObjXMLFld.Text = "0x" & pfGetHexVal(objrec.Fields(iloop))
Else
ObjXMLFld.Text = objrec.Fields(iloop).Value & ""
End If
ObjXMLRec.appendChild ObjXMLFld
Next
Set ObjXMLFld = Nothing
DoEvents
objrec.MoveNext
Set ObjXMLRec = Nothing
Loop
End If
objrec.Close
ObjXMLDoc.save sFilename
Set ObjXMLTab = Nothing
frmProgress.Caption = "Exporting Data to XML File ...." & Str(Round((jloop / Tables.Count) * 100)) & "% Completed"
Next
frmProgress.Refresh
frmProgress.lblCaption.Caption = "Exported Data to the XMl File"
frmProgress.CmdOK.Enabled = True
Set ObjXMLDoc = Nothing
End Function
Private Sub psInitializeXML(Filename As String)
Set ObjXMLDoc = New DOMDocument
ObjXMLDoc.resolveExternals = True
ObjXMLDoc.validateOnParse = True
ObjXMLDoc.async = False
ObjXMLDoc.Load Filename
If ObjXMLDoc.parseError.reason <> "" Then
If ObjXMLDoc.parseError.errorCode = -2146697210 Then
Dim FileNumber As Long
FileNumber = FreeFile
Open Filename For Output As #FileNumber
Print #FileNumber, "<?xml version=" & """1.0""?>"
Print #FileNumber, "<Data></Data>"
Close #1
psInitializeXML Filename
Else
MsgBox ObjXMLDoc.parseError.reason
End If
End If
End Sub
Private Function pfGetHexVal(SourceFld As Field) As Variant
On Error GoTo Errhand
Dim varDest As Variant
Dim sHex As String
Dim b() As Byte
Dim pos As Long
pos = 1
Do
b = MidB(SourceFld.Value, pos, 1)
sHex = Hex(AscB(b))
If Len(sHex) = 1 Then sHex = "0" & sHex
varDest = varDest & sHex
pos = pos + 1
Loop
Exit Function
Errhand:
pfGetHexVal = varDest
End Function

---

SPEED UP THIS CODE!!
I'm using this function to tile a picture to an object, and I need this as fast as humanly possible!!
It really starts to lag when the object is full screen using any type of picture.

Ready? SPEED UP THIS CODE!!!

Code:
Public Sub TileImage(RefObject As Object, ImageToTile As PictureBox)
Dim lngX&, lngY&, lngBitmapHandle&, lngFormHeight&, lngFormWidth&
Dim lngPictureHeight&, lngPictureWidth&
Dim lngPrevScale&, lngRet&, lngSourceDC&

On Error GoTo Err

With ImageToTile
lngPrevScale = .ScaleMode
.ScaleMode = vbPixels
lngPictureHeight = .ScaleHeight
lngPictureWidth = .ScaleWidth
.ScaleMode = lngPrevScale
End With

With RefObject
lngPrevScale = .ScaleMode
.ScaleMode = vbPixels
lngFormHeight = .ScaleHeight
lngFormWidth = .ScaleWidth
.ScaleMode = lngPrevScale
End With

lngSourceDC = CreateCompatibleDC(RefObject.hdc)
lngBitmapHandle = SelectObject(lngSourceDC, ImageToTile.Picture.Handle)

'core tiling routine
For lngY = 0 To lngFormHeight Step lngPictureHeight
For lngX = 0 To lngFormWidth Step lngPictureWidth
lngRet = BitBlt(RefObject.hdc, lngX, lngY, lngPictureWidth, lngPictureHeight, RefObject.hdc, 0, 0, SRCCOPY)
Next lngX
Next lngY

lngRet = SelectObject(lngSourceDC, lngBitmapHandle)
lngRet = DeleteDC(lngSourceDC)

Exit Sub

Err:
If Not RefObject Is Nothing Then
RefObject.Tag = Err.Number & " " & Err.Description
Debug.Print (Err.Number & " " & Err.Description)
End If
End Sub

Please post ANY and ALL suggestions/code snippets that will speed this up!!

Thanks,

Joe Jordan

---

Help Speed Up This VB6 Code
In conjunction with MAS 200 (Sage) and Access 97, we have a script that generates sales order numbers for a batch of orders that have been imported into the Access database.  The code runs very slow and we are hoping to see if anything can be removed / changed to make it faster.  Here is the code (followed by the Module named GetNextSONum):

CODEPrivate Sub cmdGenerate_Click()
   Dim rst As DAO.Recordset, db As DAO.Database, rstSO As DAO.Recordset, rstCust As DAO.Recordset
   Dim Skipped As Boolean, SONum As String, CustNum As String, TooLong As Boolean
   Dim curOrderNum As String
    
   Skipped = False
   TooLong = False
    curOrderNum = vbNullString
    
    cmdCancel.SetFocus
    cmdGenerate.Enabled = False
    chkYahoo.Enabled = False
    chkShopAmex.Enabled = False
    chkComerxia.Enabled = False
    chkAmazon.Enabled = True
    
    Set db = CurrentDb
    Screen.MousePointer = 11
    
    If chkAmazon Then
       db.Execute "UPDATE [Orders-Amazon] SET [Orders-Amazon].[buyer-name] = xg_ReplaceAllWith([buyer-name],"""""""",""'"") WHERE ((([Orders-Amazon].[buyer-name]) Like ""*""""*""))"
       DoEvents
       Set rst = db.OpenRecordset("Orders-Amazon")
        
       If rst.RecordCount > 0 Then
           rst.MoveFirst
           Do
StartOfAmazonLoop:
                If curOrderNum = vbNullString Then
                    curOrderNum = rst![order-id]
                Else
                    If rst![order-id] = curOrderNum Then
                        rst.MoveNext
                        GoTo StartOfAmazonLoop
                    Else
                        curOrderNum = rst![order-id]
                    End If
                End If
                
                
                Set rstSO = db.OpenRecordset("SELECT * FROM [Order Links] WHERE [Order_num] = '" & rst![order-id] & "'")
                
                If rstSO.RecordCount <= 0 Then
                    SONum = GetNextSONum
                    'Set rstCust = db.OpenRecordset("SELECT MAS_Customers.CustomerNumber FROM MAS_Customers WHERE (((Ucase(MAS_Customers.CustomerName))=""" & UCase(rst![buyer-name]) & """) AND ((Ucase(MAS_Customers.AddressLine1))=""" & UCase(rst![ship-address-1]) & """) AND ((MAS_Customers.ZipCode)='" & rst![ship-postal-code] & "')" & IIf(IsNull(rst![ship-address-2]), vbNullString, " AND((ucase(MAS_Customers.AddressLine2))=""" & UCase(rst![ship-address-2]) & """)") & IIf(IsNull(rst![ship-address-3]), vbNullString, " AND ((Ucase(MAS_Customers.AddressLine3))=""" & UCase(rst![ship-address-3]) & """)") & ")")
                    
                    
                    'If Not rstCust.EOF Then
                        'CustNum = rstCust!Customernumber
                    'Else
                        'rstCust.Close
                        'Set rstCust = db.OpenRecordset("SELECT AR1_CustomerMaster.CustomerNumber FROM AR1_CustomerMaster WHERE (((Ucase(AR1_CustomerMaster.CustomerName))=""" & UCase(rst![buyer-name]) & """) AND ((Ucase(AR1_CustomerMaster.AddressLine1))=""" & UCase(rst![ship-address-1]) & """) AND ((AR1_CustomerMaster.ZipCode)='" & rst![ship-postal-code] & "')" & IIf(IsNull(rst![ship-address-2]), vbNullString, " AND((Ucase(AR1_CustomerMaster.AddressLine2))=""" & UCase(rst![ship-address-2]) & """)") & IIf(IsNull(rst![ship-address-3]), vbNullString, " AND ((Ucase(AR1_CustomerMaster.AddressLine3))=""" & UCase(rst![ship-address-3]) & """)") & ")")
                        
                        'If Not rstCust.EOF Then
                            'CustNum = rstCust!Customernumber
                        'Else
                            'CustNum = GetNextCustNum
                            'NewCustomer = True
                        'End If
                    'End If
                    'rstCust.Close
                    
                    db.Execute "INSERT INTO [Order Links] (MAS_num, Order_num) VALUES ('" & SONum & "','" & rst![order-id] & "')"
                    
                    'If NewCustomer Then
                    '    Set rstCust = db.OpenRecordset("MAS_Customers")
                    '    rstCust.AddNew
                    '    rstCust!Customernumber = CustNum
                    '    rstCust!customername = Left(rst![buyer-name], 30)
                    '    rstCust!addressline1 = Left(rst![ship-address-1], 30)
                    '    rstCust!addressline2 = Left(rst![ship-address-2], 30)
                    '    rstCust!addressline3 = Left(rst![ship-address-3], 30)
                    '    rstCust!Zipcode = rst![ship-postal-code]
                    '    rstCust.Update
                    '    rstCust.Close
                    '    DoEvents
                    '    NewCustomer = False
                    '    If TooLong = False Then
                    '        If Len(rst![buyer-name]) > 30 Or Len(rst![ship-address-1]) > 30 Or Len(rst![ship-address-2]) > 30 Or Len(rst![ship-address-3]) > 30 Then
                    '            TooLong = True
                    '        End If
                    '    End If
                    'End If
                    
                Else
                    Skipped = True
                End If
                
                rstSO.Close
                
                rst.MoveNext
            Loop While Not rst.EOF
        End If
        rst.Close
        curOrderNum = vbNullString
    End If
    
    cmdGenerate.Enabled = True
    chkYahoo.Enabled = False
    chkShopAmex.Enabled = False
    chkComerxia.Enabled = False
    chkAmazon.Enabled = True
    Screen.MousePointer = 0
    Dim FinishedMessage As String
    
    FinishedMessage = "Finished Generating Numbers."
    If Skipped Then
        FinishedMessage = FinishedMessage & "  Some Orders appeared to have already had Numbers Generated for them and were skipped."
    End If
    If TooLong Then
        FinishedMessage = FinishedMessage & "  One or more orders had fields that were too long for MAS, please run the Address Manipulation Form to truncate these fields."
    End If
    
    If TooLong Or Skipped Then
        MsgBox FinishedMessage, vbExclamation, "Generating Complete"
    Else
        MsgBox FinishedMessage, vbOKOnly, "Generating Complete"
    End If
    
    DoCmd.Close acForm, Me.Name, acSaveNo
    
    
End Sub

---

Code To Test Fan Speed
Hi all,

I want to write a small VB6 or VBScript program that will provide the speed (RPM) of my CPU fan and two case fans (plugged into mobo). Any idea how I can do this please?

The following script (for example) produces nothing at all:


Code:
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:\" & strComputer & "
ootcimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Fan",,48)
For Each objItem in colItems
Wscript.Echo "DesiredSpeed: " & objItem.DesiredSpeed
Wscript.Echo "VariableSpeed: " & objItem.VariableSpeed
Next

Thanks a lot
Chris

---

Increase Speed? [Of Code]
Okay, I need this code to go as fast as possible, and it's not quite cutting it. I'm parsing information from HTML of a site. Here is the basic idea:

-I already have the source
-Get all the Urls and Items off a page
-Add them both into an array
-Get a random number to pick up a random url which I will goto later.

Here is what I am using. Note: Data is the source.


VB Code:
Private Type MTG    strURL As String    strItem As StringEnd TypeDim udtMTG() As MTG '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' intIndes = 0     b = 1     Do      a = InStr(b, Data, "align=center valign=top><a href='") + 33      b = InStr(a, Data, "'")     If a = 33 Or b = 0 Then Exit Do        intIndes = intIndes + 1        tempURL = Mid$(Data, a, b - a)        ReDim Preserve udtMTG(intIndes)        udtMTG(intIndes).strURL = tempURL    Loop        intIndes = 0    d = 1     Do      c = InStr(d, Data, "border=1></a><br><b>") + 21      d = InStr(c, Data, "</b>")    If c = 21 Or d = 0 Then Exit Do        intIndes = intIndes + 1        tempITEM = Mid$(Data, a, b - a)        udtMTG(intIndes).strItem = tempITEM    Loop        lngRand = rand(0, intIndes) '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Function rand(ByVal Min As Double, _        ByVal Max As Double) As Double   ' A good random function '    Dim r As Double     If Not bolAfterFirstCall Then        Randomize        bolAfterFirstCall = True    End If     rand = Int(Rnd * (Max - Min + 1)) + MinEnd Function


Is there anyways to shorten/increase the speed of this?

---

Ways To Speed Up Code:
Just wondering guys, is there any ways to speed up my code? Anything generic is fine (like after using set x = lstitems.add or whatever, and setting it to nothing afterwards)

Do you have any other examples?

---

Speed Code Baby
OK! Lets see what we know about VB speed! If you
have any good gode to put in here, put it here! I will
start out with a basic optimization:

Have you ever wanted to Enable or Disable a
CommandButton depending on if text was eneterd into
1 or more TextBox's? You probably did something like
this:

Code:
If TextBox1 <> "" And TextBox2 <> "" Then
Command.Enabled = True
Else
Command.Enabled = False
EndIF

Ha! Use this! Its faster!

Code:
Command.Enabled = -Len(TextBox1) And -Len(TextBox2)

---

Guru One - Speed Of This Code ...
I have the following piece of code :

Code:
Dim Xls As Object
Dim Rs As Variant
Dim i As Integer

Set Xls = CreateObject("Excel.application")
Xls.Workbooks.Open "C:Prices.xls"
Set Rs = DB.OpenRecordset("DBPrices")



For i = 1 To 150
Rs.MoveFirst
Do While Not Rs.EOF
If Xls.Worksheets("sheet1").Cells(i, 1).Value = Rs!Chocky_Bar Then
With Rs
.Edit
!price = Worksheets("sheet1").Cells(i, 2).Value
.Update
TxtWait.Text = "Updated Excel record number " & i & _
"into Access database" & vbCrLf
End With
Exit Do
Else
Rs.MoveNext
End If
Loop
Next i

MsgBox "The Prices of chocky bars have been updated", _
vbOKOnly + vbInformation, "Finished !"

Xls.Quit
Set Xls = Nothing
Set Qdprice = Nothing

Brief intro :
This checks an Excel cell, and looks throughout column1 in an Access database for the same entry. If the entries found, the Excell cell to the right of the selected one has the data copied to the right of the selected Access recordset. If the data isn't found, the loop checks the other recordsets / column cells in the access database.

Question
This is taking ages to perform the calculation. Is there anything I can do to speed this code up please?

---

Speed Of My File Transfer Code
Below is the code i wrote to open a selected file and add it to another one. It works perfectly fine, but can be a bit slow with large files.

If anyone has any sugestions on how to improve it our how it could be better than please let me know.

Thanks for any help.


Code:
Public Function addFile(filePath As String, fileName As String, doMove As Boolean)
Dim selectedOffset As Long
Dim lastOffset As Long
Dim addAtOffset As Long
Dim inFileSize As Long
Dim inFileKB As Long
Dim blocking As Long
Dim padding As Long
Dim blocks As Long
Dim block As Byte

Set file = FSys.getFile(filePath)
inFileSize = file.size

Do Until blocking > inFileSize
blocking = blocking + 2048
Loop
blocks = blocking / 2048
padding = blocking - inFileSize

If Main.Archive.ListItems.Count <> 0 Then
selectedOffset = CLng("&H" & Trim(Main.Archive.ListItems(Main.Archive.ListItems.Count).ListSubItems(1).Text))
lastOffset = Replace(Main.Archive.ListItems(Main.Archive.ListItems.Count).ListSubItems(2).Text, "kb", "")
Else
selectedOffset = 0
lastOffset = 0
End If

lastOffset = (lastOffset / 2) * 2048
addAtOffset = lastOffset + selectedOffset
inFileKB = inFileSize / 1024

With Main.Archive.ListItems.Add(, , fileName)
.ListSubItems.Add , , Hex(addAtOffset)
.ListSubItems.Add , , blocks * 2 & "kb"
End With

Open openIMG For Binary Access Write As #1
Open filePath For Binary Access Read As #2
Get #2, , block
Put #1, addAtOffset + 1, block
For i = 1 To inFileSize
Get #2, , block
Put #1, , block
Next
block = 0
For i = 1 To padding - 1
Put #1, , block
Next
Close #1
Close #2

If doMove = True Then
Kill (filePath)
doMove = False
deleteFiles
For i = 1 To Main.Archive.ListItems.Count
Main.Archive.ListItems(i).Selected = False
Next
Main.Archive.ListItems(Main.Archive.ListItems.Count).Selected = True
Main.Archive.ListItems(Main.Archive.ListItems.Count).EnsureVisible
End If

Main.SB.Panels(2).Text = "Files: " & Main.Archive.ListItems.Count
End Function

---

Problem With Code Execution Speed
Hi all, I have execution speed problem with this code, could someone help me change the code so that it will execute faster?




Code:
Private Sub DecodeData(DataArray() as byte, Key as string, DataSize as Long) as Byte()


Dim ByteCounter as Long, KeyCounter as Long, Extracted as Long, Index as Long, Max as Long, BitCounter as Long
Dim Bit() as byte, ByteValue as Byte
Dim K as Byte
Redim Result(DataSize -1)
Max = UBound(DataArray())
Extracted = 0
Index = 0
KeyCounter = 0

For ByteCounter = 0 to (DataSize-1 )

BitCounter = ByteCounter*8
k = 7
ByteValue = 0
Do while (BitCounter <= ((ByteCounter+8)-1)) And (Index <= Max) And (KeyCounter <= Len(Key))

If mid$(Key, KeyCounter,1) = "1"

Bit(BitCounter) = DataArray(Index) And 1 ByteValue = ByteValue + Bit(BitCounter)*(2^k) Extracted = Extracted + 1 k = k -1

Endif

BitCounter = BitCounter + 1
Index = Index + 1
keycounter = KeyCounter + 1

Loop

Temp(ByteCounter) = ByteValue

Next ByteCounter

DecodeData = Temp()

End Sub

I wrote this procedure to "take" the lsb from WAV file samples. Each sample's value is 8 bit and stored in array called DataArray. I also using key for the decoding process. Key is bitstring "0101010100111.....". If the n-th bit of the key = 1, get the lsb from the n-th sample, if the n-th bit of the key = 0, move to the next sample. Each 8th bit the lsb saved as 1 byte and so on until the sum of the byte = DataSize.

I found that the execution is very slow if datasize > 20 Kb in my Pentium III 450 with 192 MB RAM. Anyone can help change this procedure so that it will run faster ? Thanks a lot

---

Testing Internet Speed Using VB Code
Can anyone help me with some codes or functions in Visual Basic with the help of which i can determine my internet speed? more accurately, can i monitor how much data is sent and received per second?

If this forum alredy contains solution to this problem, can anyone please give me the link to that thread ?

---

Execution Speed Of This Code... 3 Possible Ways
PERFORMANCE QUESTIONS:

DOUBLED MULTIPLICATION:
For X% = 1 To 23
FrmdayView.Line (15, X% * 570)-(710, X% * 570), &H808080
Next X%

ASSIGNMENT:
For X% = 1 To 23
lineY! = (X% * 570)
FrmdayView.Line (15, lineY!)-(710, lineY!), &H808080
Next X%

INCREMENT:
For X% = 1 To 23
lineY! = (lineY! + 570)
FrmdayView.Line (15, lineY!)-(710, lineY!), &H808080
Next X%

which is the best one? I've profiled all three and got no difference... any ideas?

---

Timing Processes To Speed Up Code
I am trying to evaluate methods of speeding up certain precedures and processes in a database program and wondered whether anyone might be able to tell me how to time certain events for analysis in milliseconds.
Example: Click a cmd_button and that starts the 'stopwatch' with a msgbox or ???? displaying the elapsed time when the process is finished.

Any help greatly appreciate.

---

VB Code To Change Speed On Netcard
Does anybody has a VB code for changing the speed
on a netcard. I would like to be able to change between auto 100/Full and
1000/Full.

thks

---

Please Help Me Eliminate There Boolean Vars Or Speed Up This Code!
This refresh sub is crucial to my vinyl record database. It adds all the records to a listview in the main form. Which database columns are shown depend on which columns the user selects to see. If i put all the jvnLoad("ColumnHeaders",... lines in the loop it slows the refresh speen down tremendously because it has to read the ini file 15*RecordCount times, which right now is about 15*450. Right now the code is faily quick at about 150 ticks each refresh for all 450 records but I know it can be quicker and I would really like to clean this up as well. Anyone have any suggestions?


Code:
Public Sub Refresh()
If mvarDBFile = "" Then Exit Sub

Dim icnt As Integer
Dim iIndex As Integer
Dim dbLine As String
Dim dbColumn() As String
Dim FilterLines() As String
Dim Filter() As String
Dim DaysLeft As String
Dim clmAlbum As Boolean
Dim clmLabel As Boolean
Dim clmYear As Boolean
Dim clmGenre As Boolean
Dim clmGradeV As Boolean
Dim clmGradeC As Boolean
Dim clmNotes As Boolean
Dim clmPrice As Boolean
Dim clmLocation As Boolean
Dim clmStatus As Boolean
Dim clmCreated As Boolean
Dim clmModified As Boolean
Dim clmListed As Boolean
Dim clmSoldOn As Boolean
Dim clmListDays As Boolean

Dim objFileSystem As New FileSystemObject, objFile As TextStream
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFile = objFileSystem.OpenTextFile(mvarDBFile, ForReading)

If jvnLoad("ColumnHeaders", "Album") = "1" Then clmAlbum = True
If jvnLoad("ColumnHeaders", "Label") = "1" Then clmLabel = True
If jvnLoad("ColumnHeaders", "Year") = "1" Then clmYear = True
If jvnLoad("ColumnHeaders", "Genre") = "1" Then clmGenre = True
If jvnLoad("ColumnHeaders", "Grade(V)") = "1" Then clmGradeV = True
If jvnLoad("ColumnHeaders", "Grade(C)") = "1" Then clmGradeC = True
If jvnLoad("ColumnHeaders", "Notes") = "1" Then clmNotes = True
If jvnLoad("ColumnHeaders", "Price") = "1" Then clmPrice = True
If jvnLoad("ColumnHeaders", "Location") = "1" Then clmLocation = True
If jvnLoad("ColumnHeaders", "Status") = "1" Then clmStatus = True
If jvnLoad("ColumnHeaders", "Created") = "1" Then clmCreated = True
If jvnLoad("ColumnHeaders", "Modified") = "1" Then clmModified = True
If jvnLoad("ColumnHeaders", "Listed") = "1" Then clmListed = True
If jvnLoad("ColumnHeaders", "Sold On") = "1" Then clmSoldOn = True
If jvnLoad("ColumnHeaders", "ListDays") = "1" Then clmListDays = True

With frmMain.lvReport.ListItems

.Clear
frmMain.lvReport.Visible = False
frmMain.lvReport.Sorted = False

Do While Not objFile.AtEndOfStream
dbLine = objFile.ReadLine
dbColumn() = Split(dbLine, Chr(9))

If sCustomSearch <> "" Then
If PassFilter(dbColumn()) = False Then GoTo NextLine
End If

If sSearch <> "" And InStr(LCase(dbLine), LCase(sSearch)) = 0 Then GoTo NextLine

iIndex = iIndex + 1

.Add iIndex, CStr(dbColumn(cItem)) & "i", dbColumn(cArtist)
If clmAlbum Then .Item(iIndex).ListSubItems.Add , , dbColumn(cAlbum)
If clmLabel Then .Item(iIndex).ListSubItems.Add , , dbColumn(cLabel)
If clmYear Then .Item(iIndex).ListSubItems.Add , , dbColumn(cYear)
If clmGenre Then .Item(iIndex).ListSubItems.Add , , dbColumn(cGenre)
If clmGradeV Then .Item(iIndex).ListSubItems.Add , , dbColumn(crGrade)
If clmGradeC Then .Item(iIndex).ListSubItems.Add , , dbColumn(ccGrade)
If clmNotes Then .Item(iIndex).ListSubItems.Add , , dbColumn(cNotes)
If clmPrice Then .Item(iIndex).ListSubItems.Add , , IIf(dbColumn(cPrice) = "" Or dbColumn(cPrice) = "0", " ", "$" & dbColumn(cPrice))
If clmLocation Then .Item(iIndex).ListSubItems.Add , , dbColumn(cLocation)
If clmStatus Then .Item(iIndex).ListSubItems.Add , , StatusName(CInt(dbColumn(cStatus)))
If clmCreated Then .Item(iIndex).ListSubItems.Add , , IIf(dbColumn(cCreated) = "", " ", dbColumn(cCreated))
If clmModified Then .Item(iIndex).ListSubItems.Add , , IIf(dbColumn(cModified) = "", " ", dbColumn(cModified))
If clmListed Then .Item(iIndex).ListSubItems.Add , , IIf(dbColumn(cListed) = "", " ", dbColumn(cListed))

If clmListDays Then
icnt = CInt(dbColumn(cStatus))
If dbColumn(cListed) = "" Or (icnt <> 3 And icnt <> 5 And icnt <> 1) Then
.Item(iIndex).ListSubItems.Add , , " "
Else
DaysLeft = CStr(DateAdd("d", CInt(dbColumn(cListDays)), CDate(dbColumn(cListed))) - Date)
Select Case CInt(DaysLeft)
Case Is < 0: .Item(iIndex).ListSubItems.Add , , "Listing Over"
Case Is = 0: .Item(iIndex).ListSubItems.Add , , "Ends Today"
Case Else: .Item(iIndex).ListSubItems.Add , , DaysLeft
End Select
End If
End If

If clmSoldOn Then .Item(iIndex).ListSubItems.Add , , IIf(dbColumn(cSoldOn) = "", " ", dbColumn(cSoldOn))
.Item(iIndex).SmallIcon = IIf(dbColumn(cFlag) <> "0", CInt(dbColumn(cFlag)), 0)
NextLine:
Loop
End With

objFile.Close
frmMain.lvReport.Sorted = True
frmMain.lvReport.Visible = True
frmMain.Status.Panels(3).Text = frmMain.lvReport.ListItems.Count & " Records"
End Sub

---

Problem Skipping SQL Code Based On Speed Of CPU
I have run into a problem trying to use Microsoft Access tables with Visual Basic 6.0. Let me try and explain this in such a way where I am not confusing you. When queries seem to run one after another VB seems to skip over running some of the queries based on how long it takes to run a previous query. For instance, we run a <delete> table query and then try to do an <insert into> into the same table we deleted from, it doesn't seem to perform the insert into. It seems as though it hasn't completed the <delete> statement and attempts to go to the next statement in which it cannot perform yet because of the previous code and just skips over it. If I do a step through however it does perform everything correctly everytime. This also seems to occur with reading the amount of records in a table if you have just created the table during the previous step. I have found that by doing a refresh of the recordset and a DoEvents before running the next SQL statement it helps a lot yet still not completely. Would anyone happen to have seen this and maybe found a solution? Thanks

<P ID="edit"><FONT class="small"><EM>Edited by Sojourn on 05/10/01 04:03 PM.</EM></FONT></P>

---