X Tutup
Skip to content

Commit 36db84b

Browse files
VBAndCsVBAndCs
committed
sVB 3.5.3 and Sahla 1.0.0.9
1 parent bd03cad commit 36db84b

File tree

16 files changed

+841
-532
lines changed

16 files changed

+841
-532
lines changed

‎SBCompiler/SBCompiler/CodeGenerator.vb‎

Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -109,6 +109,55 @@ Namespace Microsoft.SmallVisualBasic
109109
New Object() {".NETFramework,Version=v4.8"}
110110
))
111111

112+
Dim info = ProgramInfo.GetProperties(
113+
IO.Path.Combine(IO.Path.GetDirectoryName(_directory), "app.json")
114+
)
115+
116+
asm.SetCustomAttribute(New CustomAttributeBuilder(
117+
GetType(System.Reflection.AssemblyTitleAttribute).GetConstructor(New Type() {GetType(String)}),
118+
New Object() {info.Title}
119+
))
120+
121+
asm.SetCustomAttribute(New CustomAttributeBuilder(
122+
GetType(System.Reflection.AssemblyDescriptionAttribute).GetConstructor(New Type() {GetType(String)}),
123+
New Object() {info.Description}
124+
))
125+
126+
asm.SetCustomAttribute(New CustomAttributeBuilder(
127+
GetType(System.Reflection.AssemblyCompanyAttribute).GetConstructor(New Type() {GetType(String)}),
128+
New Object() {info.Company}
129+
))
130+
131+
asm.SetCustomAttribute(New CustomAttributeBuilder(
132+
GetType(System.Reflection.AssemblyProductAttribute).GetConstructor(New Type() {GetType(String)}),
133+
New Object() {info.Product}
134+
))
135+
136+
asm.SetCustomAttribute(New CustomAttributeBuilder(
137+
GetType(System.Reflection.AssemblyCopyrightAttribute).GetConstructor(New Type() {GetType(String)}),
138+
New Object() {info.Copyright}
139+
))
140+
141+
asm.SetCustomAttribute(New CustomAttributeBuilder(
142+
GetType(System.Reflection.AssemblyTrademarkAttribute).GetConstructor(New Type() {GetType(String)}),
143+
New Object() {info.Trademark}
144+
))
145+
146+
asm.SetCustomAttribute(New CustomAttributeBuilder(
147+
GetType(System.Reflection.AssemblyVersionAttribute).GetConstructor(New Type() {GetType(String)}),
148+
New Object() {info.Version}
149+
))
150+
151+
asm.SetCustomAttribute(New CustomAttributeBuilder(
152+
GetType(System.Reflection.AssemblyFileVersionAttribute).GetConstructor(New Type() {GetType(String)}),
153+
New Object() {info.Version.ToString()}
154+
))
155+
156+
asm.SetCustomAttribute(New CustomAttributeBuilder(
157+
GetType(System.Runtime.InteropServices.ComVisibleAttribute).GetConstructor(New Type() {GetType(Boolean)}),
158+
New Object() {False}
159+
))
160+
112161
Dim moduleBuilder = asm.DefineDynamicModule(_outputName & ".exe", emitSymbolInfo:=True)
113162
Dim typeBuilder = moduleBuilder.DefineType("_SmallVisualBasic_Program", TypeAttributes.Sealed)
114163
entryPoint = typeBuilder.DefineMethod("_Main", MethodAttributes.Static)
@@ -133,6 +182,7 @@ Namespace Microsoft.SmallVisualBasic
133182
asm.Save(_outputName & ".exe")
134183
Dim _path = IO.Path.Combine(_directory, _outputName)
135184
_xmlDoc.Save(_path & ".xml")
185+
NativeResourceUpdater.UpdateVersionResource(_path & ".exe", info)
136186
Return asm.GetReferencedAssemblies()
137187
End If
138188

‎SBCompiler/SBCompiler/NativeResourceUpdater.vb‎

Lines changed: 213 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,213 @@
1+
Imports System.IO
2+
Imports System.Runtime.InteropServices
3+
Imports Microsoft.SmallVisualBasic
4+
5+
Public Class NativeResourceUpdater
6+
7+
<DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
8+
Public Shared Function BeginUpdateResource(fileName As String, bDeleteExistingResources As Boolean) As IntPtr
9+
End Function
10+
11+
<DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
12+
Public Shared Function UpdateResource(hUpdate As IntPtr, lpType As IntPtr, lpName As IntPtr, wLanguage As UShort, lpData As Byte(), cbData As UInteger) As Boolean
13+
End Function
14+
15+
<DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
16+
Public Shared Function EndUpdateResource(hUpdate As IntPtr, fDiscard As Boolean) As Boolean
17+
End Function
18+
19+
Public Shared Sub UpdateVersionResource(exePath As String, info As ProgramInfo)
20+
Dim hUpdate = BeginUpdateResource(exePath, False)
21+
If hUpdate = IntPtr.Zero Then
22+
Throw New System.ComponentModel.Win32Exception()
23+
End If
24+
25+
Dim versionResource = BuildVersionResource(info)
26+
' RT_VERSION is resource type 16.
27+
Dim RT_VERSION As New IntPtr(&H10)
28+
' Resource name is usually 1.
29+
Dim RES_NAME As New IntPtr(1)
30+
' Use nutral language.
31+
Dim language As UShort = 0
32+
33+
If Not UpdateResource(hUpdate, RT_VERSION, RES_NAME, language, versionResource, CUInt(versionResource.Length)) Then
34+
Throw New System.ComponentModel.Win32Exception()
35+
End If
36+
37+
If Not EndUpdateResource(hUpdate, False) Then
38+
Throw New System.ComponentModel.Win32Exception()
39+
End If
40+
End Sub
41+
42+
Private Shared Function BuildVersionResource(info As ProgramInfo) As Byte()
43+
' Build a minimal VS_VERSION_INFO resource that includes the fixed file info,
44+
' one StringFileInfo block (with a single StringTable), and a VarFileInfo block.
45+
Using ms As New MemoryStream(), bw As New BinaryWriter(ms)
46+
Dim startPos As Long = ms.Position
47+
bw.Write(CUShort(0)) ' wLength (placeholder)
48+
bw.Write(CUShort(52)) ' wValueLength = size of VS_FIXEDFILEINFO (52 bytes)
49+
bw.Write(CUShort(0)) ' wType = binary
50+
WriteUnicodeString(bw, "VS_VERSION_INFO")
51+
AlignToDword(bw)
52+
53+
' --- VS_FIXEDFILEINFO (13 DWORDS: 52 bytes) ---
54+
bw.Write(&HFEEF04BDUI) ' dwSignature
55+
bw.Write(&H10000UI) ' dwStrucVersion
56+
57+
Dim versionParts = info.Version.Split("."c)
58+
Dim major = If(versionParts.Length > 0, Convert.ToUInt16(versionParts(0)), 0)
59+
Dim minor = If(versionParts.Length > 1, Convert.ToUInt16(versionParts(1)), 0)
60+
Dim buildPart = If(versionParts.Length > 2, Convert.ToUInt16(versionParts(2)), 0)
61+
Dim revision = If(versionParts.Length > 3, Convert.ToUInt16(versionParts(3)), 0)
62+
63+
Dim fileVersionMS = CUInt((major << 16) Or minor)
64+
Dim fileVersionLS = CUInt((buildPart << 16) Or revision)
65+
bw.Write(fileVersionMS) ' dwFileVersionMS
66+
bw.Write(fileVersionLS) ' dwFileVersionLS
67+
bw.Write(fileVersionMS) ' dwProductVersionMS
68+
bw.Write(fileVersionLS) ' dwProductVersionLS
69+
70+
bw.Write(&H3FUI) ' dwFileFlagsMask
71+
bw.Write(0UI) ' dwFileFlags
72+
bw.Write(&H40004UI) ' dwFileOS (VOS_NT_WINDOWS32)
73+
bw.Write(1UI) ' dwFileType (VFT_APP)
74+
bw.Write(0UI) ' dwFileSubtype
75+
bw.Write(0UI) ' dwFileDateMS
76+
bw.Write(0UI) ' dwFileDateLS
77+
78+
' --- StringFileInfo block ---
79+
Dim sfiBytes As Byte() = BuildStringFileInfo(info)
80+
bw.Write(sfiBytes)
81+
82+
' --- VarFileInfo block ---
83+
Dim vfiBytes As Byte() = BuildVarFileInfo()
84+
bw.Write(vfiBytes)
85+
86+
' Update the top-level wLength
87+
Dim totalLength As UShort = CUShort(ms.Length)
88+
ms.Position = startPos
89+
bw.Write(totalLength)
90+
91+
Return ms.ToArray()
92+
End Using
93+
End Function
94+
95+
Private Shared Sub WriteUnicodeString(bw As BinaryWriter, s As String)
96+
Dim bytes() As Byte = System.Text.Encoding.Unicode.GetBytes(s)
97+
bw.Write(bytes)
98+
bw.Write(CUShort(0)) ' null terminator
99+
End Sub
100+
101+
Private Shared Sub AlignToDword(bw As BinaryWriter)
102+
Dim pos As Long = bw.BaseStream.Position
103+
Dim padding As Integer = CInt((4 - (pos Mod 4)) Mod 4)
104+
For i As Integer = 1 To padding
105+
bw.Write(CByte(0))
106+
Next
107+
End Sub
108+
109+
Private Shared Function BuildStringFileInfo(info As ProgramInfo) As Byte()
110+
Using ms As New MemoryStream(), bw As New BinaryWriter(ms)
111+
Dim startPos As Long = ms.Position
112+
bw.Write(CUShort(0)) ' wLength (placeholder)
113+
bw.Write(CUShort(0)) ' wValueLength = 0 (container)
114+
bw.Write(CUShort(1)) ' wType = text
115+
WriteUnicodeString(bw, "StringFileInfo")
116+
AlignToDword(bw)
117+
118+
Dim stBytes As Byte() = BuildStringTable(info)
119+
bw.Write(stBytes)
120+
121+
Dim lengthValue As UShort = CUShort(ms.Length)
122+
ms.Position = startPos
123+
bw.Write(lengthValue)
124+
Return ms.ToArray()
125+
End Using
126+
End Function
127+
128+
Private Shared Function BuildStringTable(info As ProgramInfo) As Byte()
129+
Using ms As New MemoryStream(), bw As New BinaryWriter(ms)
130+
Dim startPos As Long = ms.Position
131+
bw.Write(CUShort(0)) ' wLength (placeholder)
132+
bw.Write(CUShort(0)) ' wValueLength = 0 (container)
133+
bw.Write(CUShort(1)) ' wType = text
134+
WriteUnicodeString(bw, "000004B0") ' Language and codepage identifier.
135+
AlignToDword(bw)
136+
137+
' Add string entries.
138+
Dim entries As New List(Of Byte())
139+
entries.Add(BuildStringEntry("FileDescription", info.Description))
140+
entries.Add(BuildStringEntry("ProductName", info.Product))
141+
entries.Add(BuildStringEntry("ProductVersion", info.Version))
142+
entries.Add(BuildStringEntry("CompanyName", info.Company))
143+
entries.Add(BuildStringEntry("LegalCopyright", info.Copyright))
144+
entries.Add(BuildStringEntry("InternalName", info.Title))
145+
146+
For Each entry As Byte() In entries
147+
bw.Write(entry)
148+
AlignToDword(bw)
149+
Next
150+
151+
Dim lengthValue As UShort = CUShort(ms.Length)
152+
ms.Position = startPos
153+
bw.Write(lengthValue)
154+
Return ms.ToArray()
155+
End Using
156+
End Function
157+
158+
Private Shared Function BuildStringEntry(key As String, value As String) As Byte()
159+
Using ms As New MemoryStream(), bw As New BinaryWriter(ms)
160+
Dim startPos As Long = ms.Position
161+
bw.Write(CUShort(0)) ' wLength (placeholder)
162+
bw.Write(CUShort(value.Length)) ' wValueLength = number of characters in value
163+
bw.Write(CUShort(1)) ' wType = text
164+
WriteUnicodeString(bw, key)
165+
AlignToDword(bw)
166+
WriteUnicodeString(bw, value)
167+
AlignToDword(bw)
168+
169+
Dim lengthValue As UShort = CUShort(ms.Length)
170+
ms.Position = startPos
171+
bw.Write(lengthValue)
172+
Return ms.ToArray()
173+
End Using
174+
End Function
175+
176+
Private Shared Function BuildVarFileInfo() As Byte()
177+
Using ms As New MemoryStream(), bw As New BinaryWriter(ms)
178+
Dim startPos As Long = ms.Position
179+
bw.Write(CUShort(0)) ' wLength (placeholder)
180+
bw.Write(CUShort(0)) ' wValueLength = 0 (container)
181+
bw.Write(CUShort(1)) ' wType = text
182+
WriteUnicodeString(bw, "VarFileInfo")
183+
AlignToDword(bw)
184+
185+
Dim transBytes As Byte() = BuildTranslationBlock()
186+
bw.Write(transBytes)
187+
188+
Dim lengthValue As UShort = CUShort(ms.Length)
189+
ms.Position = startPos
190+
bw.Write(lengthValue)
191+
Return ms.ToArray()
192+
End Using
193+
End Function
194+
195+
Private Shared Function BuildTranslationBlock() As Byte()
196+
Using ms As New MemoryStream(), bw As New BinaryWriter(ms)
197+
Dim startPos As Long = ms.Position
198+
bw.Write(CUShort(0)) ' wLength (placeholder)
199+
bw.Write(CUShort(4)) ' wValueLength = 4 bytes (two WORDs)
200+
bw.Write(CUShort(0)) ' wType = binary
201+
WriteUnicodeString(bw, "Translation")
202+
AlignToDword(bw)
203+
bw.Write(CUShort(&H0)) ' Language: nutral
204+
bw.Write(CUShort(&H4B0)) ' Code page: 1252
205+
AlignToDword(bw)
206+
Dim lengthValue As UShort = CUShort(ms.Length)
207+
ms.Position = startPos
208+
bw.Write(lengthValue)
209+
Return ms.ToArray()
210+
End Using
211+
End Function
212+
213+
End Class

‎SBCompiler/SBCompiler/ProgramInfo.vb‎

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
Imports System.IO
2+
Imports System.Runtime.Serialization
3+
Imports System.Runtime.Serialization.Json
4+
5+
<DataContract>
6+
Public Class ProgramInfo
7+
<DataMember> Public Property Title As String = "My App"
8+
<DataMember> Public Property Description As String = "This app is created by Small Visual Basic."
9+
<DataMember> Public Property Company As String = "Modern VB"
10+
<DataMember> Public Property Product As String = "My App"
11+
<DataMember> Public Property Copyright As String = "Copyright @" & Now.Year
12+
<DataMember> Public Property Trademark As String
13+
<DataMember> Public Property Version As String = "1.0.0.0"
14+
15+
Public Shared Function GetProperties(filePath As String) As ProgramInfo
16+
If File.Exists(filePath) Then
17+
Try
18+
Dim serializer As New DataContractJsonSerializer(GetType(ProgramInfo))
19+
Using fs As New FileStream(filePath, FileMode.Open, FileAccess.Read)
20+
Return CType(serializer.ReadObject(fs), ProgramInfo)
21+
End Using
22+
Catch ex As Exception
23+
End Try
24+
End If
25+
26+
Return New ProgramInfo
27+
End Function
28+
End Class
29+

