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

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

−353

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
74
75
76
77
78
79
80

Dim ll As Byte 
Private Sub Command1_Click() ' При нажатие на кнопку "Кодировка" 
For i = 1 To Len(Text1) Step 1 ' Читаем тест 1 от начало до канца с шагом 1 
l = Asc(Mid(Text1, i, 1)) 
Text2.Text = Text2 & Len(l) & Asc(Mid(Text1, i, 1)) ' записываем код в text 
2 
' l = Asc(Mid(Text1, i, 1)) и Len(l) - это для того что б знать сколько 
чисел у закодированого символа. Это нам нужно для раскодировки 
Next i ' конец чтению текста 1 
End Sub 
Private Sub Command2_Click() ' При нажатии кнопки "Раскодировка" 
ll=1 ' пишим начало от счёта 
timer1.enabled=true ' включаем таймер 
End Sub 
Private Sub Text1_Change() 
Text2 = "" ' сдесь при изменение текста 1 текст 2 = "" (вы можете этого и не 
делать) 
End Sub 
Private Sub Text2_Change() 
Text4 = Text2 " тут при изменение кода в тексте 2 этот код копируеться в 
текст4 
End Sub 
Private Sub Text4_Change() 
Text3 = "" ' сдесь при изменение текста 4 текст 3 = "" (вы можете этого и 
не делать) 
End Sub 
Private Sub Timer1_Timer() 
   
For i2 = 1 To 255 Step 1 
If Mid(Text4, ll, 1) = "1" Or Mid(Text4, ll, 1) = "2" Or Mid(Text4, ll, 1) = 
"3" Then If Val(Mid(Text4, ll + 1, Mid(Text4, ll, 1))) = i2 Then Text3 = 
Text3 & asc1(Val(Mid(Text4, ll + 1, Mid(Text4, ll, 1)))): ll = ll + 
Val(Mid(Text4, ll, 1)) + 1 ' сначало сравниваем числа 1,2,3 с кодом , эти 
чилса обозначают из скольки символов состоит следующий код символа, потом мы 
читаем и сравниваем код символа с перечисленым кодом , дальше мы записываем 
каждую прочитанную букву при помощи моей функцией она записана в модуле 

Next i2 
If ll > Len(Text4) Then Timer1.Enabled = False ' если ll станет больше числа 
символов в тексте, тогда таймер выключаеться 
End Sub 

Select Case ch
Case 48: asc1 = "0": Case 49: asc1 = "1": Case 50: asc1 = "2": Case 51: asc1 
= "3": Case 52: asc1 = "4": Case 53: asc1 = "5": Case 54: asc1 = "6": Case 
55: asc1 = "7": Case 56: asc1 = "8": Case 57: asc1 = "9"
Case 65: asc1 = "A": Case 66: asc1 = "B": Case 67: asc1 = "C": Case 68: asc1 
= "D": Case 69: asc1 = "E": Case 70: asc1 = "F": Case 71: asc1 = "G": Case 
72: asc1 = "H": Case 73: asc1 = "I": Case 74: asc1 = "J": Case 75: asc1 = 
"K": Case 76: asc1 = "L": Case 77: asc1 = "M": Case 78: asc1 = "N": Case 79: 
asc1 = "O": Case 80: asc1 = "P": Case 81: asc1 = "Q": Case 82: asc1 = "R": 
Case 83: asc1 = "S": Case 84: asc1 = "T": Case 85: asc1 = "U": Case 86: asc1 
= "V": Case 87: asc1 = "W": Case 88: asc1 = "X": Case 89: asc1 = "Y": Case 
90: asc1 = "Z"
Case 97: asc1 = "a": Case 98: asc1 = "b": Case 99: asc1 = "c": Case 100: 
asc1 = "d": Case 101: asc1 = "e": Case 102: asc1 = "f": Case 103: asc1 = 
"g": Case 104: asc1 = "h": Case 105: asc1 = "i": Case 106: asc1 = "j": Case 
107: asc1 = "k": Case 108: asc1 = "l": Case 109: asc1 = "m": Case 110: asc1 
= "n": Case 111: asc1 = "o": Case 112: asc1 = "p": Case 113: asc1 = "q": 
Case 114: asc1 = "r": Case 115: asc1 = "s": Case 116: asc1 = "t": Case 117: 
asc1 = "u": Case 118: asc1 = "v": Case 119: asc1 = "w": Case 120: asc1 = 
"x": Case 121: asc1 = "y": Case 122: asc1 = "z"
Case 192: asc1 = "А": Case 193: asc1 = "Б": Case 194: asc1 = "В": Case 195: 
asc1 = "Г": Case 196: asc1 = "Д": Case 197: asc1 = "Е": Case 168: asc1 = 
"Ё": Case 198: asc1 = "Ж": Case 199: asc1 = "З": Case 200: asc1 = "И": Case 
201: asc1 = "Й": Case 202: asc1 = "К": Case 203: asc1 = "Л": Case 204: asc1 
= "М": Case 205: asc1 = "Н": Case 206: asc1 = "О": Case 207: asc1 = "П": 
Case 208: asc1 = "Р": Case 209: asc1 = "С": Case 210: asc1 = "Т": Case 211: 
asc1 = "У": Case 212: asc1 = "Ф": Case 213: asc1 = "Х": Case 214: asc1 = 
"Ц": Case 215: asc1 = "Ч": Case 216: asc1 = "Ш": Case 217: asc1 = "Щ": Case 
218: asc1 = "Ъ": Case 219: asc1 = "Ы": Case 220: asc1 = "Ь": Case 221: asc1 
= "Э": Case 222: asc1 = "Ю": Case 223: asc1 = "Я"
Case 224: asc1 = "а": Case 225: asc1 = "б": Case 226: asc1 = "в": Case 227: 
asc1 = "г": Case 228: asc1 = "д": Case 229: asc1 = "е": Case 184: asc1 = 
"ё": Case 230: asc1 = "ж": Case 231: asc1 = "з": Case 232: asc1 = "и": Case 
233: asc1 = "й": Case 234: asc1 = "к": Case 235: asc1 = "л": Ca



и еще до кучи символов... )

Суровое школоло на службе КГБ.

Кодирование и раскодирование текста, Урок 197 чать 2
http://vbbook.ru/visual-basic/kodirovanie-i-raskodirovanie-teksta-yrok-197-chat-2/

Stertor, 08 Сентября 2013

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

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

−117

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
74

