Компьютерный форум OSzone.net  

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)
-   Программирование и базы данных (http://forum.oszone.net/forumdisplay.php?f=21)
-   -   [решено] Определение IP и запись в файл (http://forum.oszone.net/showthread.php?t=228864)

aggressor_ 26-02-2012 23:37 1867289
Определение IP и запись в файл
 
Здравствуйте!
Выбрал cmd/bat, но это особой роли не играет, подойдёт любой способ.
Нужно записывать ip адрес в файл..
Если возможно, проверять на совпадения с предыдущими подключениями и при совпадении как-то демонстрировать это, будь то звук или табличка какая.
Смысл в том, чтобы каждый раз не заходить на 2ip, копировать адрес и проверять на совпадение вручную, а как-то автоматизировать этот процесс.

Iska 27-02-2012 08:00 1867418
aggressor_, выбирайте любой способ: CMD/WSH/HTA/JS/VBS: Универсальный способ определения внешнего IP и др..

Насчёт совпадений при записи в файл: поясните вид такого файла, суть его и смысл.

aggressor_ 27-02-2012 08:55 1867443
По вашей ссылке не совсем понял как это применить..

Вид очень простой.
Например:
118.151.161.70
122.221.141.20
и т.д. в столбец
Суть и смысл предупреждений в том, чтобы избежать подключения по одному и тому же ip. К слову, у меня он динамический.

Iska 27-02-2012 10:11 1867470
Цитата:
Цитата aggressor_
Суть и смысл предупреждений в том, чтобы избежать подключения по одному и тому же ip. »
Ещё подробнее, пожалуйста.

aggressor_ 27-02-2012 20:34 1867873
Объясняю:
Подключился я к интернету и получил ip 118.151.161.70. При следующем подключении новый ip. В случае, если при очередном подключении повторяется ip из списка предыдущих (например опять 118.151.161.70), появляется какое-нибудь предупреждение.
Принцип работы прост. Я запускаю батник, он пишет ip в файл и проверяет на совпадение, при совпадении как-то оповещает.

Iska 27-02-2012 21:59 1867922
Цитата:
Цитата aggressor_
В случае, если при очередном подключении повторяется ip из списка »
1. У Вас есть факты, подтверждающие такую ситуацию? Или мы теоретизируем?
2. Какова «глубина» списка? То есть: как и когда мы будем его обнулять?

Цитата:
Цитата aggressor_
появляется какое-нибудь предупреждение. »
А затем?

aggressor_ 27-02-2012 22:06 1867927
Цитата:
Цитата Iska
У Вас есть факты, подтверждающие такую ситуацию? Или мы теоретизируем? »
Вполне конкретная ситуация.
Цитата:
Цитата Iska
2. Какова «глубина» списка? То есть: как и когда мы будем его обнулять? »
Обнулять его нет необходимости. Если потребуется, я сам вручную почищу файл.
Цитата:
Цитата Iska
А затем? »
На предупреждении действия батника заканчиваются (перезагрузка модема и прочее проделаю сам).

Iska 27-02-2012 23:01 1867971
aggressor_, ясно. Пробуйте, скрипт WSH, не требующий сторонних средств:
Код:
Option Explicit

Const ForAppending = 8
Const strPreviousIPList = "PreviousIPList.txt"

Dim strIP
Dim boolIPExists


With WScript.CreateObject("Microsoft.XMLHTTP")
        .open "GET", "http://ifconfig.me/ip", False
        .send
       
        strIP = Replace(.responseText, vbLf, "")
End With

boolIPExists = False

With WScript.CreateObject("Scripting.FileSystemObject")
        If .FileExists(strPreviousIPList) Then
                With .OpenTextFile(strPreviousIPList)
                        Do Until .AtEndOfStream
                                If .ReadLine() = strIP Then
                                        boolIPExists = True
                                       
                                        Exit Do
                                End If
                        Loop
                       
                        .Close
                End With
        End If
       
        If boolIPExists Then
                MsgBox "IP exists", vbOKOnly + vbExclamation, "IP exists"
        Else
                With .OpenTextFile(strPreviousIPList, ForAppending, True)
                        .WriteLine strIP
                       
                        .Close
                End With
               
                MsgBox "IP [" & strIP & "] append", vbOKOnly + vbInformation, "IP append"
        End If
End With

WScript.Quit 0

aggressor_ 28-02-2012 00:37 1868031
Большое спасибо, всё работает.
Не могли бы вы немного изменить скрипт. Т.е. чтобы при добавлении ip в список, писало бы что-то вроде "Ip добавлен". Просто программа работает с небольшой задержкой и приходится открывать txt и смотреть сработал ли скрипт.

Iska 28-02-2012 00:52 1868040
Цитата:
Цитата aggressor_
чтобы при добавлении ip в список, писало бы что-то вроде "Ip добавлен". »
Добавил:
Код:
                MsgBox "IP [" & strIP & "] append", vbOKOnly + vbInformation, "IP append"
в код поста #8.

aggressor_ 28-02-2012 01:01 1868047
Спасибо!

aggressor_ 28-02-2012 06:10 1868102
Я немного изменил MsgBox и получилось следующее
Код:
If boolIPExists Then
                MsgBox "IP [" & strIP & "] уже существует!"& Chr(13) & "Последний добавленный IP [last ip]", vbOKOnly + vbExclamation, "Такой IP уже существует!"
        Else
Хотел бы узнать, возможно ли вывести на месте last ip последний добавленный Ip в текстовый файл?
И ещё вопрос, правильно использовать для переноса строки & Chr(13) & или же нужно & Chr(10) & или это вообще не принципиально?

Iska 28-02-2012 08:52 1868151
Цитата:
Цитата aggressor_
Хотел бы узнать, возможно ли вывести на месте last ip последний добавленный Ip в текстовый файл? »
Возможно, но надо поменять логику работы скрипта, чтобы происходило чтение всего текстового файла.

Потому я повторюсь: какова будет планируемая «глубина» списка? Т.е., каков может быть его максимальный размер в строках (это нужно знать для того, какую модель чтения выбрать для решения озвученной Вами в предыдущем посту задачи — так же, построчно, или весь файл целиком в память)?

Цитата:
Цитата aggressor_
И ещё вопрос, правильно использовать для переноса строки & Chr(13) & или же нужно & Chr(10) & или это вообще не принципиально? »
Обычно манипулируют просто константами «vbCr», «vbLf» и «vbCrLf», в данном случае разница несущественна:
Код:
MsgBox "Мама мыла раму." & vbCrLf & "Рабы не мы," & vbCr & "Мы не рабы." & vbLf & "Hello World!"
а обычно в Windows используют пару символов конца строк «vbCrLf».

aggressor_ 29-02-2012 06:32 1868934
Мне уже неловко Вас просить.

Поработав день со скриптом, хотелось бы внести некоторые изменения.

При повторении ip хотелось бы видеть MsgBox следующего типа:
Данный ip [111.11.11.11] уже был добавлен в список [01.01.2011 - 18ч:30мин]
Последний добавленный ip [222.222.22.22] [21.02.2012 - 15ч:45мин]

При внесении нового ip:
IP [333.33.33.33] добавлен в список
Последний добавленный ip [222.222.22.22] [21.02.2012 - 15ч:45мин]

Список ip в txt файле тоже хотелось бы немного видоизменить. Рядом с Ip проставлять дату и время, напр
222.222.22.22 [21.02.2012 - 15ч:45мин]

Был бы Вам очень благодарен, если бы Вы смогли это реализовать...
Цитата:
Цитата Iska
какова будет планируемая «глубина» списка? Т.е., каков может быть его максимальный размер в строках (это нужно знать для того, какую модель чтения выбрать для решения озвученной Вами в предыдущем посту задачи — так же, построчно, или весь файл целиком в память)? »
Максимальный размер не ограничен, хоть 1000, хоть 5000 строк. При необходимости, я просто перемещу txt файл и всё пойдёт заново

Iska 29-02-2012 10:02 1869013
Цитата:
Цитата aggressor_
Максимальный размер не ограничен, хоть 1000, хоть 5000 строк. При необходимости, я просто перемещу txt файл и всё пойдёт заново »
Спасибо, ясно.

Примерно так:
Код:
Option Explicit

Const adOpenStatic    = 3
Const adLockOptimistic = 3
Const adCmdText        = 1

Dim objConnection
Dim objRecordset

Dim strPath2DB
Dim strTable

Dim strIP
Dim strLastIP
Dim strPreviousIPs


strPath2DB        = WScript.CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName) & "\"
strTable          = Replace("PreviousIPList.txt", ".", "#")

Set objConnection  = WScript.CreateObject("ADODB.Connection")
Set objRecordSet  = WScript.CreateObject("ADODB.Recordset")

objConnection.Open _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & strPath2DB & ";" & _
        "Extended Properties=""text;HDR=YES;FMT=CSVDelimited"""

SetTable strTable, objConnection

strIP = GetIP()

With objRecordset
        .Open "SELECT TOP 1 * FROM " & strTable & " ORDER BY DateTime DESC", _
                objConnection, adOpenStatic, adLockOptimistic, adCmdText
               
        If .RecordCount > 0 Then
                strLastIP = .Fields.Item("DateTime").Value & vbTab & .Fields.Item("IP").Value
        Else
                strLastIP = "[Отсутствует]"
        End If
       
        .Close
       
        .Open "SELECT * FROM " & strTable & " WHERE IP = '" & strIP & "'", _
                objConnection, adOpenStatic, adLockOptimistic, adCmdText
       
        If .RecordCount > 0 Then
                strPreviousIPs = ""
               
                Do Until .EOF
                        strPreviousIPs = strPreviousIPs & .Fields.Item("DateTime").Value & vbTab & .Fields.Item("IP").Value & vbCrLf
                       
                        .MoveNext
                Loop
               
                MsgBox "Данный IP адрес [" & strIP & "] уже был ранее добавлен в список:" & vbCrLf & strPreviousIPs & vbCrLf & _
                        "Последний добавленный IP адрес:" & vbCrLf & strLastIP, vbOKOnly + vbExclamation, "IP адрес [" & strIP & "] уже существует"
        Else
                objRecordset.AddNew Array("DateTime", "IP"), Array(Now(), strIP)
               
                MsgBox "IP адрес [" & strIP & "] добавлен в список." & vbCrLf & vbCrLf & _
                        "Последний добавленный IP адрес:" & vbCrLf & strLastIP, vbOKOnly + vbExclamation, "IP адрес [" & strIP & "] добавлен"
        End If
       
        .Close
End With

objConnection.Close

Set objRecordset  = Nothing
Set objConnection = Nothing

WScript.Quit 0
'=============================================================================

'=============================================================================
Function GetIP()
        With WScript.CreateObject("Microsoft.XMLHTTP")
                .open "GET", "http://ifconfig.me/ip", False
                .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
                .send
               
                GetIP = Replace(.responseText, vbLf, "")
        End With
End Function
'=============================================================================

'=============================================================================
Sub SetTable(strTable, objConnection)
        Const adDate  = 7
        Const adWChar = 130
       
        Dim boolTableExists
       
        Dim objCatalog
        Dim objTable
       
       
        boolTableExists = False
       
        Set objCatalog = WScript.CreateObject("ADOX.Catalog")
        Set objCatalog.ActiveConnection = objConnection
       
        For Each objTable In objCatalog.Tables
                If objTable.Name = strTable Then
                        boolTableExists = True
                       
                        Exit For
                End If
        Next
       
        If Not boolTableExists Then
                Set objTable = WScript.CreateObject("ADOX.Table")
               
                objTable.Name = strTable
               
                objTable.Columns.Append "DateTime", adDate
                objTable.Columns.Append "IP", adWChar
               
                objCatalog.Tables.Append objTable
        End If
       
        Set objTable  = Nothing
        Set objCatalog = Nothing
End Sub
'=============================================================================

aggressor_ 29-02-2012 10:25 1869026
Большое спасибо!!!
Всё отлично работает!

ul9 01-01-2013 05:01 2056887
Iska, подскажите пожалуйста, а как запустить этот vbs на windows 7 x64? Постоянно выскакивает ошибка...

Iska 01-01-2013 17:54 2057065
Цитата:
Цитата ul9
Постоянно выскакивает ошибка... »
ul9, в диалоговом окне с сообщением об ошибке нажмите «Ctrl-C». Вставьте полученный текст сообщения об ошибке из буфера обмена сюда, обрамив его тэгом [code].

ul9 01-01-2013 20:09 2057124
Перегнала скрипт в ехе и всё заработало, чудеса.
А ошибка вот такая была
Код:
---------------------------
Windows Script Host
---------------------------
Сценарий:        test.vbs
Строка:        32
Символ:        1
Ошибка:        Не удается найти указанный поставщик. Вероятно, он установлен неправильно.
Код:        800A0E7A
Источник:        ADODB.Connection

---------------------------

Iska 02-01-2013 02:49 2057322
Цитата:
Цитата ul9
Перегнала скрипт в ехе и всё заработало, чудеса. »
Весьма странно.

Цитата:
Цитата ul9
А ошибка вот такая была »
Не представляю, в чём может быть дело. Составляющие MDAC той или иной версий входят в комплект поставки ОС уже очень давно.

ul9 02-01-2013 03:57 2057333
Самое странное, что 32 строка вообще пустая
Код:
...
29  SetTable strTable, objConnection
30
31  strIP = GetIP()
32 
33  With objRecordset
...

ul9 08-01-2013 19:59 2062003
А можно сделать, чтобы вся строка с ip и датой помимо записи в файл ещё и в буфер обмена копировалась?
Сейчас я делаю так:
1. Запускаю скрипт
2. Открываю PreviousIPList.txt
3. И копирую последнюю запись, она имеет вот такой вид
"171.122.140.127";29.12.2012 20:42:22

Так вот, хотелось бы, чтобы эта строка копировалась в буфер или на выскакивающем msgBox была кнопка скопировать, так как не всегда полезно перезаписывать буфер, мало ли что там может быть :)

