AlliedModders Donor
Join Date: Dec 2013
Location: BlackMarke7
|
10-25-2021
, 04:37
Re: [tweak][L4D/Any?] Open models by double click
|
#3
|
i'm trying to use this with csgo on windows 10
but i get
my l4d1 hlmv_loader.vbs
Code:
Option Explicit
On Error Resume Next
Dim L4d, models, materials, bin
L4d = "C:\Program Files (x86)\Steam\steamapps\common\Counter-Strike Global Offensive"
models = L4d & "\csgo\models"
materials = L4d & "\csgo\materials"
bin = L4d & "\bin"
Dim oShell, oFSO, t_model_dir, arg, model_name, model_dir, mat_src
Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
arg = WScript.Arguments(0)
model_dir = oFSO.GetParentFolderName(arg)
model_name = oFSO.GetFileName(arg)
t_model_dir = models & "\- temp\v"
if oFSO.FolderExists(t_model_dir) then oFSO.DeleteFolder t_model_dir, true
if not oFSO.FolderExists(oFSO.GetParentFolderName(t_model_dir)) then oFSO.CreateFolder oFSO.GetParentFolderName(t_model_dir)
if not oFSO.FolderExists(t_model_dir) then oFSO.CreateFolder t_model_dir
oFSO.CopyFolder model_dir, t_model_dir, true
PatchFile t_model_dir & "\" & model_name, "- temp\v\" & model_name, 12, false
if oFSO.FolderExists(model_dir & "\..\materials") then mat_src = model_dir & "\..\materials"
if oFSO.FolderExists(model_dir & "\..\..\materials") then mat_src = model_dir & "\..\..\materials"
if oFSO.FolderExists(model_dir & "\..\..\..\materials") then mat_src = model_dir & "\..\..\..\materials"
if oFSO.FolderExists(model_dir & "\..\..\..\..\materials") then mat_src = model_dir & "\..\..\..\..\materials"
if oFSO.FolderExists(model_dir & "\..\..\..\..\..\materials") then mat_src = model_dir & "\..\..\..\..\..\materials"
oFSO.CopyFolder mat_src, materials, true
oShell.CurrentDirectory = models
oShell.Run """" & bin & "\hlmv.exe" & """" & " -game " & """" & oFSO.GetParentFolderName(models) & """" & " " & """" & "- temp\v\" & model_name & """"
Function PatchFile(FileName, strData, Offset, Unicode)
PatchFileArray FileName, MultiByteToBinary(strData & chr(0), Unicode), Offset
End Function
Function PatchFileArray(FileName, ByteArray, Offset)
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Type = adTypeBinary
BinaryStream.Open
BinaryStream.LoadFromFile FileName
BinaryStream.Position = Offset
BinaryStream.Write ByteArray
BinaryStream.SaveToFile FileName, adSaveCreateOverWrite
BinaryStream.Close
End Function
Function MultiByteToBinary(MultiByte, Unicode)
Dim RS, LMultiByte, Binary
Const adLongVarBinary = 205
Set RS = CreateObject("ADODB.Recordset")
if Unicode then
LMultiByte = LenB(MultiByte)
else
LMultiByte = Len(MultiByte)
end if
If LMultiByte > 0 Then
RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
RS.Open
RS.AddNew
if Unicode then
RS("mBinary").AppendChunk MultiByte & ChrB(0)
else
RS("mBinary").AppendChunk StringToMB(MultiByte) & ChrB(0)
end if
RS.Update
Binary = RS("mBinary").GetChunk(LMultiByte)
End If
MultiByteToBinary = Binary
End Function
Function StringToMB(S)
Dim I, B
For I = 1 To Len(S)
B = B & ChrB(Asc(Mid(S, I, 1)))
Next
StringToMB = B
End Function
l4d2 hlmv_loader.vbs
Code:
Option Explicit
On Error Resume Next
Dim L4d, models, materials, bin
L4d = "C:\Program Files (x86)\Steam\steamapps\common\Counter-Strike Global Offensive"
models = L4d & "\csgo\models"
materials = L4d & "\csgo\materials"
bin = L4d & "\bin"
Dim oShell, oFSO, t_model_dir, arg, model_name, model_dir, mat_src
Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
arg = WScript.Arguments(0)
model_dir = oFSO.GetParentFolderName(arg)
model_name = oFSO.GetFileName(arg)
t_model_dir = models & "\- temp\v"
if oFSO.FolderExists(t_model_dir) then oFSO.DeleteFolder t_model_dir, true
if not oFSO.FolderExists(oFSO.GetParentFolderName(t_model_dir)) then oFSO.CreateFolder oFSO.GetParentFolderName(t_model_dir)
if not oFSO.FolderExists(t_model_dir) then oFSO.CreateFolder t_model_dir
oFSO.CopyFolder model_dir, t_model_dir, true
PatchFile t_model_dir & "\" & model_name, "- temp\v\" & model_name, 12, false
if oFSO.FolderExists(model_dir & "\..\materials") then mat_src = model_dir & "\..\materials"
if oFSO.FolderExists(model_dir & "\..\..\materials") then mat_src = model_dir & "\..\..\materials"
if oFSO.FolderExists(model_dir & "\..\..\..\materials") then mat_src = model_dir & "\..\..\..\materials"
if oFSO.FolderExists(model_dir & "\..\..\..\..\materials") then mat_src = model_dir & "\..\..\..\..\materials"
if oFSO.FolderExists(model_dir & "\..\..\..\..\..\materials") then mat_src = model_dir & "\..\..\..\..\..\materials"
oFSO.CopyFolder mat_src, materials, true
oShell.CurrentDirectory = models
oShell.Run """" & bin & "\hlmv.exe" & """" & " -game " & """" & oFSO.GetParentFolderName(models) & """" & " " & """" & "- temp\v\" & model_name & """"
Function PatchFile(FileName, strData, Offset, Unicode)
PatchFileArray FileName, MultiByteToBinary(strData & chr(0), Unicode), Offset
End Function
Function PatchFileArray(FileName, ByteArray, Offset)
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Type = adTypeBinary
BinaryStream.Open
BinaryStream.LoadFromFile FileName
BinaryStream.Position = Offset
BinaryStream.Write ByteArray
BinaryStream.SaveToFile FileName, adSaveCreateOverWrite
BinaryStream.Close
End Function
Function MultiByteToBinary(MultiByte, Unicode)
Dim RS, LMultiByte, Binary
Const adLongVarBinary = 205
Set RS = CreateObject("ADODB.Recordset")
if Unicode then
LMultiByte = LenB(MultiByte)
else
LMultiByte = Len(MultiByte)
end if
If LMultiByte > 0 Then
RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
RS.Open
RS.AddNew
if Unicode then
RS("mBinary").AppendChunk MultiByte & ChrB(0)
else
RS("mBinary").AppendChunk StringToMB(MultiByte) & ChrB(0)
end if
RS.Update
Binary = RS("mBinary").GetChunk(LMultiByte)
End If
MultiByteToBinary = Binary
End Function
Function StringToMB(S)
Dim I, B
For I = 1 To Len(S)
B = B & ChrB(Asc(Mid(S, I, 1)))
Next
StringToMB = B
End Function
__________________
|
|