For t = 3 To u
 If Cells(t, 204).Text = " " Or Cells(t, 204).Text = "" Then
   If Cells(t + 1, 204).Text = " " Or Cells(t + 1, 204).Text = "" Then
    If Cells(t + 2, 204).Text = " " Or Cells(t + 2, 204).Text = "" Then
     If Cells(t + 3, 204).Text = " " Or Cells(t + 3, 204).Text = "" Then
     If Cells(t + 4, 204).Text = " " Or Cells(t + 4, 204).Text = "" Then
     If Cells(t + 5, 204).Text = " " Or Cells(t + 5, 204).Text = "" Then
     If Cells(t + 6, 204).Text = " " Or Cells(t + 6, 204).Text = "" Then
     If Cells(t + 7, 204).Text = " " Or Cells(t + 7, 204).Text = "" Then
     If Cells(t + 8, 204).Text = " " Or Cells(t + 8, 204).Text = "" Then
     If Cells(t + 9, 204).Text = " " Or Cells(t + 9, 204).Text = "" Then
     If Cells(t + 10, 204).Text = " " Or Cells(t + 10, 204).Text = "" Then
     If Cells(t + 11, 204).Text = " " Or Cells(t + 11, 204).Text = "" Then
     If Cells(t + 12, 204).Text = " " Or Cells(t + 12, 204).Text = "" Then
     If Cells(t + 13, 204).Text = " " Or Cells(t + 13, 204).Text = "" Then
     If Cells(t + 14, 204).Text = " " Or Cells(t + 14, 204).Text = "" Then
     If Cells(t + 15, 204).Text = " " Or Cells(t + 15, 204).Text = "" Then
     If Cells(t + 16, 204).Text = " " Or Cells(t + 16, 204).Text = "" Then
     If Cells(t + 17, 204).Text = " " Or Cells(t + 17, 204).Text = "" Then
     If Cells(t + 18, 204).Text = " " Or Cells(t + 18, 204).Text = "" Then
     If Cells(t + 19, 204).Text = " " Or Cells(t + 19, 204).Text = "" Then
     If Cells(t + 20, 204).Text = " " Or Cells(t + 20, 204).Text = "" Then
     If Cells(t + 21, 204).Text = " " Or Cells(t + 21, 204).Text = "" Then
     If Cells(t + 22, 204).Text = " " Or Cells(t + 22, 204).Text = "" Then
     If Cells(t + 23, 204).Text = " " Or Cells(t + 23, 204).Text = "" Then
     If Cells(t + 24, 204).Text = " " Or Cells(t + 24, 204).Text = "" Then
     If Cells(t + 25, 204).Text = " " Or Cells(t + 25, 204).Text = "" Then
     If Cells(t + 26, 204).Text = " " Or Cells(t + 26, 204).Text = "" Then
     If Cells(t + 27, 204).Text = " " Or Cells(t + 27, 204).Text = "" Then
     If Cells(t + 28, 204).Text = " " Or Cells(t + 28, 204).Text = "" Then
     If Cells(t + 29, 204).Text = " " Or Cells(t + 29, 204).Text = "" Then
     If Cells(t + 30, 204).Text = " " Or Cells(t + 30, 204).Text = "" Then
     If Cells(t + 31, 204).Text = " " Or Cells(t + 31, 204).Text = "" Then
     If Cells(t + 32, 204).Text = " " Or Cells(t + 32, 204).Text = "" Then
     If Cells(t + 33, 204).Text = " " Or Cells(t + 33, 204).Text = "" Then
     If Cells(t + 34, 204).Text = " " Or Cells(t + 34, 204).Text = "" Then
              GoTo zan4:
          End If
        End If
      End If
    End If
     End If
     End If
        End If
      End If
    End If
     End If
     End If
        End If
      End If
    End If
     End If
     End If
        End If
      End If
    End If
     End If
     End If
        End If
      End If
    End If
     End If
     End If
        End If
      End If
    End If
     End If
     End If
        End If
      End If
    End If
     End If
Next t
zan4:

Кусок реально используемого "проэкта", используется у нас на призводстве.
И вот-такого штук 10 в коде.

ноу коментс.

adli__82, 21 Мая 2012

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

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 / Говнокод #3814

−120

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
74
75

Dim msg, sapi
msg=InputBox("Введите ваш текст","Говорилка")

msg = Replace(msg, "\n", " ")

msg = Replace(msg, "а", "a")
msg = Replace(msg, "б", "b")
msg = Replace(msg, "в", "v")
msg = Replace(msg, "г", "g")
msg = Replace(msg, "д", "d")
msg = Replace(msg, "е", "e")
msg = Replace(msg, "ё", "e")
msg = Replace(msg, "ж", "zh")
msg = Replace(msg, "з", "z")
msg = Replace(msg, "и", "i")
msg = Replace(msg, "й", "i")
msg = Replace(msg, "к", "k")
msg = Replace(msg, "л", "l")
msg = Replace(msg, "м", "m")
msg = Replace(msg, "н", "n")
msg = Replace(msg, "о", "o")
msg = Replace(msg, "п", "p")
msg = Replace(msg, "р", "r")
msg = Replace(msg, "с", "s")
msg = Replace(msg, "т", "t")
msg = Replace(msg, "у", "u")
msg = Replace(msg, "ф", "f")
msg = Replace(msg, "х", "kh")
msg = Replace(msg, "ц", "ts")
msg = Replace(msg, "ч", "ch")
msg = Replace(msg, "ш", "sh")
msg = Replace(msg, "щ", "shch")
msg = Replace(msg, "ъ", "")
msg = Replace(msg, "ы", "y")
msg = Replace(msg, "ь", "")
msg = Replace(msg, "э", "e")
msg = Replace(msg, "ю", "iu")
msg = Replace(msg, "я", "ia")

msg = Replace(msg, "А", "a")
msg = Replace(msg, "Б", "b")
msg = Replace(msg, "В", "v")
msg = Replace(msg, "Г", "g")
msg = Replace(msg, "Д", "d")
msg = Replace(msg, "Е", "e")
msg = Replace(msg, "Ё", "e")
msg = Replace(msg, "Ж", "zh")
msg = Replace(msg, "З", "z")
msg = Replace(msg, "И", "i")
msg = Replace(msg, "Й", "i")
msg = Replace(msg, "К", "k")
msg = Replace(msg, "Л", "l")
msg = Replace(msg, "М", "m")
msg = Replace(msg, "Н", "n")
msg = Replace(msg, "О", "o")
msg = Replace(msg, "П", "p")
msg = Replace(msg, "Р", "r")
msg = Replace(msg, "С", "s")
msg = Replace(msg, "Т", "t")
msg = Replace(msg, "У", "u")
msg = Replace(msg, "Ф", "f")
msg = Replace(msg, "Х", "kh")
msg = Replace(msg, "Ц", "ts")
msg = Replace(msg, "Ч", "ch")
msg = Replace(msg, "Ш", "sh")
msg = Replace(msg, "Щ", "shch")
msg = Replace(msg, "Ъ", "")
msg = Replace(msg, "Ы", "y")
msg = Replace(msg, "Ь", "")
msg = Replace(msg, "Э", "e")
msg = Replace(msg, "Ю", "iu")
msg = Replace(msg, "Я", "ia")

Set sapi=CreateObject("sapi.spvoice")
sapi.Speak msg

Автор изобрел преобразователь текста в речь, оригинал:

Программа «Говорилка» на VBS
Cохраняете как «123.vbs».
Запускаете.
Ввводите текст.
Слышите текст в в своих колонках!

scalar4eblo4no, 29 Июля 2010

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

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

−349

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18

Function shr(ByVal a As Long, ByVal i As Long) As Long
Dim r As Variant
r = a / (2 ^ i)
shr = Fix(r)
End Function

'используется для получения значения n-го бита таким вот образом
if (shr(value,n) mod 2)=1 then
....
end if

'в другом месте почему-то биты проверяются по-другому
For i = 2 To Len(s)
  a = Asc(Mid(s, i, 1))
  b = (q Mod (2 ^ (i - 1))) \ (2 ^ (i - 2))
  If b = 1 Then a = a - 32  'сути этого я так и не понял
  t = t + Chr(a)
Next

мастерская работа с битами. епта я б на асме это в 1 строку сделал

3.14159265, 26 Мая 2010

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

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

−368

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

