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

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

15.10.2012, 00:56. Показов 30924. Ответов 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
18035 / 7738 / 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
 Аватар для Апострофф
9912 / 3933 / 743
Регистрация: 11.10.2011
Сообщений: 5,913
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
 Аватар для Апострофф
9912 / 3933 / 743
Регистрация: 11.10.2011
Сообщений: 5,913
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
Модератор
10060 / 3905 / 885
Регистрация: 22.02.2013
Сообщений: 5,854
Записей в блоге: 79
23.04.2013, 21:55
Тест с закодированными вопросами и ответами, с защитой от неправильного изменения.
Миниатюры
Тестирование полезных кодов и примеров  
Вложения
Тип файла: rar TrickTest.rar (43.6 Кб, 24 просмотров)
1
Эксперт WindowsАвтор FAQ
 Аватар для Dragokas
18035 / 7738 / 892
Регистрация: 25.12.2011
Сообщений: 11,502
Записей в блоге: 16
23.04.2013, 23:53  [ТС]
Ув. тов. Апострофф, The trick, не имею понятия, зачем здесь эти тесты.
Тема была создана для проверки кодов на работоспособность, а не выкладывание программ тестирования.

Перенести Ваши примеры в тему: Готовые решения и полезные коды на Visual Basic 6.0
?
0
 Аватар для Апострофф
9912 / 3933 / 743
Регистрация: 11.10.2011
Сообщений: 5,913
24.04.2013, 07:04
Ув. тов. Dragokas, если к коду, оформлению и полезности нет претензий (а написан он был на больную голову), то почему и нет?
0
Модератор
10060 / 3905 / 885
Регистрация: 22.02.2013
Сообщений: 5,854
Записей в блоге: 79
24.04.2013, 09:24
Соглашусь с тов. Апострофф
0
Заблокирован
24.04.2013, 12:32
Товарищи, а не лучше ли переместить данные 2 топика в раздел сборника кодов и примеров где товарищ inv.DS ведет 1 неравный бой!?
0
Эксперт WindowsАвтор FAQ
 Аватар для Dragokas
18035 / 7738 / 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
Ответ Создать тему
Новые блоги и статьи
сукцессия 13. Питон модель трехзонного мицелия, пока что в основном арбускулярного
anaschu 28.06.2026
## Разработка агентной модели микоризной сукцессии: от выявления артефактов к созданию комплексной системы ### Аннотация Представлено исследование по разработке агентной модели микоризной. . .
сукцессия 12. краткий список проверок модели перед запуском.
anaschu 27.06.2026
Скрытые отказы в моделях систем динамики (SD-models) экологических систем: два случая из практики Контекст Разбирался прототип модели систем динамики (SD-модели) микоризной сукцессии: пять. . .
Сукцессия 11. Проверка орудий перед войной: разработка через тестирование
anaschu 27.06.2026
Как не дать модели соврать самой себе: проверки для симуляции микоризной сукцессии Введение Когда вы строите математическую модель живой системы — грибов, растений, почвы — главная опасность. . .
10 сукцессия. Питон код войны грибов и растений
anaschu 27.06.2026
import numpy as np class PlantAgent: def __init__(self, name, strategy, initial_biomass): self. name = name self. strategy = strategy # "greedy" (широколиственные) или. . .
сукцессия 9. Математика подлости: как растения предали грибных друзей
anaschu 27.06.2026
Статья 2. Глобальная фосфорная война: эволюционно-экономические механизмы распределения биомов Земли Введение: Экологический рынок как игра с нулевой суммой Традиционная экология долгое время. . .
сукцессия 8. Как я спорил с ИИ, которые - агенты растений и ненавистники грибов!
anaschu 27.06.2026
Статья 1. Хроники грибного восстания: как Сократов диалог разрушил академические догмы ИИ Введение: Синдром «цифрового учебника» Современные большие языковые модели (LLM) обладают колоссальным. . .
Главный вопрос моделирования сукцессии
anaschu 27.06.2026
главный вопрос. Если эктомикориза лучше добывает недоступный фосфор. И ее масса максимальна из всех. А широколиственный лес тоже имеет самую крутую биомассу. То почему не возникло их симбиоза? Это. . .
сукцессия 6. Питон реализация энилоджиковской модели, картинка про Центральную часть будущей модели
anaschu 26.06.2026
Етить. ИИ мне на основе моего старого файла R создал вот эту вот хмерь на пайтоне. Это уже новая модель, модель сукцессии грибной. потоки фосфора, азота. Углерода. 5 видов организмов. Я даже. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru