Get Local Ip

Тема в разделе "Lotus - Программирование", создана пользователем yerke, 10 мар 2009.

  1. yerke

    yerke Well-Known Member

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

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

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

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

    Akupaka А че я?.. О.о

    Регистрация:
    4 окт 2007
    Сообщения:
    3.373
    Симпатии:
    2
    ну... слов нет... хотел материться, но сдержался :)
    зачем велосипед? возьми апишками определи адрес да и все... и не надо гемориться...
    тем более, что код у тебя должен быть из того самого примера на делфи...

    вот тебе пример, если еще не справился
    Код (Text):
    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 чтобы она возвращала нужные данные, а не кидала месаджами...
    зы: когда-то я себе писал свою утилиту, то там меньше кода было, но ее при себе не имею...
     
  3. yerke

    yerke Well-Known Member

    Регистрация:
    28 авг 2007
    Сообщения:
    392
    Симпатии:
    0
    ну как это сделать в LS

    если можно сам код покажите
     
  4. Akupaka

    Akupaka А че я?.. О.о

    Регистрация:
    4 окт 2007
    Сообщения:
    3.373
    Симпатии:
    2
    см. выше


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

    yerke Well-Known Member

    Регистрация:
    28 авг 2007
    Сообщения:
    392
    Симпатии:
    0
    код на дельфи
    чет у вас код грамадный :)

    Код (Text):
    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.
     
  6. Akupaka

    Akupaka А че я?.. О.о

    Регистрация:
    4 окт 2007
    Сообщения:
    3.373
    Симпатии:
    2
    это не мой код, как я писал :)
    найду свой, запостю :)
    либо поищи как на VB использовать АПИшку inet_ntoa
    я с ее помощью тоже тащил...
     
  7. morpheus

    morpheus скриптописец

    Регистрация:
    7 авг 2006
    Сообщения:
    3.927
    Симпатии:
    0
  8. Akupaka

    Akupaka А че я?.. О.о

    Регистрация:
    4 окт 2007
    Сообщения:
    3.373
    Симпатии:
    2
    А Morpheus хитрее всех :)
     
  9. lmike

    lmike нет, пердело совершенство
    Команда форума Lotus team

    Регистрация:
    27 авг 2008
    Сообщения:
    6.073
    Симпатии:
    299
    вот никто не хочет использовать кроссплатформеные решения...
    все норовят юзать бесовские поделия :)
    а потом будут траблы с переносом кода...

    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
     
  10. Akupaka

    Akupaka А че я?.. О.о

    Регистрация:
    4 окт 2007
    Сообщения:
    3.373
    Симпатии:
    2
    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]
     
  11. lmike

    lmike нет, пердело совершенство
    Команда форума Lotus team

    Регистрация:
    27 авг 2008
    Сообщения:
    6.073
    Симпатии:
    299
    особливо я этот код запущу в линухах :) (виндовз СДык)
     
  12. Akupaka

    Akupaka А че я?.. О.о

    Регистрация:
    4 окт 2007
    Сообщения:
    3.373
    Симпатии:
    2
    ну зануда :) никто ж не говорит, что это самый лучший вариант!
    кроме того, если приложение предполагает работу онли в виндоуз воркспейс, то зачем перегружать приложение интерфейсом, который в итоге вызовет то же самое? :)
     
  13. yerke

    yerke Well-Known Member

    Регистрация:
    28 авг 2007
    Сообщения:
    392
    Симпатии:
    0
    спасибо всем
    особенно
    Akupaka Morpheus
     
Загрузка...
Похожие Темы - Get Local
  1. kuklofon
    Ответов:
    0
    Просмотров:
    138
  2. victorhalf
    Ответов:
    3
    Просмотров:
    222
  3. Amfion
    Ответов:
    0
    Просмотров:
    472
  4. aguch
    Ответов:
    11
    Просмотров:
    1.091
  5. Петя Кузин
    Ответов:
    2
    Просмотров:
    575

Поделиться этой страницей