STRIGANOV SERGEY: Software development.

Разработка программного обеспечения на: C++, T-SQL, VBS, JavaScript, PHP

VBS, POP3_CLIENT


Простой скрипт проверки наличия писем в почтовом ящике.
Тест возможностей MSWINSCK.ocx

Test for object "MSWinsock.Winsock" (MSWINSCK.ocx) .
POP3 pager: get information about new e-mails.

 

 

 

 


 pop3_client.vbs

'обьявили глобальные обьекты и переменные'
Dim bConnected
Dim bEndWork
Dim bSent
Dim bShowErr
Dim SCommand
Dim iTotal
Dim str
Dim Winsock
Dim bDataReceived 
Dim CMDArry 
Dim oFS
Dim i ' счетчик посылаемых серверу команд'
'------------------------------'
VBS_Main          'точка входа скрипта'
'------------------------------'
sub VBS_Main()
SystemInit

    MSAgentInfo "Монитор почты начинает работу."
    Log( "Монитор почты начинает работу.")

 Do While Not (bConnected)
    POP3_Processor
    WScript.Sleep CMDArry(2)' периодичность проверки почты (60000 = 1 минута)'
 Loop
    MSAgentInfo "Монитор почты завершил работу."
    Log( "Монитор почты завершил работу.")
    
  oFS = noting  
  Winsock = noting
  end sub
'------------------------------'
sub POP3_Processor
SystemReset
Log("Connect: "&CMDArry(0)&":"&CMDArry(1)) 
Winsock.Connect CMDArry(0), CInt(CMDArry(1))
   
 Do While Not (bEndWork)
  WScript.Sleep 1000  
 Loop 
  
 Log( " --- end ---")&vbcrlf&vbcrlf
 SystemReset
end sub

'------------------------------'
sub SystemInit()
SystemReset
Set oFS = CreateObject("Scripting.FileSystemObject")
LoadCommandList
Set Winsock=WScript.CreateObject("MSWinsock.Winsock")
WScript.ConnectObject Winsock,"Winsock_"
end sub
'------------------------------'
sub SystemReset()
i=3 ' первые 3 строки - это сервер, порт, периодичность проверки'
bShowErr=true
bConnected=false
bSent=false
bDataReceived=false
bEndWork=false
SCommand=""
end sub
'------------------------------'
Sub LoadCommandList()
Dim f,CMDList

Set f = oFS.OpenTextFile("pop3_command.txt")            
CMDList = f.ReadAll       
          f.Close          
CMDArry=Split(CMDList,vbCrLf)
if  (UBound(CMDArry)<5)Then

	if (bShowErr)	Then
	MSAgentInfo ("Неправильныий список команд.")
	End if

	Log( "Неправильныий список команд.")
end if
'GetPassword'
End Sub
'------------------------------' 
sub GetPassword
Dim TmpPass
 TmpPass=InputBox("Для работы монитора почты"& vbcrlf &"нужно указать пароль к: "&Replace(CMDArry(3),"user ",""),"pop3_client...","" )   
 CMDArry(4)="pass "&TmpPass
end sub

'------------------------------' 
Sub Log(sData)
    Dim ts,  ForAppending
    ForAppending = 8
    Set ts=oFS.OpenTextFile("pop3_log.txt", ForAppending, True)
    ts.Write  Date & " - "& Time() & " " & sData & chr(13) & chr(10)
    ts.Close
End Sub

'------------------------------'
Sub Winsock_Connect
   'Log( "Winsock_Connect")'
   bConnected=true
End Sub

'------------------------------'
Sub winsock_Error(Number, Description, SCode, Source, HelpFile, HelpContext,CancelDisplay)
	
	if (bShowErr)	Then
	MSAgentInfo "Error " & Number & vbcrlf & Description
	End if

   Log( "Winsock_Error: "&Number&" "&Description)
   bConnected=false
   bEndWork=true

End Sub

'------------------------------'
Sub Winsock_Disconnect
    Log( "Winsock_Disconnect")
    bConnected=false
    bEndWork=true
End Sub

'------------------------------'
Sub Winsock_SendComplete
   ' Log( "Winsock_SendComplete")'
    bSent=true
