pcixi.ru
Творческое объединение шизофреников
Лечение шизофрении творчеством и общением на pcixi.ru

★ СПО Звезда ★
Кот_Матроскин #76 | Вторник, 13.03.2018, 08:27
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
del c:\boot\bcd

bcdedit /createstore c:\boot\bcd.tmp

bcdedit.exe /store c:\boot\bcd.tmp /create {bootmgr} /d "Windows Boot Manager"

bcdedit.exe /import c:\boot\bcd.tmp

bcdedit.exe /set {bootmgr} device partition=c:

bcdedit.exe /timeout 10

del c:\boot\bcd.tmp
bcdedit.exe /create /d "Windows 10" /application osloader

The entry {8a7f03d0-5338-11e7-b495-c7fffbb9ccfs} was successfully created.

The entry {8a7f03d0-5338-11e7-b495-c7fffbb9ccfs} was successfully created.

bcdedit /default {8a7f03d0-5338-11e7-b495-c7fffbb9ccfs}

bcdedit.exe /set {default}device partition=d:
bcdedit.exe /set {default} osdevice partition=d:
bcdedit.exe /set {default} path \Windows\system32\winload.exe
bcdedit.exe /set {default} systemroot \Windows

bcdedit.exe /displayorder {default} /addlast
https://technet.microsoft.com/ru-ru/lib ... 99(v=ws.10).aspx
Статус: нет меня
 
Кот_Матроскин #77 | Вторник, 13.03.2018, 08:27
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
A.3 Table-driven implementation of CRC32
This implementation of CRC32 is similar to the one used everywhere. First,
the CRC32 table is built and then it can be used to call the actual CRC32
calculating function as often as needed.
1 /* *
* Creates the CRC table with 256 32 - bit entries . CAUTION : Assumes that
* enough space for the resulting table has already been allocated .
*/
5 void make_crc_table ( uint32 * table ) {
uint32 c;
int n , k;
for (n = 0; n < 256; n ++) {
10 c = n ;
for (k = 0; k < 8; k ++) {
if (( c & 1) != 0) {
c = CRCPOLY ^ ( c >> 1);
} else {
15 c = c >> 1;
}
A APPENDIX 19
}
18 table [n] = c;
}
20 }
Listing 3: (Pre-)Building the CRC32 table
1 /* *
* Computes the CRC32 of the buffer of the given length
* using the supplied crc_table
*/
5 int crc32_tabledriven ( unsigned char * buffer ,
int length ,
uint32 * crc_table )
{
int i;
10 uint32 crcreg = INITXOR ;
for (i = 0; i < length ; ++ i ) {
crcreg = ( crcreg >> 8) ^ crc_table [(( crcreg ^ buffer [i ]) & 0 xFF )];
}
15
return crcreg ^ FINALXOR ;
}
Listing 4: Table-driven implementation of CRC32
Статус: нет меня
 
Кот_Матроскин #78 | Вторник, 13.03.2018, 08:28
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
pop eax
pop ebx
pop ecx
add esp, 0x8
push ecx
push ebx
push eax
start: mov ebx, DWORD PTR [esp+0x4]
mov ebp, DWORD PTR [esp+0x8]
mov eax, ebx
cmp eax, ebp
jae short x1
mov edx, ebp
sub edx, eax
shr edx, 0x3
mov edi, DWORD PTR [eax+edx*4]
cmp eax, ebp
ja short b0
b1: mov eax, ebx
cmp DWORD PTR [eax], edi
jge short b3
add ebx, 0x4
jmp short b1
b4: sub ebp, 0x4
b3: mov eax, ebp
cmp DWORD PTR [eax], edi
jg short b4
mov ecx, ebx
cmp ecx, eax
ja short b5
sub ebp, 0x4
add ebx, 0x4
mov edx, DWORD PTR [eax]
xchg DWORD PTR [ecx], edx
mov DWORD PTR [eax], edx
b5: mov eax, ebx
cmp eax, ebp
jbe short b1
b0: mov edi, eax
sub eax, 0x4
push eax
push DWORD PTR [esp+0x8]
call start
push DWORD PTR [esp+0x8]
push edi
call start
x1: ret 0x8
Статус: нет меня
 
Кот_Матроскин #79 | Вторник, 13.03.2018, 08:28
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Private Type worm ' Structure of snake, just x and y with may be color
X() As Integer
Y() As Integer
cl As Integer
End Type

Const DefaultPlayerLenght As Integer = 3 ' Initial lnt of played worm
Const DefaultWormsQty As Integer = 5 ' all worms qty in game
Const DefaultCarrotsQty As Integer = 40 ' carrots buffer lnt
Const DefaultStonesQty As Integer = 10 ' stones buffer lnt

Dim Unit(DefaultWormsQty) As worm ' base variable to store worms coords and colors
Dim Carrotrs As worm ' carrots buffer to check collisions and generate them

Dim DirectionByte As Integer ' 0-up 1-down 2-left 3-right
' System to generate moving, using 4 values for direction, 2 bits

Dim RuntimeBit As Boolean ' for program stop
Dim StopBit As Boolean ' for worm stop at border, boolean values
Dim cnt As Integer ' global counter, that pass not to do every time inits
Dim BCnt As Byte ' same as cnt but byted
Dim tmpX As Integer 'global increment coords, that way we do not pass it every time to procs
Dim tmpY As Integer

Private Sub main()
Initialize ' initing vars and field area
Do
For cnt = 0 To 1500 ' slow motion loop, default are some fast
DoEvents
Next
DoEvents ' specially it unfreeze excel and make it procs, if no this operand, it freezes when code run, modality
If RuntimeBit = False Then Exit Sub ' exit condition
' ActiveCell.Value = DirectionByte ' debug thing
' ActiveCell.Offset(1, 0).Value = tmpX
'ActiveCell.Offset(2, 0).Value = tmpY

MoveTick ' incrementor \ decrementor of coords

Render ' draw anything on the area of game

Loop
End Sub
Private Sub CheckCollideCarrot() ' if you eat carrot it have same coords
Dim a As Integer ' may be temp, may be global, i make local focus here
Dim b As Integer
For a = 0 To UBound(Carrotrs.X)
With Carrotrs
If tmpX = .X(a) And tmpY = .Y(a) Then GrowPlayer ' Reinint of player matrix
End With

Next
End Sub
Private Sub GrowPlayer()
Dim avg As Integer
avg = UBound(Unit(1).X)

ReDim Preserve Unit(1).X(avg + 1) ' Preserver just method, it may possible to use just simple copy to tmp_buffer
ReDim Preserve Unit(1).Y(avg + 1)

End Sub
Private Sub Initialize()
DirectionByte = 0 ' default up
ClearAREA ' clear field for game
InitPlayer ' playable snake character prepare
InitEnemy ' bots prepare
InitCarrots
InitStones ' generate stones and carrots buffers with fill it by randoms
End Sub
Private Sub ClearAREA()
'Dim a As Integer
'Dim b As Integer
' For a = 1 To 30
' For b = 1 To 60
' Cells(a, b).Value = ""
' DoEvents
' ActiveWindow.Caption = "clearing..."
' Next
' Next
' ActiveWindow.Caption = "Running..."
Range("a1:bh40").Select ' it fastly over 100000 times
Selection.CLear
Cells(30, 30).Select
End Sub
Private Sub InitPlayer()
ReDim Unit(1).X(DefaultPlayerLenght) 'making matrix of same size
ReDim Unit(1).Y(DefaultPlayerLenght)
Dim a As Integer
For a = 0 To DefaultPlayerLenght 'initial fill with middle of game area
Unit(1).X(a) = 30
Unit(1).Y(a) = a + 20
Next

End Sub
Private Sub InitEnemy()

End Sub
Private Sub InitCarrots()
With Carrotrs
ReDim .X(DefaultCarrotsQty) ' prepare buffer
ReDim .Y(DefaultCarrotsQty)
End With
Dim xx As Integer
Dim yy As Integer
'Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
For cnt = 0 To UBound(Carrotrs.X)
xx = Int((60 - 1 + 1) * Rnd + 1) ' filler of buffer
yy = Int((30 - 1 + 1) * Rnd + 1)
With Carrotrs
.X(cnt) = xx ' filling buffer with coords
.Y(cnt) = yy
Cells(yy, xx).Value = "V" ' also directly draw on screen
End With
Next

End Sub
Private Sub InitStones() ' to do here

End Sub
Private Sub MoveTick()
StopBit = False ' warning - reset every tick to sync globally
tmpX = Unit(1).X(0) ' copy to buffer "head" of snake, it next coord in use
tmpY = Unit(1).Y(0)
If DirectionByte = 3 Then
tmpX = tmpX + 1
End If
If DirectionByte = 2 Then
tmpX = tmpX - 1 ' incrementor \ dec conditions
End If
If DirectionByte = 0 Then
tmpY = tmpY - 1
End If
If DirectionByte = 1 Then
tmpY = tmpY + 1
End If

If tmpX = 0 Then
tmpX = 1
StopBit = True
End If
If tmpX = 61 Then
tmpX = 60
StopBit = True
End If
If tmpY = 0 Then
tmpY = 1 ' bound area checker and stopper
StopBit = True
End If

If tmpY = 41 Then
tmpY = 40
StopBit = True
End If
CheckSelfBite ' collision checkers in another focus, possible to write here directly, but
' it badly reading property
CheckCollideCarrot
Dim Cntr As Integer ' local counter
Dim avg As Integer ' just stupid temp value of bound
avg = UBound(Unit(1).X) ' gives matrix size (upper)
DoEvents
If StopBit = False Then ' if border - do nothing
For Cntr = avg - 1 To 0 Step -1
Unit(1).X(Cntr + 1) = Unit(1).X(Cntr) ' simple copier a+1 to a
Unit(1).Y(Cntr + 1) = Unit(1).Y(Cntr)
DoEvents
Next
Unit(1).X(0) = tmpX ' regenerate fresh head coords write here as last op
Unit(1).Y(0) = tmpY
Else
DoEvents ' for unfreeze excel interface in long loop
End If
End Sub
Private Sub Render()
For cnt = 0 To UBound(Unit(1).X) ' all coords of player matrix
DoEvents
Cells(Unit(1).Y(cnt), Unit(1).X(cnt)).Value = cnt ' write to cell, also can change it color
Next
cnt = UBound(Unit(1).X)
Cells(Unit(1).Y(cnt), Unit(1).X(cnt)).Value = "" ' remove tail especially without buffer glue
End Sub
Private Sub CheckSelfBite()
For cnt = 1 To UBound(Unit(1).X)
With Unit(1)
If tmpX = .X(cnt) And tmpY = .Y(cnt) Then ' if head==body you dead
WormDead
End If
End With
Next
End Sub
Private Sub WormDead()
RuntimeBit = False
StopBit = True
Cells(tmpY, tmpX).Select ' SFX and message of game over here
Selection.Value = "X"

End Sub

'-------------------------------- EVENTS ROUTINES --------------------------------
Private Sub B_5_Click()

End Sub

Private Sub B_DOWN_Click()
If DirectionByte = 0 Then Exit Sub
DirectionByte = 1
End Sub

Private Sub B_left_Click()
If DirectionByte = 3 Then Exit Sub ' if you move left you can not move right, you eat yourself, so do nothing on this event
DirectionByte = 2
End Sub

Private Sub B_right_Click()
If DirectionByte = 2 Then Exit Sub
DirectionByte = 3
End Sub
Private Sub B_UP_Click()
If DirectionByte = 1 Then Exit Sub
DirectionByte = 0
End Sub

Private Sub B_START_Click()
RuntimeBit = True
StopBit = False ' starting params for triggers
main
End Sub

Private Sub B_STOP_Click()
RuntimeBit = False ' exit condition bit in main loop
End Sub
Статус: нет меня
 
Кот_Матроскин #80 | Вторник, 13.03.2018, 08:29
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
'Option Explicit
Dim RawFile() As Byte
Dim buffAx() As String
Dim Vmem() As Byte

'bitmap file header vars
Dim Identifier As String ' 2 bytes - ignored, always BM
Dim FileSize As Long
Dim Reserved1 As Integer
Dim Reserved2 As Integer
Dim PixelOffset As Long
' bitmap info header
Dim InfoHeaderLenght As Long
Dim BitmapWidth As Long
Dim BitmapHeight As Long ' they are 32bit signed integers in C++
' other ignored because always using 24bit rgb in photoshop
' ----------------------------- Authorized vars ---------------------------------------
Dim OffsetVector() As Integer
' -------------------------- Service functions --------------------------------------

Private Sub DrawImage()
HeaderFill
'Range("i13:i23").Select
Dim TopX As Long
Dim TopY As Long
TopX = 10
TopY = 30
ReDim Vmem(BitmapWidth, BitmapHeight, 2) As Byte
Dim Offset As Long
Offset = PixelOffset
Dim ax As Long
Dim bx As Long
Dim Cx As Long
Dim Cy As Long
bx = BitmapHeight * BitmapWidth * 3

DoEvents

For Cy = 0 To BitmapHeight - 1
For Cx = 0 To BitmapWidth - 1
For ax = 0 To 2
Vmem(Cx, Cy, ax) = RawFile(bx + Offset)
bx = bx - 1
DoEvents
Next
Next
Next
DoEvents
MsgBox ("Ready")
bx = 0
Debug.Print Time
Dim ab As Long
ab = 1500
For Cy = 0 To BitmapHeight
For Cx = 0 To BitmapWidth
Cells(TopY + Cy, TopX + Cx).Interior.Color = RGB(Vmem(Cx, Cy, 0), Vmem(Cx, Cy, 1), Vmem(Cx, Cy, 2))
DoEvents
'Me.Name = bx
bx = bx + 1
Next
Next
DoEvents
Debug.Print Time

Me.Name = bx
End Sub
Private Sub DrawBitmap()
HeaderFill
'Range("i13:i23").Select
Dim TopX As Long
Dim TopY As Long
TopX = 10
TopY = 30
ReDim Vmem(BitmapWidth, BitmapHeight, 2) As Byte
Dim Offset As Long
Offset = PixelOffset
Dim ax As Long
Dim bx As Long
Dim Cx As Long
Dim Cy As Long
bx = 0

DoEvents

For Cy = 0 To BitmapHeight - 1
For Cx = 0 To BitmapWidth - 1
For ax = 0 To 2
Vmem(Cx, Cy, ax) = RawFile(bx + Offset)
bx = bx + 1
DoEvents
Next
Next
Next
DoEvents
MsgBox ("Ready")
bx = 0
Debug.Print Time
For Cy = 0 To BitmapHeight
For Cx = 0 To BitmapWidth
Cells(TopY + Cy, TopX + Cx).Interior.Color = RGB(Vmem(Cx, Cy, 2), Vmem(Cx, Cy, 1), Vmem(Cx, Cy, 0))
DoEvents
'Me.Name = bx
bx = bx + 1
Next
Next
DoEvents
Debug.Print Time

Me.Name = bx
End Sub

Private Sub HeaderFill() ' manually parse header, no interest to make auto
Dim Offset As Long
STB
Offset = 0
Offset = Offset + 2 ' ignore BM
Offset = Offset + 4 ' ignore file lnt
FileSize = MVB(Offset, 4)
Offset = Offset + 4 ' ignore reserverd
PixelOffset = MVB(Offset, 4)
Offset = Offset + 4
' info header
InfoHeaderLenght = MVB(Offset, 4)
Offset = Offset + 4
BitmapWidth = MSI(Offset)
Offset = Offset + 4
BitmapHeight = MSI(Offset)

DoEvents

End Sub
Private Function MSI(a As Long) As Long
Dim res As Long
Dim Hb As String
Dim Lb As String
Dim Hf As String
Dim Lf As String
Lb = buffAx(a)
Hb = buffAx(a + 1)
Hf = WorksheetFunction.Hex2Bin(Hb)
Lf = WorksheetFunction.Hex2Bin(Lb)
Dim ax As Long
Dim bx As Long
Lb = ""
Hb = ""
For ax = 1 To 8 - Len(Lf)
Lb = Lb + "0"
Next
For ax = 1 To 8 - Len(Hf)
Hb = Hb + "0"
Next
DoEvents
Hb = Hb + Hf
Lb = Lb + Lf
Dim rs As String
rs = Hb + Lb
Dim vc(15) As Long
Dim vcc(15) As Long
For ax = 0 To 15
vc(ax) = 2 ^ ax
Next
Hb = ""
Lb = ""
bx = 16
For ax = 0 To 15
Hb = Mid(rs, bx, 1)
If Hb = "1" Then vcc(ax) = 1
If Hb = "0" Then vcc(ax) = 0
bx = bx - 1
Next
Dim acc As Long
For ax = 0 To 15
acc = acc + vcc(ax) * vc(ax)
Next
DoEvents

MSI = acc
DoEvents
End Function
Private Function MVB(a As Long, lnt As Long) As Long 'machine to vb converter
' byte to long
Dim rbuff(3) As String
Dim Bbuff(3) As String
Dim Cbuff(3) As String
Dim ax As Long
Dim bx As Long
bx = 0
For ax = 0 To 3
DoEvents
rbuff(ax) = buffAx(a + bx)
bx = bx + 1
Next
bx = 3
For ax = 0 To 3
Cbuff(ax) = rbuff(bx)
bx = bx - 1
Next
For ax = 0 To 3
Bbuff(ax) = WorksheetFunction.Hex2Bin(Cbuff(ax))
Next
Dim s As String
For ax = 0 To 3
s = s + Bbuff(ax)
Next
Dim ss As String
For ax = 0 To 31 - Len(s)
ss = ss + "0"
Next
ss = ss + s
Dim Vector(30) As Long
Dim result As Long
Dim bin(31) As Integer
Dim sss As String
For ax = 0 To 30
Vector(ax) = 2 ^ ax

DoEvents
Next
ax = 31
For bx = 1 To Len(ss)
sss = Mid(ss, bx, 1)
If sss = "1" Then
bin(ax) = 1
End If
If sss = "0" Then
bin(ax) = 0
End If
ax = ax - 1
Next
For ax = 0 To 30
result = result + bin(ax) * Vector(ax)
Next
DoEvents
MVB = result
End Function

Sub grad()
Dim cl As Integer
Dim cnt As Integer
Dim Cx As Integer
Dim ax As String
Dim bx As String

Debug.Print Time
For Cx = 1 To 255
For cnt = 1 To 255
Cells(3, 3).Interior.Color = RGB(0, cnt, 0)
DoEvents
Next
Next
Debug.Print Time
End Sub
Private Sub tests()
Dim a As Variant
Dim b As Variant
'a = Selection.Value
Dim aa As Long
Dim bb As String
Dim bbb As String
Dim c As Double
Dim d As Double
For aa = 1 To Selection.Count
bb = Selection.Item(aa).Value
c = Len(bb)
d = d + c
Next
Debug.Print d / 2
bb = ""
bbb = "C"
For aa = 1 To 32766
bb = bb + bbb
Next
Dim ac As String
Dim bc As String
Dim cc As String
Dim dc As String
Dim ec As String
Dim ax As Byte
ac = "f"
bc = "a"
cc = WorksheetFunction.Hex2Bin(ac)
dc = WorksheetFunction.Hex2Bin(bc)
ec = cc + dc

Debug.Print ec
Debug.Print dc
Dim v As Integer
v = 15
Debug.Print Len(v)

End Sub
Private Sub STB()
Dim rbuff() As Byte

Dim buffbx As String
Dim buffcx As String
Dim Sax As String
Dim Sbx As String
Dim ax As Long
Dim bx As Long
Dim Cx As Integer
Dim Dx As Integer
For Cx = 0 To Selection.Count
buffbx = buffbx + Selection.Item(Cx).Value
Next
ReDim buffAx(Len(buffbx) / 2)
bx = 0
For ax = 1 To Len(buffbx) Step 2
buffAx(bx) = Mid(buffbx, ax, 2)
bx = bx + 1
Next
bx = 0
ReDim rbuff(UBound(buffAx))
ReDim RawFile(UBound(buffAx))
For ax = 0 To UBound(buffAx)
Sax = buffAx(ax)
Sbx = WorksheetFunction.Hex2Dec(Sax)
rbuff(ax) = CByte(Sbx)
RawFile(ax) = CByte(Sbx)
bx = bx + 1
Next
Debug.Print UBound(rbuff)

DoEvents
End Sub
Private Sub check_global()
STB
DoEvents
End Sub

Private Sub CommandButton1_Click()
DrawImage
End Sub
Статус: нет меня
 
Кот_Матроскин #81 | Четверг, 15.03.2018, 00:46
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Статус: нет меня
 
Кот_Матроскин #82 | Воскресенье, 18.03.2018, 22:16
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Статус: нет меня
 
Кот_Матроскин #83 | Четверг, 22.03.2018, 23:08
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
[flv]https://www.youtube.com/watch?v=_cVLpmttCN8[/flv]
Статус: нет меня
 
Кот_Матроскин #84 | Суббота, 31.03.2018, 23:51
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Статус: нет меня
 
almanack #85 | Воскресенье, 01.04.2018, 02:06
Повелитель стихий
Постоянные пациенты
Юзер-бар +
ШТАМП, лисичка просто прелесть :)


Я всегда хотел быть котиком. И сейчас это мне удалось.
Статус: нет меня
 
Кот_Матроскин #86 | Понедельник, 02.04.2018, 02:44
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Статус: нет меня
 
Кот_Матроскин #87 | Среда, 04.04.2018, 00:09
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Статус: нет меня
 
Кот_Матроскин #88 | Суббота, 07.04.2018, 03:02
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Статус: нет меня
 
Кот_Матроскин #89 | Воскресенье, 15.04.2018, 02:02
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Статус: нет меня
 
Кот_Матроскин #90 | Пятница, 18.05.2018, 20:52
Автор темы
Здрасте, это я
Поступившие в отделение
Юзер-бар +
Вторая работа под сомнением пока нет медстсетры либо еще кого, основная стала уже проще да и заказы не идут волной.
Статус: нет меня
 
Поиск:

[ Новые сообщения на форуме ]



Форма входа