‎SBCompiler/SBCompiler/svB.Compiler.vbproj‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -87,7 +87,7 @@
8787
</PropertyGroup>
8888
<ItemGroup>
8989
<Reference Include="SmallBasicLibrary">
90-
<HintPath>..\..\SmallBasicIDE\SB.Lib\SmallBasicLibrary.dll</HintPath>
90+
<HintPath>Z:\sVB-Small-Visual-Basic-master\SBCompiler\SBCompiler\bin\Release\SmallBasicLibrary.dll</HintPath>
9191
</Reference>
9292
<Reference Include="StringResources, Version=1.2.0.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35, processorArchitecture=MSIL">
9393
<SpecificVersion>False</SpecificVersion>
@@ -96,6 +96,7 @@
9696
<Reference Include="System" />
9797
<Reference Include="System.Data" />
9898
<Reference Include="System.Deployment" />
99+
<Reference Include="System.Runtime.Serialization" />
99100
<Reference Include="System.Xml" />
100101
<Reference Include="System.Core" />
101102
<Reference Include="System.Xml.Linq" />
@@ -114,6 +115,7 @@
114115
<Import Include="System.Threading.Tasks" />
115116
</ItemGroup>
116117
<ItemGroup>
118+
<Compile Include="NativeResourceUpdater.vb" />
117119
<Compile Include="Completion\CompletionBag.vb" />
118120
<Compile Include="Completion\CompletionHelper.vb" />
119121
<Compile Include="Completion\CompletionItem.vb" />
@@ -144,6 +146,7 @@
144146
<Compile Include="Expressions\MethodCallExpression.vb" />
145147
<Compile Include="Expressions\NegativeExpression.vb" />
146148
<Compile Include="Expressions\PropertyExpression.vb" />
149+
<Compile Include="ProgramInfo.vb" />
147150
<Compile Include="Program.vb" />
148151
<Compile Include="Statements\AssignmentStatement.vb" />
149152
<Compile Include="Statements\ElseIfStatement.vb" />

‎Samples/Sahla Programming Language/Sahla/FrmAbout.sb.gen‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ LblSVB = "frmabout.lblsvb"
2929
LblKP = "frmabout.lblkp"
3030
LblSamples = "frmabout.lblsamples"
3131
Label9 = "frmabout.label9"
32-
_path = Program.Directory + "\FrmAbout.xaml"
32+
_path = Program.Directory + "\frmabout.xaml"
3333
FrmAbout = Forms.LoadForm("FrmAbout", _path)
3434
Form.SetArgsArr(frmabout, Stack.PopValue("_frmabout_argsArr"))
3535
'#Events{

0 commit comments

Comments
 (0)
X Tutup