Вот код
читать дальше »
Код:
Option Explicit

Const adOpenStatic    = 3
Const adLockOptimistic = 3
Const adCmdText        = 1

Dim objConnection
Dim objRecordset

Dim strPath2DB
Dim strTable

Dim strIP
Dim strLastIP
Dim strPreviousIPs


strPath2DB        = WScript.CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName) & "\"
strTable          = Replace("PreviousIPList.txt", ".", "#")

Set objConnection  = WScript.CreateObject("ADODB.Connection")
Set objRecordSet  = WScript.CreateObject("ADODB.Recordset")

objConnection.Open _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & strPath2DB & ";" & _
        "Extended Properties=""text;HDR=YES;FMT=CSVDelimited"""

SetTable strTable, objConnection

strIP = GetIP()

With objRecordset
        .Open "SELECT TOP 1 * FROM " & strTable & " ORDER BY DateTime DESC", _
                objConnection, adOpenStatic, adLockOptimistic, adCmdText
               
        If .RecordCount > 0 Then
                strLastIP = .Fields.Item("IP").Value & vbTab & .Fields.Item("DateTime").Value
        Else
                strLastIP = "[Отсутствует]"
        End If
       
        .Close
       
        .Open "SELECT * FROM " & strTable & " WHERE IP = '" & strIP & "'", _
                objConnection, adOpenStatic, adLockOptimistic, adCmdText
       
        If .RecordCount > 0 Then
                strPreviousIPs = ""
               
                Do Until .EOF
                        strPreviousIPs = strPreviousIPs & .Fields.Item("IP").Value & vbTab & .Fields.Item("DateTime").Value & vbCrLf
                       
                        .MoveNext
                Loop
               
                MsgBox "Данный IP адрес уже был ранее добавлен в список:" & vbCrLf & strPreviousIPs & vbCrLf & _
                        "Последний добавленный IP адрес:" & vbCrLf & strLastIP, vbOKOnly + vbExclamation, "IP адрес [" & strIP & "] уже существует"
        Else
                objRecordset.AddNew Array("DateTime", "IP"), Array(Now(), strIP)
               
                MsgBox "IP адрес [" & strIP & "] добавлен в список." & vbCrLf & vbCrLf & _
                        "Последний добавленный IP адрес:" & vbCrLf & strLastIP, vbOKOnly + VbInformation, "IP адрес [" & strIP & "] добавлен"
        End If
       
        .Close
End With

objConnection.Close

Set objRecordset  = Nothing
Set objConnection = Nothing

WScript.Quit 0
'=============================================================================

'=============================================================================
Function GetIP()
        With WScript.CreateObject("Microsoft.XMLHTTP")
                .open "GET", "http://ifconfig.me/ip", False
                .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
                .send
               
                GetIP = Replace(.responseText, vbLf, "")
        End With
End Function
'=============================================================================

'=============================================================================
Sub SetTable(strTable, objConnection)
        Const adDate  = 7
        Const adWChar = 130
       
        Dim boolTableExists
       
        Dim objCatalog
        Dim objTable
       
       
        boolTableExists = False
       
        Set objCatalog = WScript.CreateObject("ADOX.Catalog")
        Set objCatalog.ActiveConnection = objConnection
       
        For Each objTable In objCatalog.Tables
                If objTable.Name = strTable Then
                        boolTableExists = True
                       
                        Exit For
                End If
        Next
       
        If Not boolTableExists Then
                Set objTable = WScript.CreateObject("ADOX.Table")
               
                objTable.Name = strTable
               
                objTable.Columns.Append "IP", adWChar
                objTable.Columns.Append "DateTime", adDate
                               
                objCatalog.Tables.Append objTable
        End If
       
        Set objTable  = Nothing
        Set objCatalog = Nothing
End Sub
'=============================================================================

Iska 09-01-2013 08:16 2062246
ul9, стало быть, заработало?

Цитата:
Цитата ul9
Так вот, хотелось бы, чтобы эта строка копировалась в буфер »
Пробуйте:
читать дальше »
Код:
Option Explicit

Const adOpenStatic    = 3
Const adLockOptimistic = 3
Const adCmdText        = 1

Dim objConnection
Dim objRecordset

Dim strPath2DB
Dim strTable

Dim strIP
Dim strLastIP
Dim strPreviousIPs


strPath2DB        = WScript.CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName) & "\"
strTable          = Replace("PreviousIPList.txt", ".", "#")

Set objConnection  = WScript.CreateObject("ADODB.Connection")
Set objRecordSet  = WScript.CreateObject("ADODB.Recordset")

objConnection.Open _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & strPath2DB & ";" & _
        "Extended Properties=""text;HDR=YES;FMT=CSVDelimited"""

SetTable strTable, objConnection

strIP = GetIP()

With objRecordset
        .Open "SELECT TOP 1 * FROM " & strTable & " ORDER BY DateTime DESC", _
                objConnection, adOpenStatic, adLockOptimistic, adCmdText
               
        If .RecordCount > 0 Then
                strLastIP = .Fields.Item("IP").Value & vbTab & .Fields.Item("DateTime").Value
        Else
                strLastIP = "[Отсутствует]"
        End If
       
        .Close
       
        .Open "SELECT * FROM " & strTable & " WHERE IP = '" & strIP & "'", _
                objConnection, adOpenStatic, adLockOptimistic, adCmdText
       
        If .RecordCount > 0 Then
                strPreviousIPs = ""
               
                Do Until .EOF
                        strPreviousIPs = strPreviousIPs & .Fields.Item("IP").Value & vbTab & .Fields.Item("DateTime").Value & vbCrLf
                       
                        .MoveNext
                Loop
               
                MsgBox "Данный IP адрес уже был ранее добавлен в список:" & vbCrLf & strPreviousIPs & vbCrLf & _
                        "Последний добавленный IP адрес:" & vbCrLf & strLastIP, vbOKOnly + vbExclamation, "IP адрес [" & strIP & "] уже существует"
        Else
                objRecordset.AddNew Array("DateTime", "IP"), Array(Now(), strIP)
               
                MsgBox "IP адрес [" & strIP & "] добавлен в список." & vbCrLf & vbCrLf & _
                        "Последний добавленный IP адрес:" & vbCrLf & strLastIP, vbOKOnly + VbInformation, "IP адрес [" & strIP & "] добавлен"
               
                WScript.CreateObject("HTMLFile").parentWindow.clipboardData.setData "text", """" & strIP & """;" & Now()
               
                'With WScript.CreateObject("InternetExplorer.Application")
                '        .Navigate "about:blank"
                '        .document.parentWindow.clipboardData.setData "text", """" & strIP & """;" & Now()
                '       
                '        .Quit
                'End With
        End If
       
        .Close
