| Вопрос: работа с CDO | Добавлено: 11.12.06 14:28 |
Автор вопроса:  Шпион | ICQ: 250543104 |
|
суть кода - парсинг входящих и исходящих сообщений
все работает, но в чем трабл - когда отправляю письмо с вложением через SMTP - письмо ловится, а когда отправляю письмо через MAPI - вложения не видны. Кто сталкивался - помогите <SCRIPT language="VBScript"> Function AttCheck(fn) AttCheck=False ar="zip.exe.bat.cmd.lnk.vbs.hta" arr=Split(ar,".") For i=0 To Ubound(arr) If Instr(1,fn,arr(i))=1+(len(fn)-len(arr(i))) Then AttCheck=True objFile.WriteLine arr(i) Exit Function End If Next End Function Function GetSender(strAddr) strResult = "" arr=split(strAddr,"<") If Ubound(arr)=0 Then strResult=strAddr Else strResult=arr(1) End If 'strResult=Replace(strResult,"<","") strResult=Replace(strResult,">","") 'strResult=Replace(strResult,"\","") 'strResult=Replace(strResult,"/","") 'strResult=Replace(sreResult, chr(34), "") strResult=Ltrim(Rtrim(strResult)) GetSender=strResult End Function Function GetRecipients(strRecipients) arrResult=split(strRecipients,";") If Ubound(arrResult)=0 Then arrResult(0)=getSender(strRecipients) Else For i=0 To Ubound(arrResult) arrResult(i)=GetSender(arrResult(i)) Next End If GetRecipients=arrResult End Function Function ISMTPOnArrival_OnArrival(Msg, Status) On Error Resume Next strRecipientHdrs = "" strSender=getSender(msg.Fields.Item("urn:schemas:mailheader:from").value) strRecipients=msg.To strRecipients=getSender(msg.Fields.Item("urn:schemas:mailheader:to").value) arrRecipients = GetRecipients(strRecipients) For i=0 To Ubound(arrRecipients) strRecipientHdrs=strRecipientHdrs & arrRecipients(i) & ", " Next If Len(strRecipientHdrs)>1 Then strRecipientHdrs=Left(strRecipientHdrs, Len(strRecipientHdrs)-2) End If Set objFSO=Createobject("Scripting.Filesystemobject") Set objFile=objFSO.OpenTextFile("c:\12345.txt",8,True) objFile.Writeline "Sender: " & strSender objFile.Writeline "Recipients: " & strRecipientHdrs objFile.Writeline "Subject:" & Msg.Subject If msg.Attachments.Count>0 Then objFile.Writeline "Attachments:" & msg.Attachments.Count For x=0 To msg.Attachments.Count-1 Set objAtt=msg.Attachments.Item(x) If Not objAtt.Filename="" Then If AttCheck(lcase(objatt.Filename))=True Then objFile.Writeline x & ": " & objatt.Filename & " DROPPED!!!" msg.Attachments.Delete x Else objFile.Writeline x & ": " & objatt.Filename End If End If Set objAtt = Nothing next End if Msg.Fields.Update Msg.Datasource.Save objFIle.Writeline "" objFile.Close Set objFile = Nothing Set objFSO=Nothing Status = 0 End Function </SCRIPT> |
| Ответы | Всего ответов: 1 |
|
Номер ответа: 1 Автор ответа:  mentos Вопросов: 1 Ответов: 2 |
Профиль | | #1 | Добавлено: 25.12.06 12:24 |
| Извини, я не могу тебе помочь, но я тоже с CDO имею трабл. Состоит в следующем (http://www.vbnet.ru/forum/show.aspx?id=126092) :письмо не уходит из локальной машины. | ||
Страница: 1 |