Скрипты

[Stiratel453]

Нужна помощь. Нужно на сайте по-быстрому набить посещения . Соотвественно нужен какой-нибудь скрипт, который делает автовход-выход, поставить на комп, прийти через 2-3 часа и всё . Мб кто-нибудь знает такой .

Гугл ничего путного не дал

[KotZhilkina]

:CONFIG
SET CONFIG_FILE=%*
IF NOT EXIST "%CONFIG_FILE%" (
   CALL :EXIT Configuration file "%CONFIG_FILE%" was not found
) ELSE (
   FOR /f "eol=# delims== tokens=1,2" %%I IN (%CONFIG_FILE%) DO (
   SET %%I=%%J
   )
)
GOTO :EOF

 

Option Explicit

'On Error Resume Next

Const FONTS = &H14&

Dim objArgs
Set objArgs = WScript.Arguments

If objArgs.Count <> 0 Then

   Dim objShell
   Set objShell = WScript.CreateObject("WScript.Shell")

   Dim objFONTS
   Set objFONTS = CreateObject("Shell.Application").NameSpace(FONTS)

   Dim objFSO
   Set objFSO = CreateObject("Scripting.FileSystemObject")

   Dim strFiles
   strFiles = ""

   Dim strArg
   For Each strArg in objArgs
       Select Case True
           Case objFSO.FileExists(strArg):
               strFiles = strFiles & ";" & strArg
           Case objFSO.FolderExists(strArg):
               Dim objFile
               Dim objFolder
               Set objFolder = objFSO.GetFolder(strArg)
               For Each objFile In objFolder.Files
                   strFiles = strFiles & ";" & objFile.Path
               Next
               Set objFile = Nothing
               Set objFolder = Nothing
           Case Else:
               'file or folder provided as argument does not exist
       End Select
   Next
   Set objArgs = Nothing

   Dim objFileFont
   Dim strFile

   For Each strFile in Split (strFiles, ";")
       If (strFile <> "" And objFSO.FileExists(strFile)) Then
           Set objFileFont = objFSO.GetFile(strFile)
           Select Case UCase(Right(objFileFont.Name, 3))
               Case "OTF", "TTF":
                   If objFSO.FileExists(objShell.ExpandEnvironmentStrings("%WinDir%") & "\Fonts\" & objFileFont.Name) = False Then
                       objFONTS.CopyHere objFileFont.Path
                   Else
                       'font file already already exists in destination folder
                   End If

               Case Else:
                   'file is not an OTF or TTF font file
           End Select
           Set objFileFont = Nothing
       End If
   Next

   Set objFSO = Nothing
   Set objFONTS = Nothing
   Set objShell = Nothing

End If

WScript.Quit

 

Option Explicit

Dim iTotalFilesSaved

iTotalFilesSaved = 0

Const sTempPath = "C:	emp\"

Dim objArgs
Set objArgs = WScript.Arguments

If objArgs.Count <> 0 Then
   'WScript.Echo objArgs.Count
Else
   Dim objFSO
   Set objFSO = CreateObject("Scripting.FileSystemObject")

   Dim objOutlook
   Set objOutlook = CreateObject("Outlook.Application")

   Dim objFolder
   Set objFolder = objOutlook.ActiveExplorer.CurrentFolder

   Dim iMailItems
   iMailItems = objFolder.Items.Count

   'WScript.Echo "Processing folder [" & objFolder.Name & "] with total of [" & iMailItems &"] mail items inside it..."

   Dim iMailItem

   For iMailItem = 1 To iMailItems

       'olMail - 43
    If objFolder.Items.Item(iMailItem).Class = 43 Then
           Dim objMail
	    Set objMail= objFolder.Items.Item(iMailItem)

           With objMail

               Dim sSubject
               Dim sTo
               Dim sCC
               Dim sSentOn
               Dim sLastModificationTime
               Dim sConversationIndex
               Dim sConversationTopic
               Dim sSentOnBehalfOfName
               Dim sSenderEmailAddress
               Dim sReceivedByName

               sSubject = .Subject
               sSentOn = .SentOn
               sLastModificationTime = .LastModificationTime
  			 sConversationIndex = .ConversationIndex
               sConversationTopic = .ConversationTopic

               ' following commented lines require user interaction, because outlook security model denies external access to address book

               'sTo = .To
               'sCC = .CC
               'sSentOnBehalfOfName = .SentOnBehalfOfName
               'sSenderEmailAddress = .SenderEmailAddress
               'sReceivedByName = .ReceivedByName

               'WScript.Echo "Processing item [" & sSubject & "]..."

               With objMail.Attachments
                   Dim iAttachments
                   iAttachments = .Count

                   'WScript.Echo "Attachments number is [" & iAttachments & "]..."

                   If iAttachments > 0 Then

                       Dim iAttachment

                       For iAttachment = 1 To iAttachments

                           Dim sAttachmentFilename
                           sAttachmentFilename = .Item(iAttachment)

                           'sWScript.Echo "Saving attachment [" & sAttachmentFilename & "] to [" & sTempPath & "]..."

                           .Item(iAttachment).SaveAsFile sTempPath &  sAttachmentFilename

                           Dim objFileMetadata
                           Set objFileMetadata = objFSO.CreateTextFile(sTempPath & sAttachmentFilename & ".METADATA.TXT", True)
                               With objFileMetadata
                                   .WriteLine "Metadata for file " & sTempPath & sAttachmentFilename
                                   .WriteLine "Date and time: " & Now
                                   .WriteLine "Outlook folder name: " & objFolder.Name
                                   .WriteLine "Mail Subject: " & sSubject
                                   .WriteLine "Mail Sent On: "  & sSentOn
                                   .WriteLine "Mail Last Modification Time: "  & sLastModificationTime
                                   .WriteLine "Mail ConversationIndex: " & sConversationIndex
                                   .WriteLine "Mail Conversation Topic: "  & sConversationTopic
                                   .WriteLine "Attachment filename: " & sAttachmentFilename
                                   .WriteLine "Attachment: " & iAttachment
                                   .WriteLine "Attachments: " & iAttachments
                                   .WriteLine "Mail item: " & iMailItem
                                   .WriteLine "Mail items: " & iMailItems
                               End With
                           Set objFileMetadata = Nothing

                           iTotalFilesSaved = iTotalFilesSaved + 1

                       Next
                   End If
               End With

           End With

           Set objMail = Nothing

    End If
   Next
   WScript.Echo "Total files saved from " & objFolder  &": " & iTotalFilesSaved

   Set objFolder = Nothing
   Set objOutlook = Nothing
   Set objFSO = Nothing
End If

Set objArgs = Nothing

Dim objShell
Set objShell = CreateObject("Wscript.Shell")
objShell.Run "explorer.exe /e," & sTempPath
Set objShell = Nothing

WScript.Quit

[KotZhilkina]

;*******************************************************************************
; Process the boot phase of the MC3190 - CE 6.0
;*******************************************************************************
SetVar Int True = 1
SetVar Int False = 0
SetVar String SubNet = ""

DEBUGON "\application\startup.dbg" 1000000 0xffffff

If GetBootCount() == 1                            ; ColdBoot
   MessageDialog FULLSCREEN SHOW BOLDFONT FONTSIZE36 BKCOLOR(RGB(255,255,255)) TEXTCOLOR(RGB(0,0,0)) "\nInstallation...\n\n\n\nPlease Wait..."
   DISABLEHARDWAREKEYBOARD
EndIf

Kill ("bw.exe")

;*******************************************************************************
; Does the HHT has a valid IP address
;*******************************************************************************
MessageDialog FULLSCREEN SHOW BOLDFONT FONTSIZE36 BKCOLOR(RGB(255,255,255)) TEXTCOLOR(RGB(0,0,0)) "\n\n  Checking IP\n\n\n\nPlease Wait..."

:RetryIpCheck
If CheckIPAddr() == False                        ;if IP check fails then try again
   SLEEP 1000
   Goto RetryIpCheck
EndIf

SetVar String IPAddr = GetIPAddressList()        ;Get the first assigned IP-Address
SetVar Int T1 = Find (IPAddr, ".", 0)
SetVar String IPFirstByte = Mid (IPAddr, 0, T1)

SetVar Int T1 = T1 + 1
SetVar Int T2 = Find (IPAddr, ".", T1)
SetVar Int T2 = T2 - T1
SetVar String IPSecondByte = Mid (IPAddr, T1, T2)

SetVar Int T3 = T1 + T2 + 1
SetVar Int T4 = Find (IPAddr, ".", T3)
SetVar Int T4 = T4 - T3
SetVar String IPThirdByte = Mid (IPAddr, T3, T4)

DelVar T1
DelVar T2
DelVar T3
DelVar T4

SetVar String SubNet = IPFirstByte + "." + IPSecondByte + "." + IPThirdByte

;*******************************************************************************
; Cold or Warm boot?
;*******************************************************************************
If GetBootCount() != 1   ;WarmBoot
   Goto NormalStart
Endif

[Ramil]

золото или теплый ботинок?

[TheDeadSkin]

Знал бы я получше вбс, то такая хуйня пишется за 90 секунд, если тебе не надо логиниться и без проксей.

[rubish]

Знал бы я получше вбс, то такая хуйня пишется за 90 секунд, если тебе не надо логиниться и без проксей.

ты же си шарп знаешь. такая хуйня на шарпе не сложнее пишется

[TheDeadSkin]

У меня для шарпа даже готовая микро-либа есть, туда даёшь урл с постом и параметрами, ловишь хедеры с куками и хтмл-ответ, и всё. Только впадло ._. Нет Особо времени и стабильного инета на ноуте.

[iNaJke]

http://prodota.ru/forum/index.php?showtopic=151194&st=0

[Hed-kun]

http://prodota.ru/forum/index.php?showtopic=151194&st=760#entry9187269

вон человек тебе программку целую написал