Эксперт WindowsАвтор FAQ
 Аватар для Dragokas
18033 / 7736 / 892
Регистрация: 25.12.2011
Сообщений: 11,502
Записей в блоге: 16

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

15.10.2012, 00:56. Показов 30385. Ответов 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 / 3928 / 742
Регистрация: 11.10.2011
Сообщений: 5,908
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 / 3928 / 742
Регистрация: 11.10.2011
Сообщений: 5,908
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 / 884
Регистрация: 22.02.2013
Сообщений: 5,854
Записей в блоге: 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 / 3928 / 742
Регистрация: 11.10.2011
Сообщений: 5,908
24.04.2013, 07:04
Ув. тов. Dragokas, если к коду, оформлению и полезности нет претензий (а написан он был на больную голову), то почему и нет?
0
Модератор
10060 / 3905 / 884
Регистрация: 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
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
Ответ Создать тему
Опции темы

Новые блоги и статьи
Асинхронный приём данных из COM-порта
Argus19 01.05.2026
Асинхронный приём данных из COM-порта Купил на aliexpress термопринтер QR701. Он оказался странным. Поключил к Arduino Nano. Был очень удивлён. Наотрез отказывается печатать русские буквы. Чтобы. . .
попытка написать игровой сервер на C++
pyirrlicht 29.04.2026
попытка написать игровой сервер на плюсах с открытым бесконечным миром. возможно получится прикрутить интерпретатор питон для кастомизации игровой логики. что есть на текущий момент:. . .
Контроль уникальности выбранного документа-основания при изменении реквизита
Maks 28.04.2026
Алгоритм из решения ниже разработан на примере нетипового документа "ЗаявкаНаРемонтСпецтехники", разработанного в КА2. Задача: уведомлять пользователя, если указанная заявка (документ-основание). . .
Благородство как наказание
Maks 24.04.2026
У хорошего человека отношения с женщинами всегда складываются трудно. А я человек хороший. Заявляю без тени смущения, потому что гордиться тут нечем. От хорошего человека ждут соответствующего. . .
Валидация и контроль данных табличной части документа перед записью
Maks 22.04.2026
Алгоритм из решения ниже реализован на примере нетипового документа, разработанного в КА2. Задача: контроль и валидация данных табличной части документа перед записью с учетом регламента компании. . .
Отчёт о затраченных материалах за определенный период с макетом печатной формы
Maks 21.04.2026
Отчёт из решения ниже размещён в конфигурации КА2. Задача: разработка отчёта по затраченным материалам за определённый период, с возможностью вывода печатной формы отчёта с шапкой и подвалом. В. . .
Отчёт о спецтехнике находящейся в ремонте
Maks 20.04.2026
Отчёт из решения ниже размещен в конфигурации КА2. Задача: отобразить спецтехнику, которая на данный момент находится в ремонте. Есть нетиповой документ "Заявка на ремонт спецтехники" который. . .
Памятка для бота и "визитка" для читателей "Semantic Universe Layer (Слой семантической вселенной)"
Hrethgir 19.04.2026
Сгенерировано для краткого описания по случаю сборки и компиляции скелета серверного приложения. И пусть после этого скажут, что статьи сгенерированные AI - туфта и не интересно. И это не реклама -. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru