|
| 1 | +Module M_Module |
| 2 | + |
| 3 | + 'Private CrcTable() As UInteger = { |
| 4 | + '&H0, &H77073096, &HEE0E612CUI, &H990951BAUI, |
| 5 | + '&H76DC419, &H706AF48F, &HE963A535UI, &H9E6495A3UI, |
| 6 | + '&HEDB8832, &H79DCB8A4, &HE0D5E91EUI, &H97D2D988UI, |
| 7 | + '&H9B64C2B, &H7EB17CBD, &HE7B82D07UI, &H90BF1D91UI, |
| 8 | + '&H1DB71064, &H6AB020F2, &HF3B97148UI, &H84BE41DEUI, |
| 9 | + '&H1ADAD47D, &H6DDDE4EB, &HF4D4B551UI, &H83D385C7UI, |
| 10 | + '&H136C9856, &H646BA8C0, &HFD62F97AUI, &H8A65C9ECUI, |
| 11 | + '&H14015C4F, &H63066CD9, &HFA0F3D63UI, &H8D080DF5UI, |
| 12 | + '&H3B6E20C8, &H4C69105E, &HD56041E4UI, &HA2677172UI, |
| 13 | + '&H3C03E4D1, &H4B04D447, &HD20D85FDUI, &HA50AB56BUI, |
| 14 | + '&H35B5A8FA, &H42B2986C, &HDBBBC9D6UI, &HACBCF940UI, |
| 15 | + '&H32D86CE3, &H45DF5C75, &HDCD60DCFUI, &HABD13D59UI, |
| 16 | + '&H26D930AC, &H51DE003A, &HC8D75180UI, &HBFD06116UI, |
| 17 | + '&H21B4F4B5, &H56B3C423, &HCFBA9599UI, &HB8BDA50FUI, |
| 18 | + '&H2802B89E, &H5F058808, &HC60CD9B2UI, &HB10BE924UI, |
| 19 | + '&H2F6F7C87, &H58684C11, &HC1611DABUI, &HB6662D3DUI, |
| 20 | + '&H76DC4190, &H1DB7106, &H98D220BCUI, &HEFD5102AUI, |
| 21 | + '&H71B18589, &H6B6B51F, &H9FBFE4A5UI, &HE8B8D433UI, |
| 22 | + '&H7807C9A2, &HF00F934, &H9609A88EUI, &HE10E9818UI, |
| 23 | + '&H7F6A0DBB, &H86D3D2D, &H91646C97UI, &HE6635C01UI, |
| 24 | + '&H6B6B51F4, &H1C6C6162, &H856530D8UI, &HF262004EUI, |
| 25 | + '&H6C0695ED, &H1B01A57B, &H8208F4C1UI, &HF50FC457UI, |
| 26 | + '&H65B0D9C6, &H12B7E950, &H8BBEB8EAUI, &HFCB9887CUI, |
| 27 | + '&H62DD1DDF, &H15DA2D49, &H8CD37CF3UI, &HFBD44C65UI, |
| 28 | + '&H4DB26158, &H3AB551CE, &HA3BC0074UI, &HD4BB30E2UI, |
| 29 | + '&H4ADFA541, &H3DD895D7, &HA4D1C46DUI, &HD3D6F4FBUI, |
| 30 | + '&H4369E96A, &H346ED9FC, &HAD678846UI, &HDA60B8D0UI, |
| 31 | + '&H44042D73, &H33031DE5, &HAA0A4C5FUI, &HDD0D7CC9UI, |
| 32 | + '&H5005713C, &H270241AA, &HBE0B1010UI, &HC90C2086UI, |
| 33 | + '&H5768B525, &H206F85B3, &HB966D409UI, &HCE61E49FUI, |
| 34 | + '&H5EDEF90E, &H29D9C998, &HB0D09822UI, &HC7D7A8B4UI, |
| 35 | + '&H59B33D17, &H2EB40D81, &HB7BD5C3BUI, &HC0BA6CADUI, |
| 36 | + '&HEDB88320UI, &H9ABFB3B6UI, &H3B6E20C, &H74B1D29A, |
| 37 | + '&HEAD54739UI, &H9DD277AFUI, &H4DB2615, &H73DC1683, |
| 38 | + '&HE3630B12UI, &H94643B84UI, &HD6D6A3E, &H7A6A5AA8, |
| 39 | + '&HE40ECF0BUI, &H9309FF9DUI, &HA00AE27, &H7D079EB1, |
| 40 | + '&HF00F9344UI, &H8708A3D2UI, &H1E01F268, &H6906C2FE, |
| 41 | + '&HF762575DUI, &H806567CBUI, &H196C3671, &H6E6B06E7, |
| 42 | + '&HFED41B76UI, &H89D32BE0UI, &H10DA7A5A, &H67DD4ACC, |
| 43 | + '&HF9B9DF6FUI, &H8EBEEFF9UI, &H17B7BE43, &H60B08ED5, |
| 44 | + '&HD6D6A3E8UI, &HA1D1937EUI, &H38D8C2C4, &H4FDFF252, |
| 45 | + '&HD1BB67F1UI, &HA6BC5767UI, &H3FB506DD, &H48B2364B, |
| 46 | + '&HD80D2BDAUI, &HAF0A1B4CUI, &H36034AF6, &H41047A60, |
| 47 | + '&HDF60EFC3UI, &HA867DF55UI, &H316E8EEF, &H4669BE79, |
| 48 | + '&HCB61B38CUI, &HBC66831AUI, &H256FD2A0, &H5268E236, |
| 49 | + '&HCC0C7795UI, &HBB0B4703UI, &H220216B9, &H5505262F, |
| 50 | + '&HC5BA3BBEUI, &HB2BD0B28UI, &H2BB45A92, &H5CB36A04, |
| 51 | + '&HC2D7FFA7UI, &HB5D0CF31UI, &H2CD99E8B, &H5BDEAE1D, |
| 52 | + '&H9B64C2B0UI, &HEC63F226UI, &H756AA39C, &H26D930A, |
| 53 | + '&H9C0906A9UI, &HEB0E363FUI, &H72076785, &H5005713, |
| 54 | + '&H95BF4A82UI, &HE2B87A14UI, &H7BB12BAE, &HCB61B38, |
| 55 | + '&H92D28E9BUI, &HE5D5BE0DUI, &H7CDCEFB7, &HBDBDF21, |
| 56 | + '&H86D3D2D4UI, &HF1D4E242UI, &H68DDB3F8, &H1FDA836E, |
| 57 | + '&H81BE16CDUI, &HF6B9265BUI, &H6FB077E1, &H18B74777, |
| 58 | + '&H88085AE6UI, &HFF0F6A70UI, &H66063BCA, &H11010B5C, |
| 59 | + '&H8F659EFFUI, &HF862AE69UI, &H616BFFD3, &H166CCF45, |
| 60 | + '&HA00AE278UI, &HD70DD2EEUI, &H4E048354, &H3903B3C2, |
| 61 | + '&HA7672661UI, &HD06016F7UI, &H4969474D, &H3E6E77DB, |
| 62 | + '&HAED16A4AUI, &HD9D65ADCUI, &H40DF0B66, &H37D83BF0, |
| 63 | + '&HA9BCAE53UI, &HDEBB9EC5UI, &H47B2CF7F, &H30B5FFE9, |
| 64 | + '&HBDBDF21CUI, &HCABAC28AUI, &H53B39330, &H24B4A3A6, |
| 65 | + '&HBAD03605UI, &HCDD70693UI, &H54DE5729, &H23D967BF, |
| 66 | + '&HB3667A2EUI, &HC4614AB8UI, &H5D681B02, &H2A6F2B94, |
| 67 | + '&HB40BBE37UI, &HC30C8EA1UI, &H5A05DF1B, &H2D02EF8D} |
| 68 | + |
| 69 | + Friend Ddraw_ini() As String |
| 70 | + Friend F2res_ini(0) As String |
| 71 | + Friend Main_Path As String = Application.StartupPath |
| 72 | + |
| 73 | + Friend Sub DatDesc() |
| 74 | + Dim desc() As String |
| 75 | + Dim n As Integer |
| 76 | + On Error Resume Next |
| 77 | + IO.File.WriteAllBytes(Main_Path & "\dat.unp", My.Resources.dat2) |
| 78 | + IO.File.SetAttributes(Main_Path & "\dat.unp", IO.FileAttributes.Hidden) |
| 79 | + Dim ListDat() As String = IO.Directory.GetFiles(Main_Path, "*.dat", IO.SearchOption.TopDirectoryOnly) |
| 80 | + For Each dat In ListDat |
| 81 | + Dim z As Integer = dat.LastIndexOf("\") + 1 |
| 82 | + dat = dat.Substring(z, dat.Length - z) |
| 83 | + 'If dat.ToLower <> "master.dat" And dat <> "critter.dat" Then |
| 84 | + Shell(Main_Path & "\dat.unp x " & dat & " desc.id", AppWinStyle.Hide, True) |
| 85 | + desc = IO.File.ReadAllLines(Main_Path & "\desc.id") |
| 86 | + MainForm.ListView1.Items.Add(dat) |
| 87 | + If desc(1) = Nothing Then |
| 88 | + MainForm.ListView1.Items(n).SubItems.Add("<unknown>") '& desc(1) |
| 89 | + Else |
| 90 | + MainForm.ListView1.Items(n).SubItems.Add(desc(1)) |
| 91 | + End If |
| 92 | + IO.File.Delete(Main_Path & "\desc.id") |
| 93 | + ReDim desc(0) |
| 94 | + n += 1 |
| 95 | + 'End If |
| 96 | + Next |
| 97 | + End Sub |
| 98 | + |
| 99 | + Friend Sub Save_ini() |
| 100 | + IO.File.WriteAllLines(Main_Path & "\ddraw.ini", Ddraw_ini, System.Text.Encoding.Default) |
| 101 | + If F2res_ini.Length > 1 Then IO.File.WriteAllLines(Main_Path & "\f2_res.ini", F2res_ini, System.Text.Encoding.Default) |
| 102 | + End Sub |
| 103 | + |
| 104 | + Friend Sub Set_ListBoxRes() |
| 105 | + Dim indx As Integer = MainForm.ListBox1.Items.IndexOf(CStr(MainForm.NumericUpDown4.Value) + " X " + CStr(MainForm.NumericUpDown3.Value)) |
| 106 | + MainForm.ListBox1.SelectedIndex = indx |
| 107 | + End Sub |
| 108 | + |
| 109 | + Friend Sub Check_Exe() |
| 110 | + Dim game_exe As String = vbNullString |
| 111 | + If Not (IO.File.Exists(Main_Path & "\fallout2.exe")) Then game_exe = GetIni_Param("sFallConfigatorGameExe") |
| 112 | + If game_exe = vbNullString Then game_exe = "fallout2.exe" |
| 113 | + Check_CRC(game_exe) |
| 114 | + End Sub |
| 115 | + |
| 116 | + Friend Sub Check_CRC(ByVal game_exe As String) |
| 117 | + Dim equal As Boolean |
| 118 | + Dim crc() As String = Get_CRC(Main_Path & "\" & game_exe).Split("|") |
| 119 | + Dim crc_line() As String = MainForm.TextBox1.Text.Split(",") |
| 120 | + For n = 0 To 1 |
| 121 | + For i = 0 To crc_line.Length - 1 |
| 122 | + If crc_line(i).Trim.ToUpper = crc(n) Or crc_line(i).Trim.ToUpper = "0X" & crc(n) Then |
| 123 | + equal = True |
| 124 | + Exit For |
| 125 | + End If |
| 126 | + Next |
| 127 | + If Not (equal) Then |
| 128 | + If MainForm.TextBox1.Text.Length > 0 Then |
| 129 | + MainForm.TextBox1.Text = "0x" & crc(n) & ", " & MainForm.TextBox1.Text 'заносим в тексбох |
| 130 | + Else |
| 131 | + MainForm.TextBox1.Text = "0x" & crc(n) |
| 132 | + End If |
| 133 | + MainForm.StoreIniCrc() 'записать изменения в буффер |
| 134 | + End If |
| 135 | + equal = False |
| 136 | + Next |
| 137 | + End Sub |
| 138 | + |
| 139 | + Friend Function Get_CRC(ByVal path As String) As String |
| 140 | + Dim Bytes() As Byte = IO.File.ReadAllBytes(path) |
| 141 | + Dim LineCrc As String = Hex(CalcCRC(Bytes, &H1EDC6F41)).ToUpper |
| 142 | + LineCrc &= "|" & Hex(CalcCRC(Bytes, &HEDB88320UI)).ToUpper |
| 143 | + Return LineCrc |
| 144 | + End Function |
| 145 | + |
| 146 | + Private Function CalcCRC(ByRef Bytes() As Byte, ByVal Polynomial As UInteger) As UInteger |
| 147 | + Dim Size As UInteger = Bytes.Length |
| 148 | + Dim Table(255) As UInteger |
| 149 | + Dim crc As UInteger = &HFFFFFFFFUI |
| 150 | + Dim r As UInteger |
| 151 | + ' |
| 152 | + For i As UShort = 0 To 255 |
| 153 | + r = i |
| 154 | + For j As Byte = 0 To 7 |
| 155 | + If (r And 1) <> 0 Then : r = ((r >> 1) Xor Polynomial) : Else : r >>= 1 : End If |
| 156 | + Next |
| 157 | + Table(i) = r |
| 158 | + Next |
| 159 | + For i As UInteger = 0 To Size - 1 |
| 160 | + crc = Table(CByte(crc And &HFF) Xor Bytes(i)) Xor (crc >> 8) |
| 161 | + Next |
| 162 | + Return crc Xor &HFFFFFFFFUI |
| 163 | + End Function |
| 164 | + |
| 165 | + Friend Sub SetGameExe_Ini(ByVal game_exe As String) |
| 166 | + SetIni_ParamValue("sFallConfigatorGameExe", game_exe) |
| 167 | + 'проверяем |
| 168 | + If GetIni_Param("sFallConfigatorGameExe") = Nothing Then |
| 169 | + ReDim Preserve Ddraw_ini(UBound(Ddraw_ini) + 3) |
| 170 | + Ddraw_ini(UBound(Ddraw_ini) - 1) = ";Setting for sFallConfigurator" |
| 171 | + Ddraw_ini(UBound(Ddraw_ini)) = "sFallConfigatorGameExe=" & game_exe |
| 172 | + End If |
| 173 | + End Sub |
| 174 | + |
| 175 | + Friend Function GetIni_Param_HRP(ByVal param As String) As String |
| 176 | + Dim n As Integer |
| 177 | + For n = 0 To UBound(F2res_ini) |
| 178 | + If GetIni_NameParam(F2res_ini(n)) = param Then |
| 179 | + Return GetIni_ParamValue(F2res_ini(n)) |
| 180 | + End If |
| 181 | + Next |
| 182 | + Return Nothing |
| 183 | + End Function |
| 184 | + |
| 185 | + Friend Function GetIni_Param(ByVal param As String) As String |
| 186 | + Dim n As Integer |
| 187 | + For n = 0 To UBound(Ddraw_ini) |
| 188 | + If GetIni_NameParam(Ddraw_ini(n)) = param Then |
| 189 | + Return GetIni_ParamValue(Ddraw_ini(n)) |
| 190 | + End If |
| 191 | + Next |
| 192 | + Return vbNullString |
| 193 | + End Function |
| 194 | + |
| 195 | + Friend Function GetIni_NameParam(ByVal str As String) As String |
| 196 | + Dim m As UShort = InStr(1, str, "=", CompareMethod.Text) |
| 197 | + If m = 0 Then Return Nothing |
| 198 | + 'возвращаем |
| 199 | + Return str.Substring(0, m - 1) |
| 200 | + End Function |
| 201 | + |
| 202 | + Friend Function GetIni_ParamValue(ByVal str As String) As String |
| 203 | + Dim m As UShort = InStr(1, str, "=", CompareMethod.Text) |
| 204 | + If m = 0 Then Return Nothing |
| 205 | + 'возвращаем |
| 206 | + Return str.Substring(m, str.Length - m) |
| 207 | + End Function |
| 208 | + |
| 209 | + Friend Sub SetIni_ParamValue_HRP(ByVal param As String, ByVal value As String) |
| 210 | + Dim n As Integer |
| 211 | + For n = 0 To UBound(F2res_ini) |
| 212 | + If GetIni_NameParam(F2res_ini(n)) = param Then |
| 213 | + Dim m As UShort = InStr(1, F2res_ini(n), "=", CompareMethod.Text) |
| 214 | + If m = 0 Then Exit Sub |
| 215 | + 'записываем |
| 216 | + F2res_ini(n) = F2res_ini(n).Substring(0, m) & value |
| 217 | + Exit Sub |
| 218 | + End If |
| 219 | + Next |
| 220 | + End Sub |
| 221 | + |
| 222 | + Friend Sub SetIni_ParamValue(ByVal param As String, ByVal value As String) |
| 223 | + Dim n As Integer |
| 224 | + For n = 0 To UBound(Ddraw_ini) |
| 225 | + If GetIni_NameParam(Ddraw_ini(n)) = param Then |
| 226 | + Set_Value(n, value) |
| 227 | + Exit Sub |
| 228 | + End If |
| 229 | + Next |
| 230 | + End Sub |
| 231 | + |
| 232 | + Friend Sub Set_Value(ByVal z As Integer, ByRef value As String) |
| 233 | + Dim m As UShort = InStr(1, Ddraw_ini(z), "=", CompareMethod.Text) |
| 234 | + If m = 0 Then Exit Sub |
| 235 | + 'записываем |
| 236 | + Ddraw_ini(z) = Ddraw_ini(z).Substring(0, m) & value |
| 237 | + End Sub |
| 238 | + |
| 239 | + Friend Function GetIni_Param_Line(ByVal param As String) As Integer |
| 240 | + Dim n As Integer |
| 241 | + For n = 0 To UBound(Ddraw_ini) |
| 242 | + If GetIni_NameParam(Ddraw_ini(n)) = param Then |
| 243 | + Return n |
| 244 | + End If |
| 245 | + Next |
| 246 | + Return -1 |
| 247 | + End Function |
| 248 | + |
| 249 | + Friend Function GetIni_Section_Line(ByVal section As String) As Integer |
| 250 | + Dim n As Integer |
| 251 | + For n = 0 To UBound(Ddraw_ini) |
| 252 | + If Ddraw_ini(n) = section Then |
| 253 | + Return n |
| 254 | + End If |
| 255 | + Next |
| 256 | + Return -1 |
| 257 | + End Function |
| 258 | + |
| 259 | + 'for v3.7 |
| 260 | + Friend Sub EnableDebug() |
| 261 | + Dim n As Integer = GetIni_Section_Line("[Debugging]") |
| 262 | + If n = -1 Then Exit Sub |
| 263 | + For n = n + 1 To UBound(Ddraw_ini) |
| 264 | + If GetIni_NameParam(Ddraw_ini(n)) = "Enable" Then Ddraw_ini(n) = "Enable=1" |
| 265 | + Next |
| 266 | + End Sub |
| 267 | + |
| 268 | +End Module |
0 commit comments