End With

objConnection.Close

Set objRecordset  = Nothing
Set objConnection = Nothing

WScript.Quit 0
'=============================================================================

'=============================================================================
Function GetIP()
        With WScript.CreateObject("Microsoft.XMLHTTP")
                .open "GET", "http://ifconfig.me/ip", False
                .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
                .send
               
                GetIP = Replace(.responseText, vbLf, "")
        End With
End Function
'=============================================================================

'=============================================================================
Sub SetTable(strTable, objConnection)
        Const adDate  = 7
        Const adWChar = 130
       
        Dim boolTableExists
       
        Dim objCatalog
        Dim objTable
       
       
        boolTableExists = False
       
        Set objCatalog = WScript.CreateObject("ADOX.Catalog")
        Set objCatalog.ActiveConnection = objConnection
       
        For Each objTable In objCatalog.Tables
                If objTable.Name = strTable Then
                        boolTableExists = True
                       
                        Exit For
                End If
        Next
       
        If Not boolTableExists Then
                Set objTable = WScript.CreateObject("ADOX.Table")
               
                objTable.Name = strTable
               
                objTable.Columns.Append "IP", adWChar
                objTable.Columns.Append "DateTime", adDate
                               
                objCatalog.Tables.Append objTable
        End If
       
        Set objTable  = Nothing
        Set objCatalog = Nothing
End Sub
'=============================================================================

Если не сработает этот код — закомментируйте его и раскомментируйте этот код. Если не сработает и он — тогда только использовать обходные пути: с вызовом «clip.exe», сторонних библиотек и т.п.

Цитата:
Цитата ul9
или на выскакивающем msgBox была кнопка скопировать, »
Она есть на любом MessageBox'е. Называется — «Ctrl-C». Правда попадает туда всё содержимое.

Цитата:
Цитата ul9
так как не всегда полезно перезаписывать буфер, мало ли что там может быть »
Используйте сторонний менеджер буфера обмена. Я, например, использую CLCL. Для простого текста сгодится и кэш буфера обмена, предоставляемый PuntoSwitcher (если Вы его используете).

ul9 09-01-2013 16:16 2062561
Сработал зелёный вариант, но постоянно выскакивает


Можно как-нибудь "подавить" это окошко?

Цитата:
Цитата Iska
ul9, стало быть, заработало? »
Я его в exe перегнала и он заработал. Но всё равно вернулась на xp, так как для работы использую много разных батников, а переписывать под windows7 слишком затратно.

Iska 09-01-2013 17:25 2062614
Цитата:
Цитата ul9
Сработал зелёный вариант, но постоянно выскакивает »
Можно. Понижением безопасности IE. Потому крайне не рекомендую этого делать.

Можно ещё попробовать в *.hta сделать, там настройки безопасности изначально пониже.

ul9 09-01-2013 17:35 2062620
Я включила вот этот пункт


Это ведь не критично? Учитывая, что IE я не использую как браузер вообще.

Iska 09-01-2013 17:41 2062626
Цитата:
Цитата ul9
Я включила вот этот пункт »
Помогло?

Цитата:
Цитата ul9
IE я не использую как браузер вообще. »
Вы — нет. А какие-то приложения могут и использовать.

Впрочем, смотрите сами.

ul9 09-01-2013 18:48 2062682
Цитата:
Цитата Iska
Помогло? »
Помогло. Спасибо.

registeruser1 03-08-2013 20:21 2195857
Ребят, я в коде из 8-го поста хочу поменять адрес который определяет ip.
Тот работает долго уж. Ставлю в место него - http://checkip.dyndns.com.
С ним все шустро 1-2сек и все. Скрипт записывает еще кучу ненужной информации HTML-кода.
Помогите от этого мусора избавиться...

Iska 04-08-2013 00:56 2196067
registeruser1, ну, насчёт кучи — это Вы загнули:
Цитата:
<html><head><title>Current IP Check</title></head><body>Current IP Address: XXX.XXX.XXX.XXX</body></html>


Пробуйте:
читать дальше »
Код:
Option Explicit

Const ForAppending = 8
Const strPreviousIPList = "PreviousIPList.txt"

Dim strIP
Dim boolIPExists

Dim objRegExp


Set objRegExp = WScript.CreateObject("VBScript.RegExp")

With objRegExp
        .IgnoreCase = True
        .Pattern    = "<html><head><title>Current IP Check</title></head><body>Current IP Address: (\d+\.\d+\.\d+\.\d+)</body></html>"
End With

With WScript.CreateObject("Microsoft.XMLHTTP")
        .open "GET", "http://checkip.dyndns.com/", False
        .send
       
        strIP = objRegExp.Execute(.responseText)(0).Submatches(0)
End With

Set objRegExp = Nothing

boolIPExists = False

With WScript.CreateObject("Scripting.FileSystemObject")
        If .FileExists(strPreviousIPList) Then
                With .OpenTextFile(strPreviousIPList)
                        Do Until .AtEndOfStream
                                If .ReadLine() = strIP Then
                                        boolIPExists = True
                                       
                                        Exit Do
                                End If
                        Loop
                       
                        .Close
                End With
        End If
       
        If boolIPExists Then
                MsgBox "IP exists", vbOKOnly + vbExclamation, "IP exists"
        Else
                With .OpenTextFile(strPreviousIPList, ForAppending, True)
                        .WriteLine strIP
                       
                        .Close
                End With
               
                MsgBox "IP [" & strIP & "] append", vbOKOnly + vbInformation, "IP append"
        End If
End With

WScript.Quit 0

registeruser1 04-08-2013 06:54 2196135
Iska, спасибо, но там ошибка какая-то -

Iska 04-08-2013 07:58 2196141
registeruser1, сожалею, но ошибка на Вашей стороне:
Код:
Option Explicit

Dim objRegExp

Set objRegExp = WScript.CreateObject("VBScript.RegExp")
WScript.Echo TypeName(objRegExp)

WScript.Quit 0
Цитата:
Код:
IRegExp2
Попробуйте рецепты:
Службы - [решено] Проблема с Jscript на Win7.
Службы - Не удаётся найти исполняющего ядра VBScript

registeruser1 04-08-2013 08:01 2196143
Да, но код из 8-го поста ведь работает.! (у меня ХР)...

Iska 04-08-2013 09:21 2196156
Цитата:
Цитата registeruser1
Да, но код из 8-го поста ведь работает.! »
Вы видите в коде из поста #8 создание объекта «VBScript.RegExp»? Я — нет.

Цитата:
Цитата registeruser1
(у меня ХР)... »
У меня — тоже.

Ещё раз повторю: воспользуйтесь рецептами по приведённым ссылкам, перерегистрируйте библиотеки.

pva 04-08-2013 22:54 2196438
Windows 7 Домашняя базовая, sp1 заработала в таком варианте:
ping.js:
Код:
var
  fso = new ActiveXObject("Scripting.FileSystemObject"),
  get_ip = new ActiveXObject("WinHttp.WinHttpRequest.5.1"),
  got_ip, str_ip, last_time_this_ip,
  last_time_ip={};

try {
  eval(fso.OpenTextFile("last_ip.txt", 1).ReadAll());
} catch(e) {
  WScript.Echo(e.message);
  fso.CreateTextFile("last_ip.txt", true);
}

get_ip.Open("GET", "http://ifconfig.me/ip", false);
get_ip.Send();
got_ip = /[\d.]+/.exec(String(get_ip.responseText));
//got_ip=["192.168.0.1"];

if (got_ip) {
  str_ip = got_ip[0];
  last_time_this_ip = last_time_ip[str_ip];
  if (last_time_this_ip) {
    WScript.Echo("Last time "+str_ip+" was at "+last_time_this_ip);
  }
  fso.OpenTextFile("last_ip.txt", 8).WriteLine("last_time_ip[\""+str_ip+"\"]=\""+new Date()+"\";");
}
Предупреждаю: не самый экономный для памяти вариант. Лучше сделать гибрид с предложенным Iska.

registeruser1 04-08-2013 23:10 2196455
pva, отлично работает, а можно без всяких окон выскакивающих.?

pva 04-08-2013 23:16 2196463
Код:
wscript //B ping.js
или
Код:
сscript //B ping.js

registeruser1 05-08-2013 01:11 2196503
Честно ничего не понял из последнего поста, я не разбираюсь в скриптах же ))...
Можно по-подробней, куда это?

Iska 05-08-2013 01:49 2196509
Хоть в \Пуск\Выполнить (только с полным путём до скрипта), хоть в пакетный файл.

pva 05-08-2013 09:49 2196557
registeruser1, а есть познания в командной оболочке windows? (консоль, рабочая папка, полный путь к файлу, системная папка, пакетный файл) или нужна подробная инструкция?

Sta1917 15-11-2017 00:06 2777625
Здравствуйте, пытаюсь запустить на Win 10 скрипт из поста #15. выдает
Код:
Сценарий:        D:\Cheсk_IP.vbs
Строка:        24
Символ:        1
Ошибка:        Не удается найти указанный поставщик. Вероятно, он установлен неправильно.
Код:        800A0E7A
Источник:        ADODB.Connection
В чем может быть проблема?
В строке 24 вроде все нормально:
https://3.downloader.disk.yandex.ru/...282d39e3212b8e

Iska 15-11-2017 00:54 2777627
Цитата:
Цитата Sta1917
В чем может быть проблема? »
В том же, о чём написано зараз после поста #15 — в отсутствии библиотеки. Если Ваша ОС — x64, можете попробовать исполнить скрипт под x86-хостом:
Код:
C:\Windows\SysWOW64\wscript.exe "Путь\Скрипт.vbs"
или:
Код:
C:\Windows\SysWOW64\cscript.exe //nologo "Путь\Скрипт.vbs"

Sta1917 15-11-2017 01:57 2777631
При запуске через wscript выдает:
Код:
Сценарий:        D:\Check_IP.vbs
Строка:        82
Символ:        3
Ошибка:        Сбой скачивания указанного ресурса.

Код:        800C0008
Источник:        msxml3.dll
При запуске через cscript открывает диалоговое окно cscript, без возможности вставки чего-либо.
Установка MDAC не помогла.

Iska 15-11-2017 03:14 2777640
Цитата:
Цитата Sta1917
При запуске через wscript выдает:
Код: Выделить весь код
Сценарий: D:\Avito_Tech\Check_IP.vbs
Строка: 82
Символ: 3
Ошибка: Сбой скачивания указанного ресурса. »
А «ручками», в браузере, у Вас доступен адрес http://ifconfig.me/ip?

Цитата:
Цитата Sta1917
При запуске через cscript открывает диалоговое окно cscript, без возможности вставки чего-либо. »
А что Вы там планировали вставлять?!

Цитата:
Цитата Sta1917
Установка MDAC не помогла. »
Помогла или не помогла — не знаю, но ведь уже работает, ошибка в другом месте и по другой причине.

Sta1917 15-11-2017 10:37 2777689
Цитата:
Цитата Iska
А «ручками», в браузере, у Вас доступен адрес http://ifconfig.me/ip? »
Работает, также работает скрипт из поста #8.
Цитата:
Цитата Iska
При запуске через cscript открывает диалоговое окно cscript, без возможности вставки чего-либо. »
А что Вы там планировали вставлять?! »
Вы предложили:
Цитата:
Цитата Iska
C:\Windows\SysWOW64\cscript.exe //nologo "Путь\Скрипт.vbs" »
Вообще после проверки ip нужно запустить приложение (*.exe), если IP нет в списке, если есть сказать какой и когда был добавлен.
p.s.: Компиляция в *.exe ничего недала.

Iska 15-11-2017 11:43 2777704
Цитата:
Цитата Sta1917
также работает скрипт из поста #8. »
Да ну. Единственное отличие #15 от #8 по существу места ошибки — в использовании метода .setRequestHeader.

Цитата:
Цитата Sta1917
p.s.: Компиляция в *.exe ничего недала. »
И не должна была.

Sta1917 15-11-2017 22:32 2777834
При запуске скрипта из поста #8 двойным кликом периодически вываливается
Код:
Сценарий:        D:\Check_IP(8).vbs
Строка:        12
Символ:        2
Ошибка:        Не удается найти указанный ресурс.

Код:        800C0005
Источник:        msxml3.dll
При запуске
Код:
start C:\Windows\SysWOW64\wscript.exe "D:\Check_IP(8).vbs"
все впорядке.

Сделал
Код:
regsvr32 msxml.dll
Теперь при запуске скрипта из поста #15 появляется:
Код:
Сценарий:        D:\Check_IP(15).vbs
Строка:        81
Символ:        2
Ошибка:        Не удается найти указанный ресурс.

Код:        800C0005
Источник:        msxml3.dll
UPD: Теперь вываливается:
Код:
Сценарий:        D:\Check_IP(15).vbs
Строка:        34
Символ:        2
Ошибка:        Отсутствует значение для одного или нескольких требуемых параметров.
Код:        80040E10
Источник:        Microsoft JET Database Engine

cinstaller 07-02-2019 07:47 2856645
Здравствуйте, Iska! Будьте любезны, внесите изменение в данный скрипт из поста №8, что бы в конце IP отображалась дата и время записи, буду вам очень благодарен.
Пример:
118.151.161.70 (07.02.2019 / 07:31)
122.221.141.20 (07.02.2019 / 07:39)
И т.д...

Цитата:
Цитата Iska
Option Explicit
Const ForAppending = 8
Const strPreviousIPList = "PreviousIPList.txt"
Dim strIP
Dim boolIPExists
With WScript.CreateObject("Microsoft.XMLHTTP")
.open "GET", "http://ifconfig.me/ip", False
.send
strIP = Replace(.responseText, vbLf, "")
End With
boolIPExists = False
With WScript.CreateObject("Scripting.FileSystemObject")
If .FileExists(strPreviousIPList) Then
With .OpenTextFile(strPreviousIPList)
Do Until .AtEndOfStream
If .ReadLine() = strIP Then
boolIPExists = True
Exit Do
End If
Loop
.Close
End With
End If
If boolIPExists Then
MsgBox "IP exists", vbOKOnly + vbExclamation, "IP exists"
Else
With .OpenTextFile(strPreviousIPList, ForAppending, True)
.WriteLine strIP
.Close
End With
MsgBox "IP [" & strIP & "] append", vbOKOnly + vbInformation, "IP append"
End If
End With
WScript.Quit 0 »

Iska 07-02-2019 19:18 2856751
Цитата:
Цитата cinstaller
что бы в конце IP отображалась дата и время записи »
«В конце IP» — это где? В файле? Или в сообщении?

cinstaller 07-02-2019 21:38 2856768
Цитата:
Цитата Iska
«В конце IP» — это где? В файле? Или в сообщении? »
Что бы при внесение IP в тхт файл записывалась дата и время в конце адреса в таком формате.
Пример:
118.151.161.70 (07.02.2019 / 07:31)
122.221.141.20 (07.02.2019 / 07:39)

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



Хотелось бы, что бы вместо этой ошибки появлялся MsgBox в котором выводилась информация - ожидаем подключения к интернету.

Iska 11-02-2019 03:14 2857263
cinstaller, пробуйте:
Скрытый текст
Код:
Option Explicit

Const ForAppending = 8
Const strPreviousIPList = "PreviousIPList.txt"

Dim strIP
Dim boolIPExists


With WScript.CreateObject("Microsoft.XMLHTTP")
        .open "GET", "http://ifconfig.me/ip", False
        .send
       
        strIP = Replace(.responseText, vbLf, "")
End With

boolIPExists = False

With WScript.CreateObject("Scripting.FileSystemObject")
        If .FileExists(strPreviousIPList) Then
                With .OpenTextFile(strPreviousIPList)
                        Do Until .AtEndOfStream
                                If Split(.ReadLine())(0) = strIP Then
                                        boolIPExists = True
                                       
                                        Exit Do
                                End If
                        Loop
                       
                        .Close
                End With
        End If
       
        If boolIPExists Then
                MsgBox "IP exists", vbOKOnly + vbExclamation, "IP exists"
        Else
                With .OpenTextFile(strPreviousIPList, ForAppending, True)
                        .WriteLine strIP & " " & DateTimeNowFormat()
                       
                        .Close
                End With
               
                MsgBox "IP [" & strIP & "] append", vbOKOnly + vbInformation, "IP append"
        End If
End With

WScript.Quit 0

Function DateTimeNowFormat()
        Dim dtNow
       
        dtNow = Now()
       
        DateTimeNowFormat = _
                "(" & _
                        DigitPad(Day(dtNow), 2) & "." & DigitPad(Month(dtNow), 2) & "." & DigitPad(Year(dtNow), 4) & _
                        " / " & _
                        DigitPad(Hour(dtNow), 2) & ":" & DigitPad(Minute(dtNow), 2) & _
                ")"
End Function

Function DigitPad(intValue, intZeroCount)
        DigitPad = Right(String(intZeroCount, "0") & CStr(intValue), intZeroCount)
End Function

cinstaller 13-02-2019 22:17 2857855
Цитата:
Цитата Iska
Iska »
Большое вам спасибо!

cinstaller 19-02-2019 19:28 2858828
Здравствуйте, Iska. У вас золотые руки! Мне очень сильно помог ваш скрипт, еще раз большое спасибо! Скажите пожалуйста, как можно реализовать, что бы скрипт узнавал IP адреса через браузер Google Chrome ? Дело в том, что в данном браузере установлено расширение VPN и я хочу перебрать все IP адреса и уникальные занести в ТХТ документ.

Скрытый текст
Код:
Option Explicit

Const ForAppending = 8
Const strPreviousIPList = "PreviousIPList.txt"

Dim strIP
Dim boolIPExists


With WScript.CreateObject("Microsoft.XMLHTTP")
        .open "GET", "http://ifconfig.me/ip", False
        .send
       
        strIP = Replace(.responseText, vbLf, "")
End With

boolIPExists = False

With WScript.CreateObject("Scripting.FileSystemObject")
        If .FileExists(strPreviousIPList) Then
                With .OpenTextFile(strPreviousIPList)
                        Do Until .AtEndOfStream
                                If Split(.ReadLine())(0) = strIP Then
                                        boolIPExists = True
                                       
                                        Exit Do
                                End If
                        Loop
                       
                        .Close
                End With
        End If
       
        If boolIPExists Then
                MsgBox "IP exists", vbOKOnly + vbExclamation, "IP exists"
        Else
                With .OpenTextFile(strPreviousIPList, ForAppending, True)
                        .WriteLine strIP & " " & DateTimeNowFormat()
                       
                        .Close
                End With
               
                MsgBox "IP [" & strIP & "] append", vbOKOnly + vbInformation, "IP append"
        End If
End With

WScript.Quit 0

Function DateTimeNowFormat()
        Dim dtNow
       
        dtNow = Now()
       
        DateTimeNowFormat = _
                "(" & _
                        DigitPad(Day(dtNow), 2) & "." & DigitPad(Month(dtNow), 2) & "." & DigitPad(Year(dtNow), 4) & _
                        " / " & _
                        DigitPad(Hour(dtNow), 2) & ":" & DigitPad(Minute(dtNow), 2) & _
                ")"
End Function

Function DigitPad(intValue, intZeroCount)
        DigitPad = Right(String(intZeroCount, "0") & CStr(intValue), intZeroCount)
End Function


Я не разбираюсь в программирование, но примерно понимаю, что ваш скрипт на данный момент узнает IP адреса таким способом:

Скрытый текст
Код:
With WScript.CreateObject("Microsoft.XMLHTTP")
        .open "GET", "http://ifconfig.me/ip", False
        .send
       
        strIP = Replace(.responseText, vbLf, "")
End With


Но вот вопрос, можно или нельзя реализовать проверку именно через браузер Google Chrome с включенным расширением VPN ?

Iska 19-02-2019 20:25 2858837
Ответ простой — никак. Google Chrome не предоставляет класса Automation.


Время: 22:17.

Время: 22:17.
© OSzone.net 2001-