purebasic.info

PureBasic forum
Текущее время: Ср ноя 21, 2018 9:45 pm

Часовой пояс: UTC + 3 часа




Начать новую тему Ответить на тему  [ Сообщений: 22 ]  На страницу 1, 2  След.
Автор Сообщение
 Заголовок сообщения: Проверка почты...
СообщениеДобавлено: Вс июл 20, 2008 10:38 pm 
Не в сети
GameC@Soft
Аватар пользователя

Зарегистрирован: Сб сен 22, 2007 12:45 pm
Сообщений: 1084
Откуда: Я из лесу вышел, и сразу зашел, в босоножках дырявых и взлядом ночным.
Благодарил (а): 1 раз.
Поблагодарили: 2 раз.
Пункты репутации: 0
Сделал программу для проверки почты... то Петр: Не обижайся...

Программа для проверки почты v1.0
Автор программы : Шаганов Артём Фёдорович

что делает программа?

- программа проверяет ваши почтовые ящики и выдает сообщение о кол-во писем в Каждом ящике

настройка программы:

интерфейс программы предельно прост

В окне "настройка программы" вы можете

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

В окне "добовление учетное записи" поля соответсвуют такому порядку

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

по окончанию ввода параметров учетной записи нажмите "Ок", учетная запись создана и сохранена, теперь не надо каждый раз вводить одно и тоже.

если вы случайно попали сюда, то есть кнопка "отмена" она закроет кокно и не сохранит изменения.

Как работает таймер?

таймер автоматической проверки почты
при нажатии на кнопку таймер, появится строка ввода длины таймера, указывайте в сек, рекомендуется ставить значение равным 300 (5 мин)
Если вам не нужен таймер, то просто еще раз нажмите на кнопку "таймер" и вам будет предложенно удалить его

так же с таймером на автовыключение.. только время вводится в минутах.

найденные глюки:

-лично мной найден один глюк

Что он из себя представляет?

- по какой то причине, библиотека POP отказыватеся работать в результате, окно где выводится сообщение просто пустое, как исправить, пока не понятно.

будут глюки пишите на email: kilosoft{собка}mail.ru с пометкой "Проверка почты - глюки" и все остальное с пометкой "Проверка почты - все остальное"

Спасибо за внимание.
kilosoft@2008 г.


Код:
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
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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
; Проверка почты v1.0
; Автор: Шаганов Артём
; PureBasic 4.0 and lib PurePOP3
; DEMO : нет
 
InitNetwork()
 
Global event,timedelay,timedelayexit,index,message.s, opo
 
Enumeration
  #main
  #setting
  #list
  #add
  #dell
 
  #adduser
  #name
  #user
  #pass
  #port
  #server
  #ok
  #cancel
  #timer
  #autoexit
  #exit
  #svernut
 
  #poup
  #texts
  #info
  #ico
  #kill_poups
 
  #icon
  #again
  #menu
EndEnumeration
 
OpenWindow(#main,0,0,0,0,"Проверка почты")
HideWindow(#main,1)
 
CreatePopupMenu(#menu)
MenuItem(#setting,"Настройки")
MenuBar()
MenuItem(#again, "Проверить")
MenuBar()
MenuItem(#exit, "Выход")
 
Structure user
  name.s
  user.s
  pass.s
  port.l
  server.s
EndStructure
 
Global NewList user.user()
 
LoadImage(#icon,"icon.ico")
 
AddSysTrayIcon(#icon,WindowID(#main),ImageID(#icon))
SysTrayIconToolTip(#icon,"Программа проверки почты, автор: Шаганов Артём")
 
Procedure mouse(button)
If button=1
  Select event
  Case #WM_LBUTTONDOWN
  mouse_a=1
  Case #WM_LBUTTONUP
  mouse_a=0
  EndSelect
  ProcedureReturn mouse_a
EndIf
If button=2
  Select event
  Case #WM_RBUTTONDOWN
  mouse_b=1
  Case #WM_RBUTTONUP
  mouse_b=0
  EndSelect
  ProcedureReturn mouse_b
EndIf
EndProcedure
 
Procedure adduser(name.s, user.s, pass.s, port.l, server.s)
AddElement(user())
 
  With user()
    \name=name
    \user=user
    \pass=pass
    \port=port
    \server=server
  EndWith
 
EndProcedure
 
Procedure savesetting()
CreateFile(0,"setting.ini")
WriteStringN(0,Str(timedelay))
WriteStringN(0,Str(timedelayexit))
WriteStringN(0,"")
ResetList(user())
While NextElement(user())
  With user()
  WriteStringN(0,\name)
  WriteStringN(0,\user)
  WriteStringN(0,RC4Api(\pass,"Manduck2008for4"))
  WriteStringN(0,Str(\port))
  WriteStringN(0,\server)
  WriteStringN(0,"")
  EndWith
Wend
CloseFile(0)
EndProcedure
 
Procedure opensetting()
OpenFile(0,"setting.ini")
 
timedelay=Val(ReadString(0))
timedelayexit=Val(ReadString(0))
pustihka=Val(ReadString(0))
 
While Eof(0)=0
  name.s=ReadString(0)
  user.s=ReadString(0)
  pass.s=RC4Api(RC4Api(ReadString(0),"Manduck2008for4"),"Manduck2008for4")
  port.l=Val(ReadString(0))
  server.s=ReadString(0)
  pustihka=Val(ReadString(0))
  adduser(name,user,pass,port,server)
Wend
CloseFile(0)
EndProcedure
 
Procedure lisituser()
 
ResetList(user())
While NextElement(user())
AddGadgetItem(#list,P,user()\name)
p+1
Wend
EndProcedure
 
Procedure setting()
 
OpenWindow(#setting,0,0,300,100,"Настройка программы",#PB_Window_ScreenCentered)
CreateGadgetList(WindowID(#setting))
  ListIconGadget(#list,0,0,200,100,"Ящики",180)
  ButtonGadget(#Add,210,0,80,20,"Добавить")
  ButtonGadget(#dell,210,20,80,20,"Удалить")
  ButtonGadget(#timer,210,40,80,20,"Таймер")
  ButtonGadget(#autoexit,210,60,80,20,"Автовыход")
  ButtonGadget(#svernut,210,80,80,20,"Свернуть")
  lisituser()
EndProcedure
 
Procedure w_adduser()
OpenWindow(#adduser,0,0,200,130,"Добавление учетной записи",#PB_Window_ScreenCentered)
CreateGadgetList(WindowID(#adduser))
 StringGadget(#name,10,5,100,20,"name")
 StringGadget(#user,10,30,100,20,"user")
 StringGadget(#pass,10,55,100,20,"pass",#PB_String_Password)
 StringGadget(#port,10,80,100,20,"110")
 StringGadget(#server,10,105,100,20,"pop.mail.ru")
 
 ButtonGadget(#ok,120,5,70,20,"ОК")
 ButtonGadget(#cancel,120,30,70,20,"Отмена")
EndProcedure
 
Procedure avtoexit()
End
EndProcedure
 
 
 
Procedure poup_window(text.s,SizeX,SizeY)
ExamineDesktops()
x=DesktopWidth(0)-SizeX-5
y=DesktopHeight(0)-SizeY-5
opo=OpenWindow(#poup,x,y,SizeX,SizeY,"",#PB_Window_BorderLess,WindowID(main))
SetWindowColor(#poup,RGB(46, 172, 209))
CreateGadgetList(WindowID(#poup))
TextGadget(#texts,0,40,SizeX,SizeY,text, #PB_Text_Center)
 
ImageGadget(#ico,3,3,32,32,ImageID(#icon))
 
SetGadgetColor(#texts,#PB_Gadget_BackColor,RGB(46, 172, 209))
SetGadgetColor(#texts,#PB_Gadget_FrontColor,RGB(255,255,225))
 
Repeat
event=WaitWindowEvent()
If mouse(1)
  CloseWindow(#poup)
  r=1
EndIf
If mouse(2)
  CloseWindow(#poup)
  r=1
EndIf
Until r=1
EndProcedure
 
Procedure ob_mail()
PurePOP3_ClosePOP3Connection()
ResetList(user())
While NextElement(user())
Debug user()\name
  If PurePOP3_OpenPOP3Connection(user()\server,user()\port,user()\user,user()\pass) = #PurePOP3_Ok
    count=PurePOP3_CountMessages()
    If count>=0
      message+" в ящике "+user()\name+" "+Str(count)+" писем(о) "+Chr(10)
    EndIf
  PurePOP3_ClosePOP3Connection()
  Else
  message+"ящик "+user()\name+" "+"недоступен "+Chr(10)
  EndIf
  Delay(5000) ; задержка
Wend
If message<>""
poup_window(message,200,200)
message=""
Else
poup_window("Нет писем",200,200)
EndIf
EndProcedure
 
Procedure timerr()
ob_mail()
StartTimer(#timer,timedelay*1000,@timerr())
EndProcedure
 
Procedure ob_setting()
 
If event=#PB_Event_CloseWindow ; закрытие окна
  CloseWindow(#setting)
EndIf
 
If event=#PB_Event_Gadget
  Select EventGadget()
 
    Case #add ; добавляем ползьвателя
        CloseWindow(#setting)
        w_adduser()
    Case #dell ; удаляем пользователя
        name.s=GetGadgetText(#list)
        ResetList(user())
        While NextElement(user())
          If user()\name=name
            DeleteElement(user())
          EndIf
        Wend
        CloseWindow(#setting)
        setting()
        savesetting()
   
    Case #timer
        If timedelay<>0
          otvet=MessageRequester("Внимание","Внимание, таймер уже включен, удалить его?",#PB_MessageRequester_YesNo)
        EndIf
       
        If timedelay=0
          timedelay=Val(InputRequester("Ввод","Укажите в сек, с какой переодичностью проверять почтовые ящик(и)",""))
          If timedelay<>0 Or timedelay>0
          StartTimer(#timer,timedelay*1000,@timerr())
          Else
          MessageRequester("Ошибка","Не верное введено время")
          EndIf
        EndIf
       
        If otvet=6
          EndTimer(#timer)
          MessageRequester("","Таймер удален")
          timedelay=0
        EndIf
        savesetting()
    Case #autoexit
   
        If timedelayexit<>0
          otvet=MessageRequester("Внимание","Внимание, таймер уже включен, удалить его?",#PB_MessageRequester_YesNo)
        EndIf
   
        If timedelayexit=0
          timedelayexit=ValF(InputRequester("Ввод","Укажите в минутах, когда программе завершить сеанс",""))
          If timedelayexit<>0 Or timedelayexit>0
          StartTimer(#autoexit,timedelayexit*1000*60,@avtoexit())
          Else
          MessageRequester("Ошибка","Не верное введено время")
          EndIf
        EndIf
   
        If otvet=6
          EndTimer(#autoexit)
          MessageRequester("","Таймер удален")
          timedelayexit=0
        EndIf
        savesetting()
    Case #svernut
     CloseWindow(#setting)
  EndSelect
EndIf
 
EndProcedure
 
Procedure ob_w_user()
 
If event=#PB_Event_CloseWindow ; закрытие окна
  CloseWindow(#adduser)
EndIf
 
If event=#PB_Event_Gadget
  Select EventGadget()  
    Case #ok
   
        name.s=GetGadgetText(#name)
        user.s=GetGadgetText(#USer)
        pass.s=GetGadgetText(#pass)
        port.l=Val(GetGadgetText(#port))
        server.s=GetGadgetText(#server)
       
        If CountList(user())>0
        ResetList(user()) ; проверяем есть такое имя или нет
        While NextElement(user())
            If name<>user()\name
                ok=1
            Else
                ok=0
                MessageRequester("Внимание","Такое название учетной записи существует, пожалуйста поменяйте имя",0)
            EndIf
        Wend
        Else
        ok=1
        EndIf
       
        If ok=1 ; если совпадения в имени не было, то добавляем его в базу
        adduser(name,user,pass,port,server)  
        CloseWindow(#adduser)
        setting()
        savesetting()
        EndIf
       
    Case #cancel
        CloseWindow(#adduser)
        setting()
  EndSelect
EndIf
 
EndProcedure
 
Procedure ob_menu()
 
If event = #PB_Event_SysTray
  If EventType() = #PB_EventType_RightClick ; Обработка правой кнопки мышки
  DisplayPopupMenu(#menu, WindowID(0)) ; показ вспывающего меню
  EndIf
EndIf
 
If event = #PB_Event_Menu
Select EventMenu()
 
  Case #setting
    setting()
  Case #again
    ob_mail()
  Case #exit
    End
   
EndSelect
EndIf
 
EndProcedure
 
 
opensetting()
ob_mail()
Repeat
event=WaitWindowEvent(100)
 
 
ob_menu()    ; обработка меню
ob_setting() ; обработка событий окна настроек
ob_w_user()  ; обработка событий окна добавлния учетной запси
 
 
Until q=1
End



Вложения:
Проверка почты.rar [34.86 KiB]
Скачиваний: 392

_________________
"Самый большой глюк в PureBasic - это твоя голова...." (с) Артем
Мой сайт: http://feelzone.org.ua/


Последний раз редактировалось Артём Пн июл 21, 2008 12:09 am, всего редактировалось 1 раз.
Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Вс июл 20, 2008 11:51 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Вс май 04, 2008 12:18 am
Сообщений: 434
Откуда: PointOfPresence.Ru
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Артём писал(а):
то Петр: Не обижайся...

Интересно на что?

Артём писал(а):
будут глюки пишите на email

1. Никогда не свети имэйлом - спам замучишься выгребать
2. Почему бы не сделать отсылку багов через прогу?
Теоретически могу поделиться своим модулем баг-репортинга (используется во всех наших проектах)

_________________
Изображение Точка.Присутствия - каждому по потребностям!


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн июл 21, 2008 12:07 am 
Не в сети
GameC@Soft
Аватар пользователя

Зарегистрирован: Сб сен 22, 2007 12:45 pm
Сообщений: 1084
Откуда: Я из лесу вышел, и сразу зашел, в босоножках дырявых и взлядом ночным.
Благодарил (а): 1 раз.
Поблагодарили: 2 раз.
Пункты репутации: 0
поделись, будет весьма интересно... А спама и так хватает)

_________________
"Самый большой глюк в PureBasic - это твоя голова...." (с) Артем
Мой сайт: http://feelzone.org.ua/


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн июл 21, 2008 10:09 am 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11325
Благодарил (а): 4 раз.
Поблагодарили: 441 раз.
Артём писал(а):
по какой то причине, библиотека POP отказыватеся работать в результате, окно где выводится сообщение просто пустое, как исправить, пока не понятно
Я тоже сталкивался с подобной проблемой... :(
Похоже что это глюк библиотеки PurePOP3 :(
Используй в место неё PureSMTP http://freenet-homepage.de/gnozal/PureSMTP_.zip и всё нормально будет. :)

Я вот заметил один глюк.
Когда окно активно, нельзя вызвать контекстное меню.
Рекомендую добавить обработчик событий трея и меню в процедуру poup_window

Если хочешь, можешь улучшить вид контекстного меню
так
Изображение
или так
Изображение
Для этого нужно установить библиотеку CoolMenu_Lib http://pbasic.spb.ru/phpBB2/viewtopic.php?p=4194#4194
Для первого случая, достаточно вставить строку InitCoolMenu(WindowID(#main) ) после создания контекстного меню.
А для второго случая, строку InitCoolMenu(WindowID(#main),2)

_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн июл 21, 2008 1:01 pm 
Не в сети
GameC@Soft
Аватар пользователя

Зарегистрирован: Сб сен 22, 2007 12:45 pm
Сообщений: 1084
Откуда: Я из лесу вышел, и сразу зашел, в босоножках дырявых и взлядом ночным.
Благодарил (а): 1 раз.
Поблагодарили: 2 раз.
Пункты репутации: 0
Глюк связан из за того, что у меня было слабое соединение, так как использовал GPRS, проверил на работе, все отлично работает.. там скорость 1-1.5 мегабит

_________________
"Самый большой глюк в PureBasic - это твоя голова...." (с) Артем
Мой сайт: http://feelzone.org.ua/


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн июл 21, 2008 1:10 pm 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11325
Благодарил (а): 4 раз.
Поблагодарили: 441 раз.
А почему у тебя в коде два обработчика событий? :shock:
Должен быть только один!

А определять в каком окне произошло событие можно с помощью EventWindow()

_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пн июл 21, 2008 2:49 pm 
Не в сети
GameC@Soft
Аватар пользователя

Зарегистрирован: Сб сен 22, 2007 12:45 pm
Сообщений: 1084
Откуда: Я из лесу вышел, и сразу зашел, в босоножках дырявых и взлядом ночным.
Благодарил (а): 1 раз.
Поблагодарили: 2 раз.
Пункты репутации: 0
Пётр, ты гений по разборке и нахождению ошибок)) Спасибо, все проверю и исправлю), возможно что то еще добавлю...

_________________
"Самый большой глюк в PureBasic - это твоя голова...." (с) Артем
Мой сайт: http://feelzone.org.ua/


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пт июл 25, 2008 1:11 am 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Вс май 04, 2008 12:18 am
Сообщений: 434
Откуда: PointOfPresence.Ru
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Артём писал(а):
поделись, будет весьма интересно


Основной модуль:
Код:
1
2
3
4
5
6
7
OnErrorGosub(?CatchError)
 
<Основной код проги здесь>
 
CatchError:
XIncludeFile "ErrorDialog.pbi"
Return



ErrorDialog.pbi
Код:
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
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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
 
Enumeration
  #SEND_STATUS_INIT
  #SEND_STATUS_OK
  #SEND_STATUS_ERROR
EndEnumeration
 
Global EXIT_Button.s
Global CONTINUE_Button.s
Global EXTENDET_Button.s
Global EXTENDET_Address.l
Global sendStatus = #SEND_STATUS_INIT
 
Declare Send_Email(body.s)
 
EXTENDET_Address = @Send_Email()
;CompilerSelect #language
;  CompilerCase #LANG_ENGLISH
    EXIT_Button     = "&End"
    CONTINUE_Button = "&Continue"
    EXTENDET_Button = "&Send bug report"
;  CompilerCase #LANG_RUSSIAN
;    EXIT_Button     = "&Выход"
;    CONTINUE_Button = "&Продолжить"
;    EXTENDET_Button = "&Отправить отчет"
;CompilerEndSelect
 
Procedure ErrorDialog(Title.s, MessageTitle.s, MessageBody.s)
  #Dialog_Width = 400
  #Dialog_Height = 190
  #Logo = 0
  #MsgTitle = 1
  #MsgBody = 2
  #Exit = 3
  #Extendet = 5
  #Continue = 4
  #WindowID=999
  #pbar = 10
  Protected ExeFileName.s = Space(1024)
  GetModuleFileName_(0, @ExeFileName.s, 1024)
  MessageTitle=ReplaceString(MessageTitle, "%file%", GetFilePart(ExeFileName))
  Protected ErrorHWND = OpenWindow(#WindowID, 0, 0, #Dialog_Width, #Dialog_Height, Title, #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  If ErrorHWND
    If CreateGadgetList(WindowID(#WindowID))
      ImageGadget(#Logo, 10, 8, 32, 32, LoadIcon_(0,32513))
      TextGadget(#MsgTitle, 60, 17, #Dialog_Width - 80, 32, MessageTitle)
      Protected StringFlags = #PB_String_ReadOnly;|#WS_VSCROLL
      Protected HwndEG = EditorGadget(#MsgBody, 10, 50, #Dialog_Width - 20, #Dialog_Height - 100, StringFlags)
      SetGadgetText(#MsgBody, MessageBody)
      SetGadgetColor(#MsgBody, #PB_Gadget_BackColor, GetSysColor_(#COLOR_BTNFACE))    
      ShowScrollBar_(HwndEG, #SB_HORZ, #False)
      ButtonGadget(#Exit, 10, #Dialog_Height - 40, (#Dialog_Width - 40) / 3, 27, EXIT_Button, #BS_FLAT)
      If EXTENDET_Button <> ""
        ButtonGadget(#Extendet, 20 + (#Dialog_Width - 40) / 3, #Dialog_Height - 40, (#Dialog_Width - 40) / 3, 27, EXTENDET_Button, #BS_FLAT)
      EndIf
      Protected bHwnd = ButtonGadget(#Continue, 30 + ((#Dialog_Width - 40) / 3) * 2, #Dialog_Height - 40,(#Dialog_Width - 40) / 3, 27, CONTINUE_Button, #BS_FLAT)
      SetFocus_(bHwnd)
      DisableGadget(#Continue, 1)
      ProgressBarGadget(#pbar, 10, #Dialog_Height - 8, #Dialog_Width - 20, 6, 0, 100, #PB_ProgressBar_Smooth)
    EndIf
    SetWindowPos_(ErrorHWND, -1, 0, 0, 0, 0, $53)
    Repeat
      Protected WindowEvent = WaitWindowEvent()
      If WindowEvent = #PB_Event_Gadget
        If EventGadget() = #Exit
          End
        ElseIf EventGadget() = #Extendet
          CallFunctionFast(EXTENDET_Address, MessageBody)
        ElseIf EventGadget() = #Continue
          CloseWindow(#WindowID)
          ProcedureReturn 1
        EndIf
      EndIf
    Until WindowEvent = #PB_Event_CloseWindow
  EndIf
  End
  ProcedureReturn 0
EndProcedure
 
Procedure sendThread(body.s)
  If POP_MAIL_sendmail(#MAIL_SERVER$, #MAIL_TO$, #MAIL_FROM$, #MAIL_SUBJECT$, body)  
    sendStatus = #SEND_STATUS_OK
  Else
    sendStatus = #SEND_STATUS_ERROR  
  EndIf
EndProcedure
 
Procedure Send_Email(body.s)
 
  body = ReplaceString(body, Chr(9), " ")
  While FindString(body, "  ", 1)
    body = ReplaceString(body, "  ", " ")
  Wend  
  Protected thread = CreateThread(@sendThread(), body)
  DisableWindow(#WindowID, 1)
  Protected  i
  Repeat
    For i = 0 To 100 Step 1
      Select sendStatus
        Case #SEND_STATUS_OK
          CloseWindow(#WindowID)
          POP_MB_Info("Done", "Bug report sent successfully." + #CRLF$ + "Thank you!")
          End
        Case #SEND_STATUS_ERROR
          CloseWindow(#WindowID)
          POP_MB_Error("SMTP error", "Error sending report")
          End
        Default
          SetGadgetState(#pbar, i)
          Delay(10)
      EndSelect
    Next
  ForEver
  End  
EndProcedure
 
Procedure.s ShowError ()  
  Protected error = GetLastError_ ()  
  If error      
    POP_MB_Error("", GetLastErrorAsText( error ))
    Protected e$
    Protected *MemoryID = AllocateMemory (255)
    Protected length = FormatMessage_ (#FORMAT_MESSAGE_FROM_SYSTEM, #Null, error, 0, *MemoryID, 255, #Null)  
    If length > 1 ; Some error messages are "" + Chr (13) + Chr (10)... stoopid M$... :(  
        e$ = PeekS (*MemoryID, length - 2)  
    Else  
        e$ = "Unknown error!"  
    EndIf  
    FreeMemory (0)  
    ProcedureReturn e$  
  Else  
    ProcedureReturn "No error has occurred!"  
  EndIf  
EndProcedure  
 
; this procedure returns information about the current error:
Procedure.s GetErrorInfo()
 
  Protected errorModule.s = GetFilePart(GetErrorModuleName())
  errorModule = ReplaceString(errorModule, ".pbi", "")
  errorModule = ReplaceString(errorModule, ".pb", "")
 
  Protected RegisterInfo.s = "Executable: " + GetProgramName() + #CRLF$
  ;RegisterInfo.s + "-------------------------------------------------------------------------------------" + #CRLF$
  RegisterInfo.s + "Error code: 0x" + Hex(GetErrorNumber()) + #CRLF$
 ; RegisterInfo.s + "-------------------------------------------------------------------------------------" + #CRLF$
  RegisterInfo.s + "Error description: " + GetErrorDescription() + #CRLF$
  ;RegisterInfo.s + "-------------------------------------------------------------------------------------" + #CRLF$
  RegisterInfo.s + "Line: " + Str(GetErrorLineNR()) + #CRLF$
 ; RegisterInfo.s + "-------------------------------------------------------------------------------------" + #CRLF$
  RegisterInfo.s + "Module: " + "<" + errorModule + ">" + #CRLF$
  ;RegisterInfo.s + "-------------------------------------------------------------------------------------" + #CRLF$
  ;RegisterInfo.s + "Register  EIP" + #TAB$ + "=" + #TAB$ + "0x" + Hex(GetErrorAddress()) + #CRLF$
  ;RegisterInfo.s + "Register  EAX" + #TAB$ + "=" + #TAB$ + "0x" + Hex(GetErrorRegister(#PB_OnError_EAX)) + #CRLF$
  ;RegisterInfo.s + "Register  EBX" + #TAB$ + "=" + #TAB$ + "0x" + Hex(GetErrorRegister(#PB_OnError_EBX)) + #CRLF$
  ;RegisterInfo.s + "Register  ECX" + #TAB$ + "=" + #TAB$ + "0x" + Hex(GetErrorRegister(#PB_OnError_ECX)) + #CRLF$
  ;RegisterInfo.s + "Register  EDX" + #TAB$ + "=" + #TAB$ + "0x" + Hex(GetErrorRegister(#PB_OnError_EDX)) + #CRLF$
  ;RegisterInfo.s + "Register  EBP" + #TAB$ + "=" + #TAB$ + "0x" + Hex(GetErrorRegister(#PB_OnError_EBP)) + #CRLF$
  ;RegisterInfo.s + "Register  ESI" + #TAB$ + "=" + #TAB$ + "0x" + Hex(GetErrorRegister(#PB_OnError_ESI)) + #CRLF$
  ;RegisterInfo.s + "Register  EDI" + #TAB$ + "=" + #TAB$ + "0x" + Hex(GetErrorRegister(#PB_OnError_EDI)) + #CRLF$
  ;RegisterInfo.s + "Register  SegCS" + #TAB$ + "=" + #TAB$ + "0x" + Hex(GetErrorRegister(#PB_OnError_SegCS)) + #CRLF$
  ;RegisterInfo.s + "Register  FFlags" + #TAB$ + "=" + #TAB$ + "0x" + Hex(GetErrorRegister(#PB_OnError_FFLags))
  ProcedureReturn RegisterInfo
EndProcedure
 
;CompilerSelect #language
;  CompilerCase #LANG_ENGLISH
    ErrorDialog("Error message", "An error occured while running %file%", GetErrorInfo())
;  CompilerCase #LANG_RUSSIAN
;    ErrorDialog("Сообщение об ошибке", "В файле %file% произошла ошибка", GetErrorInfo())
;CompilerEndSelect



юзерлиба для отправки почты:
Код:
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
55
56
57
58
59
60
Procedure send(ConnID, msg.s)  
  SendNetworkData(ConnID,@msg,Len(msg))  
EndProcedure  
 
Procedure.s wait(ConnID)  
  res.s = Space(4999)
  ReceiveNetworkData(ConnID, @res, 4999)  
  res = Left(res, 3)  
  ProcedureReturn res  
EndProcedure  
 
ProcedureDLL.l POP_MAIL_sendmail(mailserver.s, mailto.s, mailfrom.s, subject.s, msgbody.s)  
  If InitNetwork()  
    ConnID = OpenNetworkConnection(mailserver, 25)  
    If ConnID  
      res.s = wait(ConnID)  
      error = 0  
      If res = "220"  
        send(ConnID, "HELO CGIapp" + #CRLF$)  
        res = wait(ConnID)  
        If res = "250"  
          Delay(100)  
          send(ConnID, "MAIL FROM:<" + mailfrom + ">" + #CRLF$)  
          res = wait(ConnID)  
          If res = "250"  
            send(ConnID, "RCPT TO:<" + mailto + ">" + #CRLF$)  
            res = wait(ConnID)  
            If res = "250"  
              send(ConnID, "DATA" + #CRLF$)  
              res = wait(ConnID)  
              If res = "354"  
                Delay(100)  
                send(ConnID, "Date: " + #CRLF$)  
                send(ConnID, "From: <" + mailfrom + ">" + #CRLF$)  
                send(ConnID, "To: <" + mailto + ">" + #CRLF$)  
                send(ConnID, "Subject: " + subject + #CRLF$)  
                send(ConnID, "X-Mailer: PBMailer" + #CRLF$)  
                Delay(100)  
                ;send(ConnID, "--" + #CRLF$ + "--" + #CRLF$ + #CRLF$)  
                send(ConnID, #CRLF$ + #CRLF$)  
                send(ConnID, msgbody)  
                Delay(100)  
                send(ConnID, "" + #CRLF$)  
                send(ConnID, "." + #CRLF$)  
                res = wait(ConnID)  
                If res = "250"  
                  Delay(100)  
                  send(ConnID, "QUIT" + #CRLF$)  
                  res = wait(ConnID)  
                  ProcedureReturn 1  
                EndIf  
              EndIf  
            EndIf  
          EndIf  
        EndIf  
      EndIf  
      CloseNetworkConnection(ConnID)  
    EndIf  
  EndIf  
EndProcedure



Бонус:
Код:
1
2
3
4
5
6
7
8
9
10
11
12
ProcedureDLL.l POP_MB_Info(Title.s, Message.s) ; MsgBox Info
  ProcedureReturn MessageRequester(Title, Message, #MB_ICONINFORMATION)
EndProcedure
ProcedureDLL.l POP_MB_Warning(Title.s, Message.s) ; MsgBox Warning
  ProcedureReturn MessageRequester(Title, Message, #MB_ICONWARNING)
EndProcedure
ProcedureDLL.l POP_MB_Error(Title.s, Message.s) ; MsgBox Error
  ProcedureReturn MessageRequester(Title, Message, #MB_ICONERROR)
EndProcedure
ProcedureDLL.l POP_MB_Question(Title.s, Message.s, Flags.l) ; MsgBox Question
  ProcedureReturn MessageRequester(Title, Message, Flags | #MB_ICONQUESTION)
EndProcedure



Это тоже кудато вставишь
Код:
1
2
3
4
5
; почтовые константы  
#MAIL_SERVER$ = "smtp.mail.ru"
#MAIL_TO$     = "твой@мыло_неважно.где"
#MAIL_FROM$   = "твой_мыло@mail.ru"
#MAIL_SUBJECT$ = "Bug report"



Надеюсь соберешь

_________________
Изображение Точка.Присутствия - каждому по потребностям!


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пт июл 25, 2008 9:29 am 
Не в сети
GameC@Soft
Аватар пользователя

Зарегистрирован: Сб сен 22, 2007 12:45 pm
Сообщений: 1084
Откуда: Я из лесу вышел, и сразу зашел, в босоножках дырявых и взлядом ночным.
Благодарил (а): 1 раз.
Поблагодарили: 2 раз.
Пункты репутации: 0
да вроде все понятно)) Спасибо))

_________________
"Самый большой глюк в PureBasic - это твоя голова...." (с) Артем
Мой сайт: http://feelzone.org.ua/


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Вс окт 12, 2008 10:22 am 
Не в сети
ассистент

Зарегистрирован: Пт июл 11, 2008 9:36 am
Сообщений: 12
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
А кто ни будь пробовал написать программу спама :?: :?: :?:


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Вс окт 12, 2008 11:29 am 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Вс май 04, 2008 12:18 am
Сообщений: 434
Откуда: PointOfPresence.Ru
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
гг, да, а что сложного то?

_________________
Изображение Точка.Присутствия - каждому по потребностям!


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Вс окт 12, 2008 11:32 am 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11325
Благодарил (а): 4 раз.
Поблагодарили: 441 раз.
Кто здесь? писал(а):
А кто ни будь пробовал написать программу спама

Ну да, предложи ещё вирус написать. :shock:
Теоритически, написать спамерную прогу можно, но только вот зачем.
Лично меня спам так достал...

_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Вс окт 12, 2008 5:44 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Вс май 04, 2008 12:18 am
Сообщений: 434
Откуда: PointOfPresence.Ru
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Пётр писал(а):
Теоритически, написать спамерную прогу можно, но только вот зачем.

Как зачем? Доставать Петра :)

Вирус - тоже идея прикольная. Есть масса наработок. И Хроно на булке много чего выкладывала...

_________________
Изображение Точка.Присутствия - каждому по потребностям!


Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Вт окт 14, 2008 2:47 pm 
Не в сети
ассистент

Зарегистрирован: Пт июл 11, 2008 9:36 am
Сообщений: 12
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
:cry:


Последний раз редактировалось Кто здесь? Чт окт 16, 2008 12:13 pm, всего редактировалось 1 раз.

Вернуться наверх
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Вт окт 14, 2008 4:16 pm 
Не в сети
BackupUser
Аватар пользователя

Зарегистрирован: Ср ноя 29, 2006 9:29 pm
Сообщений: 1492
Откуда: Москва
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Кто здесь? писал(а):
просто препод дал тему написать программу анти-спама,

Препод... С припаяной головой.
Это ж каким образом можно спам распознать, препод не поведал?

А каптчу разгадать он не просил?

Он тебя завтра попросит накодить прогу, которая на картинке породу животного узнавать будет.


Вернуться наверх
 Профиль  
 
Показать сообщения за:  Сортировать по:  
Начать новую тему Ответить на тему  [ Сообщений: 22 ]  На страницу 1, 2  След.

Часовой пояс: UTC + 3 часа


Кто сейчас на форуме

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 6


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
Создано на основе phpBB® Forum Software © phpBB Group (блог о phpBB)
Сборка создана CMSart Studio
Русская поддержка phpBB