Форум программистов, компьютерный форум, киберфорум
Visual Basic
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
 
Рейтинг 4.53/140: Рейтинг темы: голосов - 140, средняя оценка - 4.53
Эксперт WindowsАвтор FAQ
 Аватар для Dragokas
18033 / 7736 / 892
Регистрация: 25.12.2011
Сообщений: 11,502
Записей в блоге: 16

Тестирование полезных кодов и примеров

15.10.2012, 00:56. Показов 29756. Ответов 301
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Если Ваш код из темы Готовые решения и полезные коды на Visual Basic 6.0

неправильно собран или неработоспособен, он будет перенесен сюда.

Для доведения кода в рабочее состояние в порядке обсуждения создайте новую тему
2
Лучшие ответы (1)
IT_Exp
Эксперт
34794 / 4073 / 2104
Регистрация: 17.06.2006
Сообщений: 32,602
Блог
15.10.2012, 00:56
Ответы с готовыми решениями:

Тестирование полезных скриптов
В этой теме нужно писать: - о багах в выложенных полезных скриптах (закрепленная тема); - ошибках в кодах, на которые ведут ссылки...

Программное тестирование кодов
Доброго! Часто возникает потребность протестить некоторую программку, обычно небольшую. Т.к. в большинстве случаев это надо сделать быстро,...

Cумма кодов четных символов равна сумме кодов нечетных
Даны два поля edit1 и edit2. и кнопка button1. Нужно чтобы при нажатии на кнопку, проверялось: сумма кодов четных символов была равна сумме...

301
145 / 46 / 1
Регистрация: 06.11.2012
Сообщений: 283
29.12.2012, 16:51
Студворк — интернет-сервис помощи студентам
Цитата Сообщение от inv.DS Посмотреть сообщение
E-Mail отправителя
А кое кто думает что мейл получателя
0
Эксперт WindowsАвтор FAQ
 Аватар для Dragokas
18033 / 7736 / 892
Регистрация: 25.12.2011
Сообщений: 11,502
Записей в блоге: 16
29.12.2012, 18:18  [ТС]
Проверил. И так, и так работает.
Так что можно писать:
.Item(v_Conf & "sendusername") = "mail@mail.ru"
Можно просто
.Item(v_Conf & "sendusername") = "mail"
0
 Аватар для Апострофф
9908 / 3924 / 742
Регистрация: 11.10.2011
Сообщений: 5,904
19.01.2013, 12:53
Цитата Сообщение от inv.DS Посмотреть сообщение
Как установить новую дату и время на компьютере?
Visual Basic
1
2
3
4
Sub Set_Date_Time()
Date = DateSerial(2013, 12, 31)
Time = TimeSerial(23, 59, 59)
End Sub
inv.DS, а в чем преимущество Вашего кода?
0
Заблокирован
19.01.2013, 12:55
Апострофф, Он мне понравился !
0
 Аватар для Pro_grammer
6807 / 2839 / 527
Регистрация: 24.04.2011
Сообщений: 5,308
Записей в блоге: 10
19.01.2013, 14:09
Цитата Сообщение от Апострофф Посмотреть сообщение
а в чем преимущество
Я считаю, что главное преимущество этого кода в универсальности - его можно повторить практически на любом современном Языке Программирования. А Ваш код будет работать только на VB
1
 Аватар для Апострофф
9908 / 3924 / 742
Регистрация: 11.10.2011
Сообщений: 5,904
19.04.2013, 10:50
Лучший ответ Сообщение было отмечено как решение

Решение

Текст для теста оформляется по элементарным правилам (достаточно найти и открыть скрытый файл Test.txt в приложенной папке)
Код
Visual Basic
1
2
3
4
5
6
7
8
9
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
Option Explicit
 
Sub main()
Dim s As String
Dim a
Dim v
Dim n() As Long
Dim i As Long, j As Long, k As Long
Dim b() As Long
Dim p As Long
Open App.Path & "\Test.txt" For Input As 1
  s = Input$(LOF(1), 1)
Close
a = Split(s, vbCrLf & vbCrLf)
ReDim n(UBound(a))
Randomize
For i = 0 To UBound(n)
  j = Int(Rnd * (i + 1))
  n(i) = n(j)
  n(j) = i
Next i
For i = 0 To UBound(n)
  v = Split(a(n(i)), vbCrLf)
  s = v(0)
  ReDim b(1 To UBound(v))
  For k = 1 To UBound(b)
    j = Int(Rnd * k + 1)
    b(k) = b(j)
    b(j) = k
  Next k
  For k = 1 To UBound(b)
    s = s & vbCrLf & vbCrLf & k & ":  " & v(b(k))
  Next k
  Do
    j = Val(InputBox(s, "Введите номер правильного ответа"))
    If j < 1 Or j > UBound(b) Then
      If MsgBox("Повторить - [Да]" & vbCrLf & "Выйти - [Нет]", vbYesNo, "Не корректный ввод!") <> vbYes Then Exit Sub
    Else
      Exit Do
    End If
  Loop
  p = p - (b(j) = 1)
Next i
MsgBox "Вы дали " & p & " правильных ответов из " & i
End Sub
Миниатюры
Тестирование полезных кодов и примеров  
Вложения
Тип файла: zip test.zip (2.9 Кб, 12 просмотров)
3
19.04.2013, 13:56

Не по теме:

Вопросы сам придумал? Это ппц! :D :rofl:

0
19.04.2013, 14:12

Не по теме:

Цитата Сообщение от Казанский Посмотреть сообщение
Вопросы сам придумал?
Нет, я на такое не горазд:-[
Вот - http://www.hr-portal.ru/pages/hu/logika.php

1
 Аватар для Андрэич
2842 / 774 / 41
Регистрация: 20.05.2012
Сообщений: 2,055
20.04.2013, 00:56
http://www.google.ru/search?cl... el=suggest
0
Модератор
10052 / 3897 / 884
Регистрация: 22.02.2013
Сообщений: 5,850
Записей в блоге: 79
23.04.2013, 21:55
Тест с закодированными вопросами и ответами, с защитой от неправильного изменения.
Миниатюры
Тестирование полезных кодов и примеров  
Вложения
Тип файла: rar TrickTest.rar (43.6 Кб, 24 просмотров)
1
Эксперт WindowsАвтор FAQ
 Аватар для Dragokas
18033 / 7736 / 892
Регистрация: 25.12.2011
Сообщений: 11,502
Записей в блоге: 16
23.04.2013, 23:53  [ТС]
Ув. тов. Апострофф, The trick, не имею понятия, зачем здесь эти тесты.
Тема была создана для проверки кодов на работоспособность, а не выкладывание программ тестирования.

Перенести Ваши примеры в тему: Готовые решения и полезные коды на Visual Basic 6.0
?
0
 Аватар для Апострофф
9908 / 3924 / 742
Регистрация: 11.10.2011
Сообщений: 5,904
24.04.2013, 07:04
Ув. тов. Dragokas, если к коду, оформлению и полезности нет претензий (а написан он был на больную голову), то почему и нет?
0
Модератор
10052 / 3897 / 884
Регистрация: 22.02.2013
Сообщений: 5,850
Записей в блоге: 79
24.04.2013, 09:24
Соглашусь с тов. Апострофф
0
Заблокирован
24.04.2013, 12:32
Товарищи, а не лучше ли переместить данные 2 топика в раздел сборника кодов и примеров где товарищ inv.DS ведет 1 неравный бой!?
0
Эксперт WindowsАвтор FAQ
 Аватар для Dragokas
18033 / 7736 / 892
Регистрация: 25.12.2011
Сообщений: 11,502
Записей в блоге: 16
24.04.2013, 16:34  [ТС]
Просмотрел, проверил.

The trick, очень кропотливая работа. Понравился. Багов не обнаружил.
Апострофф, тоже понравился простотой исполнения. Только стоит добавить, что в файле тестов из 3 ответов верным является первый.
0
3 / 3 / 1
Регистрация: 22.06.2013
Сообщений: 45
08.11.2013, 17:00
Готовые решения и полезные коды на Visual Basic 6.0
Visual Basic
1
2
3
4
5
     Private Sub Command1_Click()  
    'генерирует случайное число от 0 до 99  
    Randomize 'перемешиваем счетчик относительно системного времени
    MsgBox Int(100 * Rnd)  
    End Sub
Наткнулся на примерчик и подумал, что у человека, его ищущего, останутся вопросы типа 'Как это работает?', "А если надо от 5 до 99?'
Ленивые Чай-ники пользуются функцией в общем модуле (в нем хоть полную формулу видно):
Visual Basic
1
2
3
4
5
6
7
Public Function RaNum(minRand As Long, maxRand As Long)  as Long
'генерирует случайное число  до  2147483647
  Randomize        'перемешиваем счетчик относительно системного времени
   RaNum = Int((maxRand - minRand + 1) * Rnd + minRand)
End Function
 
 MsgBox RaNum(0, 99)
0
Заблокирован
09.11.2013, 03:01
chai_nick смотри
Visual Basic
1
2
Randomize timer
MsgBox Int(95 * Rnd)+5
будет вылазить строго от 5 до 99

Добавлено через 1 час 13 минут
Цитата Сообщение от The trick Посмотреть сообщение
Тест с закодированными вопросами и ответами, с защитой от неправильного изменения.
полезная штука !
1
 Аватар для Sapphire
58 / 52 / 0
Регистрация: 15.12.2012
Сообщений: 449
25.12.2013, 08:38
Цитата Сообщение от inv.DS Посмотреть сообщение
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Option Explicit
Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
Dim p As String
Private Sub Form_Load()
p = "c:\101.mp3"
End Sub
'воспроизводим файл
Private Sub Command2_Click()
Dim f As Long, s As String
s = StrConv(LoadResData(101, "CUSTOM"), vbUnicode)
f = FreeFile
Open p For Binary As #f
Put #f, , s
Close #f
Call mciExecute("play " & p)
End Sub
'стоп
Private Sub Command1_Click()
On Error Resume Next
Call mciExecute("close " & p)
Kill p
End Sub
Код не работает, ибо ресурс 101 не найден. Тестил в хп. В чем причина?

 Комментарий модератора 
Цитата Сообщение от Dragokas Посмотреть сообщение
Запрещаются любые обсуждения выложенных здесь работ (читаем спойлер).
0
es geht mir gut
 Аватар для SoftIce
11274 / 4760 / 1183
Регистрация: 27.07.2011
Сообщений: 11,439
25.12.2013, 08:55
Нужно добавить ресурс
Миниатюры
Тестирование полезных кодов и примеров  
0
 Аватар для Антихакер32
1201 / 473 / 46
Регистрация: 06.01.2014
Сообщений: 1,797
Записей в блоге: 19
17.05.2014, 03:06
Регистрация DLL // OCX с помощью API

с примером и DLL-кой внутри архива

Visual Basic
1
2
3
4
5
6
7
8
9
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
Option Explicit
'
'© FelixMacintosh 2014
'Регистрация DLL // OCX
'
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Any, ByVal wParam As Any, ByVal lParam As Any) As Long
 