Public Function Chten(adr As String, TK As Boolean) As String
Dim str As String
Dim strr As String
Dim i As Long
If DirectoryExists(adr) = True Then
  Dim FLong As Long
  Open adr For Binary As #1
  FLong = Loc(1)
  Do While FLong < LOF(1)
    str = str + Input(1, #1)
    FLong = Loc(1)
  Loop
  Close #1
  strr = str
  If TK = True Then
  strr = ""
  Dim j As Long
  j = Len(str)
  For i = 1 To j
    If ((i Mod 8) = 0) Or (i = j) Then
        strr = strr + RTK(Mid(str, 1, 8))
        str = Mid(str, 9)
    End If
  Next
  End If
  Chten = strr
End If
End Function

'есть ли
'видно что функцию он где-то взял - см. другой стиль именования переменных и отступы
'но при этом сама и функция тоже попахивает
Public Function DirectoryExists(ByVal strPathName As String) As Boolean
    Dim DirectoryFound As String
    Const errPathNotFound As Integer = 76
    On Error GoTo 0
    DirectoryFound = Dir(strPathName, vbDirectory)
    If (Len(DirectoryFound) = 0 Or Err = errPathNotFound) Then
        DirectoryExists = False
    Else
        DirectoryExists = True
    End If
End Function

лаба моего бывшего однокурсника, весь остальной код - в таком же стиле
вчера искал кой-чего - наткнулся на архив старых лаб моих одногрупников и их предшественников.
Эта наверно одна из самых адекватных, потому что хоть можно сходу понять что она делает
и писал её человек хоть немного выкупающий что он пишет и тем не менее...

3.14159265, 21 Мая 2010

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

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

−359

1
2
3
4
5
6
7

Private Function Leto(ByVal Dat1 As Date) As Boolean
Return IIf(Dat1.Month > 3 And Dat1.Month < 9, True, False)
End Function

Private Function Bas(ByVal Cost1 As Decimal, ByVal Kol1 As Integer)
Return Cost1 * Kol1
End Function

вообще это по линку cfdevа лежало в #3142
http://www.sql.ru/forum/actualthread.aspx?bid=9&tid=467673&hl=

но он не запостил самое гавно - то есть этот кусок
и его походу мало кто заметил

3.14159265, 07 Мая 2010

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

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

−125.2

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

Sub Макрос2()
    Dim pos0, pos1, pos2, pos3, pos4, pos5, pos6, pos7, pos8, pos9, digitPos As Integer

    For Counter = 2 To 999999
        digitPos = 1000
    
        Set curCell = Worksheets("Лист1").Cells(Counter, 5)
        Set primCell = Worksheets("Лист1").Cells(Counter, 6)
    
        pos0 = InStr(1, primCell.Value, "0")
        pos1 = InStr(1, primCell.Value, "1")
        pos2 = InStr(1, primCell.Value, "2")
        pos3 = InStr(1, primCell.Value, "3")
        pos4 = InStr(1, primCell.Value, "4")
        pos5 = InStr(1, primCell.Value, "5")
        pos6 = InStr(1, primCell.Value, "6")
        pos7 = InStr(1, primCell.Value, "7")
        pos8 = InStr(1, primCell.Value, "8")
        pos9 = InStr(1, primCell.Value, "9")
        
        If pos0 > 0 And pos0 < digitPos Then
            digitPos = pos0
        End If
        
        If pos1 > 0 And pos1 < digitPos Then
            digitPos = pos1
        End If
        
        If pos2 > 0 And pos2 < digitPos Then
            digitPos = pos2
        End If
        
        If pos3 > 0 And pos3 < digitPos Then
            digitPos = pos3
        End If
        
        If pos4 > 0 And pos4 < digitPos Then
            digitPos = pos4
        End If
        
        If pos5 > 0 And pos5 < digitPos Then
            digitPos = pos5
        End If
        
        If pos6 > 0 And pos6 < digitPos Then
            digitPos = pos6
        End If
        
        If pos7 > 0 And pos7 < digitPos Then
            digitPos = pos7
        End If
        
        If pos8 > 0 And pos8 < digitPos Then
            digitPos = pos8
        End If
        
        If pos9 > 0 And pos9 < digitPos Then
            digitPos = pos9
        End If
        
        'MsgBox Left(primCell.Value, digitPos - 1)
        
        curCell.Value = Trim(Left(primCell.Value, digitPos - 1))
    Next Counter
End Sub

Я идиот и не умею программировать в excel!!
Мне надо было отрезать текст до первой цифры в одной ячейке и засунуть его в другую.
Наверное, надо было почитать про массивы в VB

striker, 12 Апреля 2010

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

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

−132.6

1
2
3
4

If objRow.IsQuestion_SpecialismNull Then
            '--- ASK DEAN
            Return True
End If

Dean - наш тим лид

6istik, 05 Апреля 2010

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

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

−122.2

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

Private Sub Form_Load()
'загрузка изображения
Dim xx(), yy(), zz()
Dim i As Integer
Dim maxx As Integer
Dim maxy As Integer
Dim minx As Integer
Dim miny As Integer
xx = Array(0#, 1#, 1#, 11#, 11#, 6#, 11#, 1#, 1#, 11#, 11#)
yy = Array(0#, 11#, 1#, 1#, 6#, 11#, 11#, 11#, 1#, 1#, 11#)
zz = Array(0#, 11#, 11#, 11#, 11#, 11#, 6#, 1#, 1#, 1#, 1#)
For i = 1 To 10
 x(i) = xx(i) * 1.5
 y(i) = yy(i) * 1.5
 z(i) = zz(i) * 1.5
 x0(i) = xx(i)
 y0(i) = yy(i)
 z0(i) = zz(i)
Next
maxx = 20
minx = -20
maxy = 20
miny = -20
Picture1.ScaleMode = 0
Picture1.Scale (minx, maxy)-(maxx, miny)
Call Angle(210, 30)
Call Cube(x(), y(), z())
sd = False
End Sub

Вот такая вот куча малопонятного говна

flash, 21 Января 2010

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

Говнокод: по колено в коде.