Get Local Ip

yerke

Well-Known Member
28.08.2007
392
0
#1
в документе должно сохраняться ip адрес компа в сети
в котором док редактировался
сделал так
1) по примеру, который нашел в инете, сделал программку на дельфи,
который определяет ай пи адрес и записывает его в текстовый файл
2) приатачил програмку в лотус базу
3) при сохранение дока, сливаю эту программку в локальный диск юзера
и запускаю через Shell(Id)
4) пытаюсь прочитать текстовый файл с помощью NotesStream-а

но программка не запускается ни через Shell ни через ShellId
толи не сможет создать текстовый файл

а в ручную запускается и создается файл с ай пи адресом

можете сказать в чем трабла
спасибо заранее
 

Akupaka

А че я?.. О.о
04.10.2007
3 360
2
#2
ну... слов нет... хотел материться, но сдержался :)
зачем велосипед? возьми апишками определи адрес да и все... и не надо гемориться...
тем более, что код у тебя должен быть из того самого примера на делфи...

вот тебе пример, если еще не справился
Код:
Const WS_VERSION_REQD = &H101
Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Const MIN_SOCKETS_REQD = 1
Const SOCKET_ERROR = -1
Const WSADescription_Len = 256
Const WSASYS_Status_Len = 128

Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type

Type WSADATA
wversion As Integer
wHighVersion As Integer
szDescription(0 To WSADescription_Len) As Byte
szSystemStatus(0 To WSASYS_Status_Len) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpszVendorInfo As Long
End Type

Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Declare Function WSAStartup Lib "WSOCK32.DLL" (Byval wVersionRequired As Integer, lpWSAData As WSADATA) As Long
Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

Declare Function gethostname Lib "WSOCK32.DLL" (Byval hostname$, Byval HostLen As Long) As Long
Declare Function gethostbyname Lib "WSOCK32.DLL" (Byval hostname$) As Long
Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, Byval hpvSource& As Any, Byval cbCopy& As Any)


Function hibyte(Byval wParam As Integer)
hibyte = wParam \ &H100 And &HFF&
End Function

Function lobyte(Byval wParam As Integer)
lobyte = wParam And &HFF&
End Function

Sub SocketsInitialize()
Dim WSAD As WSADATA
Dim iReturn As Integer
Dim sLowByte As String, sHighByte As String, sMsg As String

iReturn = WSAStartup(WS_VERSION_REQD, WSAD)

If iReturn <> 0 Then
Msgbox "Winsock.dll is not responding."
End
End If

If lobyte(WSAD.wversion) <WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = _
WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then

sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte
sMsg = sMsg & " is not supported by winsock.dll "
Msgbox sMsg
End
End If

'iMaxSockets is not used in winsock 2. So the following check is only
'necessary for winsock 1. If winsock 2 is requested,
'the following check can be skipped.

If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
sMsg = "This application requires a minimum of "
sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
Msgbox sMsg
End
End If

End Sub

Sub SocketsCleanup()
Dim lReturn As Long

lReturn = WSACleanup()

If lReturn <> 0 Then
Msgbox "Socket error " & Trim$(Str$(lReturn)) & " occurred in Cleanup "
End
End If

End Sub

Sub ShowIP()
Dim hostname As String * 256
Dim hostent_addr As Long
Dim host As HOSTENT
Dim hostip_addr As Long
Dim temp_ip_address() As Byte
Dim i As Integer
Dim ip_address As String

If gethostname(hostname, 256) = SOCKET_ERROR Then
Msgbox "Windows Sockets error " & Str(WSAGetLastError())
Exit Sub
Else
hostname = Trim$(hostname)
End If

hostent_addr = gethostbyname(hostname)

If hostent_addr = 0 Then
Msgbox "Winsock.dll is not responding."
Exit Sub
End If

RtlMoveMemory host, hostent_addr, Lenb(host)
RtlMoveMemory hostip_addr, host.hAddrList, 4

Msgbox hostname

'get all of the IP address if machine is multi-homed

Do
Redim temp_ip_address(1 To host.hLength)
RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength

For i = 1 To host.hLength
ip_address = ip_address & temp_ip_address(i) & "."
Next
ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)

Msgbox ip_address

ip_address = ""
host.hAddrList = host.hAddrList + Lenb(host.hAddrList)
RtlMoveMemory hostip_addr, host.hAddrList, 4
Loop While (hostip_addr <> 0)

End Sub

Sub GetIP()
Call SocketsInitialize()
Call ShowIP()
Call SocketsCleanup()
End Sub
вызвать надо GetIP
код не правил, содрал как есть, только немного изменил для Нотеса, поэтому на вопросы по коду отвечать не буду :)
подправишь себе ShowIP чтобы она возвращала нужные данные, а не кидала месаджами...
зы: когда-то я себе писал свою утилиту, то там меньше кода было, но ее при себе не имею...
 

Akupaka

А че я?.. О.о
04.10.2007
3 360
2
#4
см. выше


зы: выдай в зал код для делфи, может попроще налабаем что-то :)
зы2: прочитал твою подпись... ты уверен, что там ничего не пропустил? :)))
 

yerke

Well-Known Member
28.08.2007
392
0
#5
код на дельфи
чет у вас код грамадный :)

Код:
program GetIP;
uses WinSock;
var
f: Textfile;
ss:String;

function GetLocalIP: String;
const WSVer = $101;
var
wsaData: TWSAData;
P: PHostEnt;
Buf: array [0..127] of Char;
begin
Result := '';
if WSAStartup(WSVer, wsaData) = 0 then begin
if GetHostName(@Buf, 128) = 0 then begin
P := GetHostByName(@Buf);
if P <> nil then Result := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
end;
WSACleanup;
end;
end;
begin
ss:=GetLocalIP;
AssignFile(f, 'MyIP.TXT');
ReWrite(f);
Writeln(f, ss);
Closefile(f);
end.
 

Akupaka

А че я?.. О.о
04.10.2007
3 360
2
#6
это не мой код, как я писал :)
найду свой, запостю :)
либо поищи как на VB использовать АПИшку inet_ntoa
я с ее помощью тоже тащил...
 

lmike

нет, пердело совершенство
Lotus team
27.08.2008
6 492
367
#9
вот никто не хочет использовать кроссплатформеные решения...
все норовят юзать бесовские поделия :)
а потом будут траблы с переносом кода...

http://littletutorials.com/2008/03/10/netw...ls-with-java-6/
распаковываем Посмотреть вложение NetInfo.zip
пущаем cmd файло

этот код требует (как написано по ссылке) ЖВМ 1.6
и вроде как в 8.5 она именно такая (так чта - мона и нативно выполнить в домине, искл. МакОсХ)
http://www-01.ibm.com/support/docview.wss?...uid=swg21188789
 

Akupaka

А че я?.. О.о
04.10.2007
3 360
2
#10
все норовят юзать бесовские поделия wink.gif
IBM'овская ява еще то поделие! :))


в общем, вот моя давняя библиотечка :)

[codebox]'++LotusScript Development Environment:2:5:(Options):0:66
Option Public
Option Declare

'++LotusScript Development Environment:2:5:(Forward):0:1
Declare Public Type WSAData
Declare Type WSADataInfo
Declare Public Type HOSTENT
Declare Public Function GetIPAddress() As String
Declare Public Function GetIPHostName() As String
Declare Public Function HiByte(Byval wParam As Integer)
Declare Public Function LoByte(Byval wParam As Integer)
Declare Public Sub SocketsCleanup()
Declare Public Function SocketsInitialize() As Boolean
Declare Function GetIPAddressByName(AHostName As String) As String
Declare Function StrMoveMemory(Byval hpvSource As Long) As String

'++LotusScript Development Environment:2:5:(Declarations):0:10
Public Const WSADESCRIPTION_LEN = 257
Public Const WSASYS_STATUS_LEN = 129
Public Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128
Public Const MIN_SOCKETS_REQD = 1
Public Const WS_VERSION_REQD = &H101
Public Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Public Const SOCKET_ERROR = -1
Public Const ERROR_SUCCESS = 0


Public Type WSAData
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Integer
wMaxUDPDG As Integer
dwVendorInfo As Long
End Type

Type WSADataInfo
wVersion As Integer
wHighVersion As Integer
szDescription As String * WSADESCRIPTION_LEN
szSystemStatus As String * WSASYS_STATUS_LEN
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As String
End Type

Public Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLen As Integer
hAddrList As Long
End Type


' Platform SDK: Memory Management
Const LMEM_FIXED = &H0
Const LMEM_MOVEABLE = &H2
Const LMEM_ZEROINIT = &H40
Const LHND = (LMEM_MOVEABLE + LMEM_ZEROINIT)
Const LPTR = (LMEM_FIXED + LMEM_ZEROINIT)
Const NONZEROLHND = LMEM_MOVEABLE
Const NONZEROLPTR = LMEM_FIXED

Declare Function LocalAlloc Lib "kernel32.dll" Alias "LocalAlloc" (Byval wFlags As Long, Byval wBytes As Long) As Long
Declare Function LocalFree Lib "kernel32.dll" Alias "LocalFree" (Byval hMem As Long) As Long

' Kernel-Mode Driver Architecture: Windows DDK
Declare Sub MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (hpvDest As Any, Byval hpvSource As Long, Byval cbCopy As Long)

' Platform SDK: Windows Sockets
Declare Function WSAStartupInfo Lib "wsock32.dll" Alias "WSAStartup" (Byval wVersionRequested As Integer, lpWSADATA As WSADataInfo) As Long
Declare Function WSACleanup Lib "wsock32.dll" Alias "WSACleanup" () As Long
Declare Function WSAGetLastError Lib "wsock32.dll" Alias "WSAGetLastError" () As Long
Declare Function WSAStartup Lib "wsock32.dll" Alias "WSAStartup" (Byval wVersionRequired As Long, lpWSADATA As WSAData) As Long
Declare Function gethostname Lib "wsock32.dll" Alias "gethostname" (Byval szHost As String, Byval dwHostLen As Long) As Long
Declare Function gethostbyname Lib "wsock32.dll" Alias "gethostbyname" (Byval szHost As String) As Long

'Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlCopyMemory" (hpvDest As Any, Byval hpvSource As Long, Byval cbCopy As Long)
Declare Function inet_addr Lib "wsock32.dll" Alias "inet_addr" (Byval cp As String) As Long
Declare Function inet_ntoa Lib "wsock32.dll" Alias "inet_ntoa" (Byval inn As Long) As Long

' Platform SDK: Internet Protocol Helper
'Declare Function SendARP Lib "IPHLPAPI.dll" (DestIP As IPAddr, SrcIP As IPAddr, pMacAddr As Long, PhyAddrLen As Long) As Long
Declare Function SendARP Lib "iphlpapi.dll" Alias "SendARP" (DestIP As Long, SrcIP As Long, pMacAddr As Long, PhyAddrLen As Long) As Long

' Platform SDK: Debugging and Error Handling
Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Const LANG_NEUTRAL = &H0
Const SUBLANG_DEFAULT = &H1
Const ERROR_BAD_USERNAME = 2202&
Declare Function GetLastError Lib "kernel32" () As Long
Declare Sub SetLastError Lib "kernel32" (Byval dwErrCode As Long)
Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (Byval dwFlags As Long, lpSource As Any, Byval dwMessageId As Long, Byval dwLanguageId As Long, Byval lpBuffer As String, Byval nSize As Long, Arguments As Long) As Long
'++LotusScript Development Environment:2:1:GetIPAddress:1:8
Public Function GetIPAddress() As String
Dim sHostName As String * 256
Dim lpHost As Long
Dim HOST As HOSTENT
Dim dwIPAddr As Long
Dim tmpIPAddr() As Byte
Dim I As Integer
Dim sIPAddr As String
If Not SocketsInitialize() Then
GetIPAddress = ""
Exit Function
End If
If gethostname(sHostName, 256) = SOCKET_ERROR Then
GetIPAddress = ""
Msgbox "Windows Sockets error " & Str$(WSAGetLastError()) & " has occurred. Unable to successfully get Host Name."
SocketsCleanup
Exit Function
End If
sHostName = Trim$(sHostName)
lpHost = gethostbyname(sHostName)
If lpHost = 0 Then
GetIPAddress = ""
Msgbox "Windows Sockets are not responding. " & "Unable to successfully get Host Name."
SocketsCleanup
Exit Function
End If
MoveMemory HOST, lpHost, Len(HOST)
MoveMemory dwIPAddr, HOST.hAddrList, 4
Redim tmpIPAddr(1 To HOST.hLen)
MoveMemory tmpIPAddr(1), dwIPAddr, HOST.hLen
For I = 1 To HOST.hLen
sIPAddr = sIPAddr & tmpIPAddr(I) & "."
Next
GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
SocketsCleanup
End Function
'++LotusScript Development Environment:2:1:GetIPHostName:1:8
Public Function GetIPHostName() As String
Dim sHostName As String * 256
If Not SocketsInitialize() Then
GetIPHostName = ""
Exit Function
End If
If gethostname(sHostName, 256) = SOCKET_ERROR Then
GetIPHostName = ""
Msgbox "Windows Sockets error " & Str$(WSAGetLastError()) & " has occurred. Unable to successfully get Host Name."
SocketsCleanup
Exit Function
End If
GetIPHostName = Left$(sHostName, Instr(sHostName, Chr(0)) - 1)
SocketsCleanup
End Function
'++LotusScript Development Environment:2:1:HiByte:1:8
Public Function HiByte(Byval wParam As Integer)
HiByte = wParam \ &H100 And &HFF&
End Function
'++LotusScript Development Environment:2:1:LoByte:1:8
Public Function LoByte(Byval wParam As Integer)
LoByte = wParam And &HFF&
End Function
'++LotusScript Development Environment:2:2:SocketsCleanup:1:8
Public Sub SocketsCleanup()
If WSACleanup() <> ERROR_SUCCESS Then
Msgbox "Socket error occurred in Cleanup."
End If
End Sub
'++LotusScript Development Environment:2:1:SocketsInitialize:1:8
Public Function SocketsInitialize() As Boolean
Dim WSAD As WSAData
Dim sLoByte As String
Dim sHiByte As String
If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
Msgbox "The 32-bit Windows Socket is not responding."
SocketsInitialize = False
Exit Function
End If
If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
Msgbox "This application requires a minimum of " & Cstr(MIN_SOCKETS_REQD) & " supported sockets."
SocketsInitialize = False
Exit Function
End If
If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
sHiByte = Cstr(HiByte(WSAD.wVersion))
sLoByte = Cstr(LoByte(WSAD.wVersion))
Msgbox "Sockets version " & sLoByte & "." & sHiByte & " is not supported by 32-bit Windows Sockets."
SocketsInitialize = False
Exit Function
End If
'must be OK, so lets do it
SocketsInitialize = True
End Function