Sub main()
    '
    'Пример регистрации моей dll-ки
    '
    Dim cErr As Object
    ChDir App.Path 'Зайти в папку, где сейчас программа
    Register_OCX_DLL 0, "dllErr.dll", True 'Зарегить
    '
    'Внутренности той dll-ки
    '
    'Public Function Add(Number&, Description$) As Long
    '    'Создаёт номер и дискриптор ошибки
    '    'Возвращает успешно добавленный номер
    'Public Sub Raise(Expression As Boolean, ByVal Index$, Optional Source$)
    '    'Вызов ошибки по указанному индексу
    '    'Арг: выражение // номер или ключ // источник
    '
    'Протестировать её работу
    Set cErr = CreateObject("dllErr.cErr") 'Создать класс
    '
    cErr.Add -2 ^ 16, "Ошибка из за того что ... 2 + 2 = 4"
    cErr.Raise 2 + 2 = 4, -2 ^ 16, "main"
    
    Register_OCX_DLL 0, "dllERR.dll", False 'Отенить регистрацию
End Sub
'
'
'
Public Function Register_OCX_DLL(Wnd As Long, Path As String, Reg As Boolean)
    On Error Resume Next
    Dim lb As Long, pa As Long
    lb = LoadLibrary(Path)
 
    If Reg = True Then
        pa = GetProcAddress(lb, "DllRegisterServer")
    Else
        pa = GetProcAddress(lb, "DllUnregisterServer")
    End If
 
    If pa > 0 Then
        Call CallWindowProc(pa, Wnd, ByVal 0&, ByVal 0&, ByVal 0&)
        Call FreeLibrary(lb)
    End If
End Function
Вложения
Тип файла: rar RegDllOcx.rar (6.2 Кб, 35 просмотров)
2
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
BasicMan
Эксперт
29316 / 5623 / 2384
Регистрация: 17.02.2009
Сообщений: 30,364
Блог
17.05.2014, 03:06
Помогаю со студенческими работами здесь

Парочка полезных видеоуроков по C++
323e1ffiYjw AEA7GmPli5Y OH7g2lfsYEU Может какой-нибудь следующий &quot;учитель&quot; посмотрит и передумает делать свои уроки :)

Удаленное тестирование приложение/Пересылка на тестирование
Если кто-то написал приложение под андроид и захочет показать другому человеку, то достаточно отослать apk. А как обстоит с этим дело в...

Unit -тестирование или автоматизированное тестирование
Доброго времени суток. Я программирую «для себя» второй год, на выходе получаются разного рода приложения от постоянно подающих с...

Не Большой Набор Полезных Функций
Функция проверки на наличие не запрещенных символов в поле, где ? - запрещенные символы Function Check_BadSymbols(sStr As String) As...

USBasp - пара возможно полезных плюшек.
Уважаемые коллеги! Возможно то, что я опишу - баян с бородищей. Готов принять справедливую критику. Но вдруг кому-то поможет. Держу...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
40
Ответ Создать тему
Новые блоги и статьи
SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами
8Observer8 20.02.2026
Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .
Конвертировать закладки radiotray-ng в m3u-плейлист
damix 19.02.2026
Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .
Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI
Eddy_Em 18.02.2026
Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .
Камера Toupcam IUA500KMA
Eddy_Em 12.02.2026
Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
И ясному Солнцу
zbw 12.02.2026
И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.
«Знание-Сила»
zbw 12.02.2026
«Знание-Сила» «Время-Деньги» «Деньги -Пуля»
SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров
8Observer8 12.02.2026
Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .
SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image)
8Observer8 11.02.2026
Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru