VisualBasic — Говнокод.ру

VisualBasic / Говнокод #6861

−99

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73

Dim byteOut(64) As Byte
        Dim i As Integer
        Try
            byteOut(0) = Len(outCName) + 5 'number bytes in output message
            byteOut(1) = &H0 'should be 0 for NXT
            byteOut(2) = &H80 '&H0 = reply expected &H80 = no reply expected
            byteOut(3) = &H9 'Send Bluetooth
            byteOut(4) = &H0 'Box Number - 1
            byteOut(5) = Len(outCName) + 1 'message size with null terminator
            For i = 1 To Len(outCName) 'copy bytes into output array
                byteOut(i + 5) = Asc(Mid(outCName, i, 1))
            Next
            byteOut(Len(outCName) + 6) = &H0 'add null terminator
            SerialPort1.Write(byteOut, 0, Len(outCName) + 7) 'send message

        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try
        '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
        Try
            byteOut(0) = Len(outWState) + 5 'number bytes in output message
            byteOut(1) = &H0 'should be 0 for NXT
            byteOut(2) = &H80 '&H0 = reply expected &H80 = no reply expected
            byteOut(3) = &H9 'Send Bluetooth
            byteOut(4) = &H1 'Box Number - 1
            byteOut(5) = Len(outWState) + 1 'message size with null terminator
            For i = 1 To Len(outWState) 'copy bytes into output array
                byteOut(i + 5) = Asc(Mid(outWState, i, 1))
            Next
            byteOut(Len(outWState) + 6) = &H0 'add null terminator
            SerialPort1.Write(byteOut, 0, Len(outWState) + 7) 'send message

        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try

<..ещё один раз..>

   '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
        Try
            byteOut(0) = Len(outWindC) + 5 'number bytes in output message
            byteOut(1) = &H0 'should be 0 for NXT
            byteOut(2) = &H80 '&H0 = reply expected &H80 = no reply expected
            byteOut(3) = &H9 'Send Bluetooth
            byteOut(4) = &H3 'Box Number - 1
            byteOut(5) = Len(outWindC) + 1 'message size with null terminator
            For i = 1 To Len(outWindC) 'copy bytes into output array
                byteOut(i + 5) = Asc(Mid(outWindC, i, 1))
            Next
            byteOut(Len(outWindC) + 6) = &H0 'add null terminator
            SerialPort1.Write(byteOut, 0, Len(outWindC) + 7) 'send message

        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try

        '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
        Try
            byteOut(0) = Len(outHum) + 5 'number bytes in output message
            byteOut(1) = &H0 'should be 0 for NXT
            byteOut(2) = &H80 '&H0 = reply expected &H80 = no reply expected
            byteOut(3) = &H9 'Send Bluetooth
            byteOut(4) = &H4 'Box Number - 1
            byteOut(5) = Len(outHum) + 1 'message size with null terminator
            For i = 1 To Len(outHum) 'copy bytes into output array
                byteOut(i + 5) = Asc(Mid(outHum, i, 1))
            Next
            byteOut(Len(outHum) + 6) = &H0 'add null terminator
            SerialPort1.Write(byteOut, 0, Len(outHum) + 7) 'send message

        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try

Говнокод почти трёхлетней давности. Понадобилось мне посмотреть, как я реализовывал "общение" по блютусу с Mindstorms NXT, и напоролся на вот это...

RaZeR, 04 Июня 2011

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

VisualBasic / Говнокод #6519

−102

01
02
03
04
05
06
07
08
09
10

210 IF A$='1' THEN 2000
220 IF A$='2' THEN 2010
230 IF A$='3' THEN 2020
240 IF A$='4' THEN 2030
250 IF A$='5' THEN 2040
260 IF A$='6' THEN 2060
270 IF A$='7' THEN 2070
280 IF A$='8' THEN 2080
285 IF A$='9' THEN 4000
290 IF A$='10' THEN 3000

