[решено] Определение IP и запись в файл

[ul9]

Самое странное, что 32 строка вообще пустая

...
29 SetTable strTable, objConnection
30
31 strIP = GetIP()
32
33 With objRecordset
...

[ul9]

А можно сделать, чтобы вся строка с 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]

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», сторонних библиотек и т.п.

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

так как не всегда полезно перезаписывать буфер, мало ли что там может быть »
Используйте сторонний менеджер буфера обмена. Я, например, использую CLCL (http://www.nakka.com/soft/clcl/index_eng.html). Для простого текста сгодится и кэш буфера обмена, предоставляемый PuntoSwitcher (если Вы его используете).

[ul9]

Сработал зелёный вариант, но постоянно выскакивает
http://s2.ipicture.ru/uploads/20130109/CqQ35w1E.png

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

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

[Iska]

Сработал зелёный вариант, но постоянно выскакивает »
Можно. Понижением безопасности IE. Потому крайне не рекомендую этого делать.

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

[ul9]

Я включила вот этот пункт
http://s2.ipicture.ru/uploads/20130109/EErDPLpr.png

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

[Iska]

Я включила вот этот пункт »
Помогло?

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

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

[ul9]

Помогло? »
Помогло. Спасибо.

[registeruser1]

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

[Iska]

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]

Iska, спасибо, но там ошибка какая-то -


http://s48.radikal.ru/i120/1308/ee/f2975bd892a2.jpg

[Iska]

registeruser1, сожалею, но ошибка на Вашей стороне:
Option Explicit

Dim objRegExp

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

WScript.Quit 0

IRegExp2


Попробуйте рецепты:
Службы - [решено] Проблема с Jscript на Win7. (http://forum.oszone.net/thread-190702.html)
Службы - Не удаётся найти исполняющего ядра VBScript (http://forum.oszone.net/thread-171405.html)

[registeruser1]

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

[Iska]

Да, но код из 8-го поста ведь работает.! »
Вы видите в коде из поста #8 (http://forum.oszone.net/post-1867971.html#post1867971) создание объекта «VBScript.RegExp»? Я — нет.

(у меня ХР)... »
У меня — тоже.

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

[pva]

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]

pva, отлично работает, а можно без всяких окон выскакивающих.?

[pva]

wscript //B ping.js

или

сscript //B ping.js

[registeruser1]

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

[Iska]

Хоть в \Пуск\Выполнить (только с полным путём до скрипта), хоть в пакетный файл.

[pva]

registeruser1, а есть познания в командной оболочке windows? (консоль, рабочая папка, полный путь к файлу, системная папка, пакетный файл) или нужна подробная инструкция?