'++LotusScript Development Environment:2:1:GetIPAddressByName:1:8
Function GetIPAddressByName(AHostName As String) As String
Dim sHostName As String * 256
Dim lpHost As Long
Dim HOST As HOSTENT
Dim dwIPAddr As Long
Dim tmpIPAddr() As Byte
Dim I As Integer
Dim sIPAddr As String
If Not SocketsInitialize() Then
GetIPAddressByName = "0.0.0.0"
Exit Function
End If

If Trim$(AHostName) = "" Then
If gethostname(sHostName, 256) = SOCKET_ERROR Then
GetIPAddressByName = "0.0.0.0"
Print "Windows Sockets error " & Str$(WSAGetLastError()) & " has occurred. Unable to successfully get Host Name."
SocketsCleanup
Exit Function
End If
Else
Dim shn As String
shn = AHostName & Chr(0)
sHostName = AHostName & Chr(0)
End If

'sHostName = sHostName
sHostName = Trim$(sHostName)
lpHost = gethostbyname(sHostName)
If lpHost = 0 Then
GetIPAddressByName = "0.0.0.0"
Print "Unable to successfully get Host Name."
SocketsCleanup
Exit Function
End If
MoveMemory HOST, lpHost, Len(HOST)
MoveMemory dwIPAddr, HOST.hAddrList, 4
Redim tmpIPAddr(1 To HOST.hLen)
MoveMemory tmpIPAddr(1), dwIPAddr, HOST.hLen
For I = 1 To HOST.hLen
sIPAddr = sIPAddr & tmpIPAddr(I) & "."
Next
GetIPAddressByName = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
SocketsCleanup
End Function
'++LotusScript Development Environment:2:1:StrMoveMemory:1:8
Function StrMoveMemory(Byval hpvSource As Long) As String
Dim ip As String
Dim lpip As Long
Dim ipb As Byte

lpip = hpvSource
StrMoveMemory = ""
Do
MoveMemory ipb, lpip, 1
If ipb = 0 Then Exit Do
StrMoveMemory = StrMoveMemory & Chr(ipb)
lpip = lpip + 1
Loop Until ipb = 0
End Function[/codebox]
 

lmike

нет, пердело совершенство
Lotus team
27.08.2008
6 492
367
#11
особливо я этот код запущу в линухах :) (виндовз СДык)
 

Akupaka

А че я?.. О.о
04.10.2007
3 360
2
#12
ну зануда :) никто ж не говорит, что это самый лучший вариант!
кроме того, если приложение предполагает работу онли в виндоуз воркспейс, то зачем перегружать приложение интерфейсом, который в итоге вызовет то же самое? :)