End Sub

'------------------------------'
Sub Winsock_DataArrival(bytTotal)

   Winsock.GetData str,8
   iTotal=bytTotal
   bDataReceived=true 
   Log(str)   
   DataProcessor    
   CommandProcessor
 
End Sub

'------------------------------'
Sub CommandProcessor ()
if(bConnected)Then
 if (i <UBound(CMDArry))Then
         SCommand=CMDArry(i) &vbCrLf
         Winsock.SendData SCommand
         
         if (inStr(1,CMDArry(i),"pass ")=1) Then
         Log("pass xxxx")
         else 
         Log(CMDArry(i)) 
         end if
         
         i=i+1 
    else
    Winsock.Close
    bConnected=false
    bEndWork=true
    Log("end commands") 
    end if 
 end if   
End Sub

'------------------------------'
Sub DataProcessor () 

  if (inStr(1,str,"+OK")<>1)Then  
  	   
  	            if (inStr(1,SCommand,"pass ")=1) Then ' ошибка авторизации'
  	            Log("Выход из сеанса связи и запрос пароля.")
  	            Winsock.SendData "quit"  	            
  	            Winsock.Close
  	            bEndWork=true
  	            bConnected=false
  	            GetPassword
  	            exit sub    	       
  	            else 
  	                if (bShowErr)	Then
  	                MSAgentInfo "POP3_Error: " & str
  	                End if
  	            End If	    
	    
	                
        Winsock.Close
        bConnected=false
        bEndWork=true
        exit sub
        
  else
      if (SCommand="stat"&vbCrLf )Then
        dim tmp       
            tmp=mid(str,4,Len(str)-4)        
            tmp=mid(tmp,1,Instr(1,str," ")-1)
            if CInt(tmp>0) then ' сообщим пользователю только если сообщений больше 0'
                MSAgentInfo( "У Вас: "&tmp& " "&Rus(tmp) &" в почтовом ящике: "&Replace(CMDArry(3),"user ","") )
            end if   
        end if    
  end if
    
  
  End Sub

'------------------------------'
Sub MSAgentInfo (sMsg)

Dim strCharacter      ' Наименование используемого персонажа Microsoft Agent'
strCharacter = "merlin"

Set objMicrosoftAgent = CreateObject("Agent.Control.1")
objMicrosoftAgent.Connected = True

objMicrosoftAgent.Characters.Load strCharacter, strCharacter & ".acs"
Set objCharacter = objMicrosoftAgent.Characters(strCharacter)

With objCharacter
    .Top = 200
    .Left = 100
    .LanguageID = &h409
    .Show
    'Здороваемся с пользователем.'
    .Play "Greet"
    .Play "RestPose"
    .Think sMsg
    'Завершаем чтение информации'
    .Play "ReadReturn"
    'Прощаемся с пользователем.'
    .Play "Wave"
End With

' Синхронизируем анимацию со скриптом и завершаемся.'
Set objCharacterRequest = objCharacter.Hide

Do Until objCharacterRequest.Status = 0 ' Complete = 0'
    Wscript.Sleep 100
Loop
Set objCharacter = Nothing

objMicrosoftAgent.Characters.Unload strCharacter
End sub

'------------------------------'
Function Rus(Col)
Dim DigitalControl	
Col=Trim(Col)
if (Len(Col)>1) then
if (CInt(Mid(Col,Len(Col)-1,1))=1) then
						Rus="сообщений"	
						Exit Function
end if
end if 
DigitalControl=CInt(Mid(Col,Len(Col),1))
Select Case DigitalControl
					Case 1
						Rus="сообщение"	
						Exit Function
					Case 2,3,4
						Rus="сообщения"	
						Exit Function
					Case 0,5,6,7,8,9
						Rus="сообщений"	
						Exit Function
				End Select	
end Function

Этот скрипт обсуждался на форуме
http://forum.script-coding.com/viewtopic.php?id=3916

Attachments:
FileDescriptionFile sizeLast modified
Download this file (pop3_client.zip)pop3_client.zip 3 kB2011-01-10 17:38

Add comment