-
Jul 24th, 2012, 03:46 PM
#1
Thread Starter
Lively Member
[RESOLVED] [VB6] Strange bug?
Sup flokes,
When i run this code in IDE mode it will work. But when i run it just in windows after i compiled it it wont work at all.
Tested under Windows 7 Ult 64-bit and Win 7 Perm 64-bit SP1
Both executed as Administrator.
This is a fix for Far Cry 2 for Windows 7 Custom maps.
Sub:
Code:
Private Sub CMD1_Click()
On Error Resume Next
Dim steamexe As String
steamexe = GetStringValue("HKEY_CURRENT_USER\Software\Valve\Steam", "SteamExe")
Dim tps As String
tps = Replace(steamexe, "steam.exe", "steamapps\common\far cry 2\bin")
steamexe = tps
Dim tpss As String
tpss = Replace(steamexe, "/", "\")
steamexe = tpss
'MsgBox steamexe
MsgBox "Steam version of FarCry 2 has been fixed!", vbInformation, "Fixed!"
Kill steamexe & "\winhttp.dll"
Dim file1() As Byte
file1 = LoadResData(101, "CUSTOM")
Open steamexe & "\winhttp.dll" For Binary As #1
Put #1, , file1
Close #1
End Sub
Read reg module:
Code:
Type FILETIME
lLowDateTime As Long
lHighDateTime As Long
End Type
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByRef lpData As Long, lpcbData As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Long, ByVal cbData As Long) As Long
Declare Function RegSetValueExB Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Byte, ByVal cbData As Long) As Long
Const ERROR_SUCCESS = 0&
Const ERROR_BADDB = 1009&
Const ERROR_BADKEY = 1010&
Const ERROR_CANTOPEN = 1011&
Const ERROR_CANTREAD = 1012&
Const ERROR_CANTWRITE = 1013&
Const ERROR_OUTOFMEMORY = 14&
Const ERROR_INVALID_PARAMETER = 87&
Const ERROR_ACCESS_DENIED = 5&
Const ERROR_NO_MORE_ITEMS = 259&
Const ERROR_MORE_DATA = 234&
Const REG_NONE = 0&
Const REG_SZ = 1&
Const REG_EXPAND_SZ = 2&
Const REG_BINARY = 3&
Const REG_DWORD = 4&
Const REG_DWORD_LITTLE_ENDIAN = 4&
Const REG_DWORD_BIG_ENDIAN = 5&
Const REG_LINK = 6&
Const REG_MULTI_SZ = 7&
Const REG_RESOURCE_LIST = 8&
Const REG_FULL_RESOURCE_DESCRIPTOR = 9&
Const REG_RESOURCE_REQUIREMENTS_LIST = 10&
Const KEY_QUERY_VALUE = &H1&
Const KEY_SET_VALUE = &H2&
Const KEY_CREATE_SUB_KEY = &H4&
Const KEY_ENUMERATE_SUB_KEYS = &H8&
Const KEY_NOTIFY = &H10&
Const KEY_CREATE_LINK = &H20&
Const READ_CONTROL = &H20000
Const WRITE_DAC = &H40000
Const WRITE_OWNER = &H80000
Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const STANDARD_RIGHTS_READ = READ_CONTROL
Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
Const KEY_EXECUTE = KEY_READ
Dim hKey As Long, MainKeyHandle As Long
Dim rtn As Long, lBuffer As Long, sBuffer As String
Dim lBufferSize As Long
Dim lDataSize As Long
Dim ByteArray() As Byte
Const DisplayErrorMsg = False
Function SetBinaryValue(SubKey As String, Entry As String, Value As String)
On Error Resume Next
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_WRITE, hKey) 'open the key
If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
lDataSize = Len(Value)
ReDim ByteArray(lDataSize)
For i = 1 To lDataSize
ByteArray(i) = Asc(Mid$(Value, i, 1))
Next
rtn = RegSetValueExB(hKey, Entry, 0, REG_BINARY, ByteArray(1), lDataSize) 'write the value
If Not rtn = ERROR_SUCCESS Then 'if the was an error writting the value
If DisplayErrorMsg = True Then 'if the user want errors displayed
MsgBox ErrorMsg(rtn) 'display the error
End If
End If
rtn = RegCloseKey(hKey) 'close the key
Else 'if there was an error opening the key
If DisplayErrorMsg = True Then 'if the user wants errors displayed
MsgBox ErrorMsg(rtn) 'display the error
End If
End If
End If
End Function
Function ErrorMsg(lErrorCode As Long) As String
On Error Resume Next
End Function
Function GetStringValue(SubKey As String, Entry As String)
On Error Resume Next
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_READ, hKey) 'open the key
If rtn = ERROR_SUCCESS Then 'if the key could be opened then
sBuffer = Space(255) 'make a buffer
lBufferSize = Len(sBuffer)
rtn = RegQueryValueEx(hKey, Entry, 0, REG_SZ, sBuffer, lBufferSize) 'get the value from the registry
If rtn = ERROR_SUCCESS Then 'if the value could be retreived then
rtn = RegCloseKey(hKey) 'close the key
sBuffer = Trim(sBuffer)
GetStringValue = Left(sBuffer, Len(sBuffer) - 1) 'return the value to the user
Else 'otherwise, if the value couldnt be retreived
GetStringValue = "Key Not found" 'return Error to the user
If DisplayErrorMsg = True Then 'if the user wants errors displayed then
MsgBox ErrorMsg(rtn) 'tell the user what was wrong
End If
End If
Else 'otherwise, if the key couldnt be opened
GetStringValue = "Key Not found" 'return Error to the user
If DisplayErrorMsg = True Then 'if the user wants errors displayed then
MsgBox ErrorMsg(rtn) 'tell the user what was wrong
End If
End If
End If
End Function
Private Sub ParseKey(Keyname As String, Keyhandle As Long)
On Error Resume Next
rtn = InStr(Keyname, "\") 'return if "\" is contained in the Keyname
If Left(Keyname, 5) <> "HKEY_" Or Right(Keyname, 1) = "\" Then 'if the is a "\" at the end of the Keyname then
MsgBox "Incorrect Format:" + Chr(10) + Chr(10) + Keyname 'display error to the user
Exit Sub 'exit the procedure
ElseIf rtn = 0 Then 'if the Keyname contains no "\"
Keyhandle = GetMainKeyHandle(Keyname)
Keyname = "" 'leave Keyname blank
Else 'otherwise, Keyname contains "\"
Keyhandle = GetMainKeyHandle(Left(Keyname, rtn - 1)) 'seperate the Keyname
Keyname = Right(Keyname, Len(Keyname) - rtn)
End If
End Sub
Function SetStringValue(SubKey As String, Entry As String, Value As String)
On Error Resume Next
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_WRITE, hKey) 'open the key
If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
rtn = RegSetValueEx(hKey, Entry, 0, REG_SZ, ByVal Value, Len(Value)) 'write the value
If Not rtn = ERROR_SUCCESS Then 'if there was an error writting the value
If DisplayErrorMsg = True Then 'if the user wants errors displayed
MsgBox ErrorMsg(rtn) 'display the error
End If
End If
rtn = RegCloseKey(hKey) 'close the key
Else 'if there was an error opening the key
If DisplayErrorMsg = True Then 'if the user wants errors displayed
MsgBox ErrorMsg(rtn) 'display the error
End If
End If
End If
End Function
Function GetMainKeyHandle(MainKeyName As String) As Long
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006
Select Case MainKeyName
Case "HKEY_CLASSES_ROOT"
GetMainKeyHandle = HKEY_CLASSES_ROOT
Case "HKEY_CURRENT_USER"
GetMainKeyHandle = HKEY_CURRENT_USER
Case "HKEY_LOCAL_MACHINE"
GetMainKeyHandle = HKEY_LOCAL_MACHINE
Case "HKEY_USERS"
GetMainKeyHandle = HKEY_USERS
Case "HKEY_PERFORMANCE_DATA"
GetMainKeyHandle = HKEY_PERFORMANCE_DATA
Case "HKEY_CURRENT_CONFIG"
GetMainKeyHandle = HKEY_CURRENT_CONFIG
Case "HKEY_DYN_DATA"
GetMainKeyHandle = HKEY_DYN_DATA
End Select
End Function
What could be the problem?? I am out of ideas..
Best Regards,
NiTrOwow
-
Jul 24th, 2012, 04:54 PM
#2
Re: [VB6] Strange bug?
It helps if you describe what "it wont work at all" means.
Does it show your messagebox?
Is an error generated?
Does the program just crash?
You are saying you are having problems on 64bit machines. Was it developed on a 64bit or 32bit machine?
Removing the On Error Resume next may give you an idea what the problem is. I'm guessing if you were to check what is being returned in steamexe you will find it isn't what you expect.
-
Jul 24th, 2012, 04:56 PM
#3
Re: [VB6] Strange bug?
Remove the 'On Error Resume Next' statement and see what happens
-
Jul 24th, 2012, 08:45 PM
#4
Thread Starter
Lively Member
Re: [VB6] Strange bug?
Originally Posted by Doogle
Remove the 'On Error Resume Next' statement and see what happens
Lol guys think i did copy paste work. I added that myself, why? IF the file does not exist yet it can't be deleted so it sneeds to resume on that error.. And no i have removed anything and tried it all over again. No message box nothing. Just doesn't work, just wont create or open the file. And i used this method so many freaking times and it always worked this is the first time it only works in IDE mode.
-
Jul 24th, 2012, 08:49 PM
#5
Re: [VB6] Strange bug?
What happens if you remove the line Doogle mentioned above then run the code in the IDE debug mode?
when you quote a post could you please do it via the "Reply With Quote" button or if it multiple post click the "''+" button then "Reply With Quote" button.
If this thread is finished with please mark it "Resolved" by selecting "Mark thread resolved" from the "Thread tools" drop-down menu.
https://get.cryptobrowser.site/30/4111672
-
Jul 25th, 2012, 03:19 AM
#6
Thread Starter
Lively Member
Re: [VB6] Strange bug?
Originally Posted by Nightwalker83
What happens if you remove the line Doogle mentioned above then run the code in the IDE debug mode?
As i said before nothing heppens. The file would be created.
And it gives err 75 file path not found or something because of kill if the file is not there without on error resume next etc.
-
Jul 25th, 2012, 03:28 AM
#7
Re: [VB6] Strange bug?
Which line is highlighted when the error occurs?
when you quote a post could you please do it via the "Reply With Quote" button or if it multiple post click the "''+" button then "Reply With Quote" button.
If this thread is finished with please mark it "Resolved" by selecting "Mark thread resolved" from the "Thread tools" drop-down menu.
https://get.cryptobrowser.site/30/4111672
-
Jul 25th, 2012, 05:56 AM
#8
Re: [VB6] Strange bug?
There's another 'On Error Resume Next' in Function GetStringValue. I'd remove that and see what happens. By the way, you're not testing the result from GetStringValue, just assuming it all ran OK. Note that it can return a value "Key Not found" instead of the Key's value.
Saying all that I'd still expect the MsgBox to be executed.
-
Jul 25th, 2012, 12:16 PM
#9
Thread Starter
Lively Member
Re: [VB6] Strange bug?
Originally Posted by Doogle
There's another 'On Error Resume Next' in Function GetStringValue. I'd remove that and see what happens. By the way, you're not testing the result from GetStringValue, just assuming it all ran OK. Note that it can return a value "Key Not found" instead of the Key's value.
Saying all that I'd still expect the MsgBox to be executed.
Thats what i all tested, the output of the string with messagebox before i use it for opening the file and putting the data of the resource file in it.
-
Jul 25th, 2012, 12:17 PM
#10
Thread Starter
Lively Member
Re: [VB6] Strange bug?
Originally Posted by Nightwalker83
Which line is highlighted when the error occurs?
Shows nothing in IDE. It just works in IDE mode. While i compile it wont work and just not create the file at all. And yes i tried to test ANYTHING you guys said.
-
Jul 25th, 2012, 01:14 PM
#11
Re: [VB6] Strange bug?
Try doing a little logging and see what happens.
Code:
Private Sub CMD1_Click()
Dim steamexe As String
Dim tps As String
Dim tpss As String
Dim file1() As Byte
10 On Error GoTo CMD1_Click_Error
20 steamexe = GetStringValue("HKEY_CURRENT_USER\Software\Valve\Steam", "SteamExe")
30 tps = Replace(steamexe, "steam.exe", "steamapps\common\far cry 2\bin")
40 steamexe = tps
50 tpss = Replace(steamexe, "/", "\")
60 steamexe = tpss
70 Kill steamexe & "\winhttp.dll"
80 MsgBox "Steam version of FarCry 2 has been fixed!", vbInformation, "Fixed!"
90 file1 = LoadResData(101, "CUSTOM")
100 Open steamexe & "\winhttp.dll" For Binary As #1
110 Put #1, , file1
120 Close #1
130 Exit Sub
CMD1_Click_Error:
LogError "Error " & Err.Number & " (" & Err.Description & ") in procedure CMD1_Click of Form Form1" & vbCrLf & "Error on line number " & Erl
Resume Next
End Sub
Private Sub LogError(strError)
Dim strErrLog As String
Dim ff As Integer
strErrLog = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\") & "ErrorLog.txt"
ff = FreeFile
Open strErrLog For Append As ff
Print #ff, strError
Print #ff, ""
Close ff
End Sub
-
Jul 25th, 2012, 06:50 PM
#12
Junior Member
Re: [VB6] Strange bug?
Just throwing this out there, but Windows since Vista has been picky about where you can delete and write files. Could it be the OS simply does not like where you are trying to write the dll? One thing I picked up early on with VB6 under Vista/7 is it needs to run ad admin, which makes what you do in the IDE less strict than a compiled exe, which if it does not have admin privs, will not output data as efficiently as could be done pre Vista.
- Kev
-
Jul 26th, 2012, 03:53 AM
#13
Thread Starter
Lively Member
Re: [VB6] Strange bug?
Error 53 (File not found) in procedure CMD1_Click of Form Form1
Error on line number 70
(Obvious, Kill steamexe & "\winhttp.dll")
Error 75 (Path/File access error) in procedure CMD1_Click of Form Form1
Error on line number 100
(Open steamexe & "\winhttp.dll" For Binary As #1)
Error 52 (Bad file name or number) in procedure CMD1_Click of Form Form1
Error on line number 110
(Obvious, 110 Put #1, , file1) Can't put the data in the file if the path string isn't right or good.
The string output is not good. Thats the problem i guess.
Screenshot:
http://wss-data.com/i/9AEF5488C.png
lol vb!
The solution was:
Using a textbox instead of a string. And the wierd thing is.
It works in IDE mode, with the string. But not after i compiled it.
Code:
50 tpss = Replace(steamexe, "/", "\")
60 steamexe = tpss
Text1.Text = steamexe
70 Kill steamexe & "\winhttp.dll"
80 'MsgBox "Steam version of FarCry 2 has been fixed!", vbInformation, "Fixed!"
MsgBox Text1.Text
90 file1 = LoadResData(101, "CUSTOM")
100 Open Text1.Text & "\winhttp.dll" For Binary As #1
110 Put #1, , file1
120 Close #1
130 Exit Sub
Thanks to MarKT and all others that tried to help Thanks!
Last edited by NiTrOwow; Jul 26th, 2012 at 04:23 AM.
Best Regards
-
Jul 26th, 2012, 04:27 AM
#14
Lively Member
Re: [VB6] Strange bug?
Hi Everyone,
Sorry for the interruption, May I know, What is the use of these numbers (10, 20, 30, 40) before syntax?
Like:
Code:
10 On Error GoTo CMD1_Click_Error
20 steamexe = GetStringValue("HKEY_CURRENT_USER\Software\Valve\Steam", "SteamExe")
30 tps = Replace(steamexe, "steam.exe", "steamapps\common\far cry 2\bin")
40 steamexe = tps
Thanks
Regards,
-
Jul 26th, 2012, 08:08 AM
#15
Thread Starter
Lively Member
Re: [VB6] Strange bug?
Originally Posted by green.pitch
Hi Everyone,
Sorry for the interruption, May I know, What is the use of these numbers ( 10, 20, 30, 40) before syntax?
Like:
Code:
10 On Error GoTo CMD1_Click_Error
20 steamexe = GetStringValue("HKEY_CURRENT_USER\Software\Valve\Steam", "SteamExe")
30 tps = Replace(steamexe, "steam.exe", "steamapps\common\far cry 2\bin")
40 steamexe = tps
Thanks
Regards,
It has already been solved. I forgot to edit the thread.
Regards.
-
Jul 26th, 2012, 09:29 AM
#16
Junior Member
Re: [RESOLVED] [VB6] Strange bug?
It works in IDE mode, with the string. But not after i compiled it.
Please read the post I made about why this might be.
-
Jul 26th, 2012, 10:16 AM
#17
Lively Member
Re: [RESOLVED] [VB6] Strange bug?
Ya Sorry @NiTrOwow YES the Thread has been solved, I just wanted to know the use of these numbers (10, 20, 30, 40) you using in your codes syntax. I'v seen such coding styles, But donot know the concept behind these bullet numbering.
-Regards,
-
Jul 28th, 2012, 08:03 AM
#18
Thread Starter
Lively Member
Re: [RESOLVED] [VB6] Strange bug?
Originally Posted by green.pitch
Ya Sorry @NiTrOwow YES the Thread has been solved, I just wanted to know the use of these numbers (10, 20, 30, 40) you using in your codes syntax. I'v seen such coding styles, But donot know the concept behind these bullet numbering.
-Regards,
Lol dude that is the error/debug log. To write to ErrorLog.txt why are you even asking in above posts you see the whole code. It's obvious..
-
Jul 28th, 2012, 08:06 AM
#19
Thread Starter
Lively Member
Re: [RESOLVED] [VB6] Strange bug?
Originally Posted by KProvance
Please read the post I made about why this might be.
If i already don't know that. And the method i use always worked on Windows 7 and vista. It wasn't the problem, if it was then i replied to you to thank you. Btw don't have to run it as administrator to extraxt the file out of the resource. I have UAC and DEP disabled on my machine.
Sry forgot to quote this in post 18#.
Last edited by NiTrOwow; Jul 28th, 2012 at 08:10 AM.
Reason: forgot to quote this, but can't delete anymore.
Best Regards
-
Jul 28th, 2012, 09:43 AM
#20
Re: [RESOLVED] [VB6] Strange bug?
While you may have fixed this using a TextBox I suspect the real problem is in the registry code and you can get rid of the TextBox:
Code:
sBuffer = Trim(sBuffer)
GetStringValue = Left(sBuffer, Len(sBuffer) - 1) 'return the value to the user
You should NOT be using Trim here. Try this:
Code:
GetStringValue = StripNull(sBuffer)
Public Function StripNull(StrIn As String) As String
Dim nul As Long
nul = InStr(StrIn, vbNullChar)
If (nul) Then
StripNull = Left$(StrIn, nul - 1)
Else
StripNull = Trim$(StrIn)
End If
End Function
-
Jul 28th, 2012, 12:21 PM
#21
Thread Starter
Lively Member
Re: [RESOLVED] [VB6] Strange bug?
Originally Posted by DrUnicode
While you may have fixed this using a TextBox I suspect the real problem is in the registry code and you can get rid of the TextBox:
Code:
sBuffer = Trim(sBuffer)
GetStringValue = Left(sBuffer, Len(sBuffer) - 1) 'return the value to the user
You should NOT be using Trim here. Try this:
Code:
GetStringValue = StripNull(sBuffer)
Public Function StripNull(StrIn As String) As String
Dim nul As Long
nul = InStr(StrIn, vbNullChar)
If (nul) Then
StripNull = Left$(StrIn, nul - 1)
Else
StripNull = Trim$(StrIn)
End If
End Function
Nah, there was no nullbyte in the string at all. Not in the start or end. I have tested this all. textbox does it's job fine. I have hidden it, and works like it has to work lol.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|