говнокод прямо с обложки книги по прикладному васику для ИТР

bugmenot, 30 Апреля 2011

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

VisualBasic / Говнокод #6455

−99

1
2
3
4
5

If Not Me.Opacity > 1 Then 'полный провал
      Opacity = Opacity + 0.02
Else
     Timer1.Enabled = False
End If

Часть кода из функции таймера

undiscovered, 22 Апреля 2011

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

VisualBasic / Говнокод #6216

−110

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

Public Class Decoder
    Dim arr_en() As String = {"q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "[", "]", "a", "s", "d", "f", "g", "h", "j", "k", "l", ";", "'", "z", "x", "c", "v", "b", "n", "m", ",", ".", "/", "?", "@"}
    Dim arr_ua() As String = {"й", "ц", "у", "к", "е", "н", "г", "ш", "щ", "з", "х", "ъ", "ф", "ы", "в", "а", "п", "р", "о", "л", "д", "ж", "є", "я", "ч", "с", "м", "и", "т", "ь", "б", "ю", ".", ",", "'"}
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        TextBox2.Clear()

        Dim t As Char
        Dim ch As Char
        Dim vv As String

        For Each vv In TextBox1.Lines
            For Each t In vv
                For i As Integer = 0 To arr_en.Count - 1
                    ch = arr_en.GetValue(i)
                    If t = ch Then
                        t = arr_ua.GetValue(i)
                        Exit For
                    End If
                Next
                TextBox2.Text = TextBox2.Text & t
            Next
            TextBox2.Text = TextBox2.Text & vbCrLf
        Next
    End Sub
End Class

Декодер с английской раскладки за 5 минут.

undiscovered, 04 Апреля 2011

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

VisualBasic / Говнокод #6052

−110

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

Dim num As Integer
    Dim inp As Integer
    Dim wrt As String
    Dim liv As Integer



    Sub Main()
        liv = 3
        Console.WriteLine("LIVES = " & liv)
pl:
        If liv = 0 Then GoTo st


        num = Fix(Rnd() * 5)

        Console.WriteLine("ENTER NUMBER:")
        inp = Console.ReadLine()
        If inp < num Then
            Console.WriteLine("GREATER")
            liv = liv - 1
            Console.WriteLine("LIVES = " & liv)
            GoTo pl

        End If

        If inp > num Then
            Console.WriteLine("LESS")

            liv = liv - 1
            Console.WriteLine("LIVES = " & liv)
            GoTo pl
        End If


        If inp = num Then Console.WriteLine("YES!")
st:
        Console.WriteLine("GAME OVER")
        Console.WriteLine("ENTER ANY NUMBER TO EXIT")
        inp = Console.ReadLine()






    End Sub

Одна из моих первых "прог" на VB, написанная около 4х лет назад - "Угадай число".

RaZeR, 21 Марта 2011

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

VisualBasic / Говнокод #6051

−105

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53

Public LettersB() As Char = {"A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z"}
    Public LettersM() As Char = {"a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z"}
    Public Numbers() As Char = {"0", "1", "2", "3", "4", "5", "6", "7", "8", "9"}
<...>
    Public Function GenLetterB() As String
        GenLetterB = LettersB(rnd.Next(0, LettersB.Length - 1)).ToString
    End Function
    Public Function GenLetterM() As String
        GenLetterM = LettersM(rnd.Next(0, LettersB.Length - 1)).ToString
    End Function
    Public Function GenNumber() As String
        GenNumber = rnd.Next(0, 9).ToString
    End Function
<...>
For i = 1 To numLen.Value
RndGen:     curType = rnd.Next(0, 3)
            Select Case curType
                Case 0
                    If chkB.Checked = True Then
                        pass += GenLetterB()
                        rnd.Next(0, LettersB.Length - 1)
                    Else
                        GoTo RndGen

                    End If
                    
                Case 1
                    If chkM.Checked = True Then
                        pass += GenLetterM()
                        rnd.Next(0, LettersM.Length - 1)
                    Else
                        GoTo RndGen
                    End If
                Case 2
                    If chkNum.Checked = True Then
                        pass += GenNumber()
                        rnd.Next(0, LettersM.Length - 1)
                    Else
                        GoTo RndGen
                    End If

                Case Else
                    If chkNum.Checked = True Then
                        pass += GenNumber()
                        rnd.Next(0, LettersM.Length - 1)
                    Else
                        GoTo RndGen
                    End If
            End Select



        Next

Очень древний мой высер, ещё из тех времён, когда я писал на VB. Кстати, прога есть на сурсфордже, у неё достаточно много скачиваний и жалоб нету.

RaZeR, 21 Марта 2011

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

VisualBasic / Говнокод #5434

−81

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

Try
            RichTextBox1.Text = int.OpenURL(adress & TextBox1.Text & units)
            tmpStr = RichTextBox1.Text.Split(">")

            Header = tmpStr(4).Split("<")

            lblHeader.Text = Header(0)
            CityName = Trim(Mid$(Header(0), 17, Len(Header(0)) - 16))

            outCName = CityName

            Codemass = tmpStr(43).Split(Chr(34))

            CodeNum = CInt(Codemass(3))


            tMass = tmpStr(43).Split(Chr(34))
            WCmass = tmpStr(17).Split(Chr(34))
            ATmass = tmpStr(18).Split(Chr(34))

            outWindC = "W: " & WCmass(3) & "o," & WCmass(5) & unSpd
            'outWCode = WCondition(CodeNum)


            outWState = tMass(1) & ","
            outTemp = tMass(5)
            outTemp = outTemp & Mid(units, 4, 1)

            outDate = tMass(7)
            outHum = ATmass(1) & "%, " & ATmass(5) & unPre
        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try

Мой старый парсер XML-погоды с Yahoo. System.Xml? Нет, не слышал.

RaZeR, 28 Января 2011

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

VisualBasic / Говнокод #5378

−457

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

Public Function CheckForError(ByVal sRes1 As String, ByVal sRes2 As String, Optional ByVal sRes3 As String = "", Optional ByVal sRes4 As String = "", Optional ByVal sRes5 As String = "", Optional ByVal sRes6 As String = "", Optional ByVal sRes7 As String = "", Optional ByVal sRes8 As String = "", Optional ByVal sRes9 As String = "", Optional ByVal sRes10 As String = "", Optional ByVal sRes11 As String = "") As Boolean
            Dim bRes As Boolean = True
            If Not CheckForError(sRes1) Then
                If Not CheckForError(sRes2) Then
                    If Not CheckForError(sRes3) Then
                        If Not CheckForError(sRes4) Then
                            If Not CheckForError(sRes5) Then
                                If Not CheckForError(sRes6) Then
                                    If Not CheckForError(sRes7) Then
                                        If Not CheckForError(sRes8) Then
                                            If Not CheckForError(sRes9) Then
                                                If Not CheckForError(sRes10) Then
                                                    If Not CheckForError(sRes11) Then
                                                        bRes = False
                                                    End If
                                                End If
                                            End If
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If

            Return bRes
        End Function

Птицы летят на юг!

adler, 24 Января 2011

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

VisualBasic / Говнокод #5206

−174

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56

Sub display(frm As Form)
    Dim lvl As Boolean
    Dim format As String
    If (frm.optSex(0).value) Then
        format = oI18n.translate("res_m")
        format = Replace(format, "\n", vbCrLf, 1, -1, vbBinaryCompare)
        format = Replace(format, "*", frm.cmbSchool.Text, 1, 1, vbTextCompare)
        format = Replace(format, "*", frm.txtForm.Text, 1, 1, vbTextCompare)
        format = Replace(format, "*", frm.txtName.Text, 1, 1, vbTextCompare)
        format = Replace(format, "*", frm.txtSurname.Text, 1, 1, vbTextCompare)
        lvl = False
        For Each optLvl In frm.chkLevel
            If (optLvl.value) Then
                format = Replace(format, "*", oI18n.translate(optLvl.Tag & "_m"), 1, 1, vbTextCompare)
                lvl = True
            End If
        Next optLvl
        If (Not lvl) Then format = Replace(format, "*", oI18n.translate("Bad" & "_m"), 1, 1, vbTextCompare)
    End If
    If (frm.optSex(1).value) Then
        format = oI18n.translate("res_f")
        format = Replace(format, "\n", vbCrLf, 1, -1, vbBinaryCompare)
        format = Replace(format, "*", frm.cmbSchool.Text, 1, 1, vbTextCompare)
        format = Replace(format, "*", frm.txtForm.Text, 1, 1, vbTextCompare)
        format = Replace(format, "*", frm.txtName.Text, 1, 1, vbTextCompare)
        format = Replace(format, "*", frm.txtSurname.Text, 1, 1, vbTextCompare)
        lvl = False
        For Each optLvl In frm.chkLevel
            If (optLvl.value) Then
                format = Replace(format, "*", oI18n.translate(optLvl.Tag & "_f"), 1, 1, vbTextCompare)
            End If
        Next optLvl
        If (Not lvl) Then format = Replace(format, "*", oI18n.translate("Bad" & "_f"), 1, 1, vbTextCompare)
    End If
    Dim dalykai As String
    Dim first As Boolean
    dalykai = ""
    first = True
    For Each chkFavorite In frm.chkFavorites
        If (chkFavorite.value) Then dalykai = dalykai & IIf(first, vbCrLf, vbCrLf) & (chkFavorite.Caption)
        first = False
    Next chkFavorite
    If (frm.chkFavoriteOther.value) Then dalykai = dalykai & IIf(first, vbCrLf, vbCrLf) & (frm.txtFavoriteOther.Text)
    Dim b As Boolean
    b = dalykai = ""
    If (b) Then
        If (frm.optSex(0).value) Then dalykai = oI18n.translate("nores_m")
        If (frm.optSex(1).value) Then dalykai = oI18n.translate("nores_f")
    End If
    If (Not b) Then
        If (frm.optSex(0).value) Then dalykai = oI18n.translate("res2_m") & dalykai
        If (frm.optSex(1).value) Then dalykai = oI18n.translate("res2_f") & dalykai
    End If
    
    MsgBox (format & vbCrLf & dalykai)
End Sub

заполняем строку-шаблон, заменяя звездочки реальными данными
вот не было в VB6 printf-подобной функции ((

Lure Of Chaos, 10 Января 2011

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

VisualBasic / Говнокод #5205

−166

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39

Public Sub DBOpen(Optional sFullPath As String = "")
    If sFullPath = "" Then sFullPath = sPath
    Dim f As Integer
    Dim l As Integer
    Dim tmp As String
    Dim sName As String
    Dim sSurname As String
    Dim sSex As String
    Dim dBirthdate As Date
    Dim sCity As String
    Dim sStreet As String
    l = 0
    f = FreeFile
    Open sFullPath For Input As #f
        While Not EOF(f)
            Line Input #f, tmp
            l = l + 1
        Wend
    Close #f
    If l > 0 Then
        ReDim asDB(0 To l - 1) As clsCitizen
        l = 0
        f = FreeFile
        Open sFullPath For Input As #f
            While Not EOF(f)
                Input #f, sName, sSurname, sSex, dBirthdate, sCity, sStreet
                Set asDB(l) = New clsCitizen
                asDB(l).sName = sName
                asDB(l).sSurname = sSurname
                asDB(l).sSex = sSex
                asDB(l).dBirthdate = dBirthdate
                asDB(l).sCity = sCity
                asDB(l).sStreet = sStreet
                l = l + 1
            Wend
        Close #f
    End If
    sPath = sFullPath
End Sub

за что я ненавижу VB6

а ведь по-другому никак = (