Drama con Visual

caudillo_famoso
28 de Enero del 2005
Estimados(as):

Tengo un terrible problema con Visual, cree un pequeño programa para que me de la IP local y la IP publica, luego inserte un codigo para que con esa informacion me mandara un archivo asp(texto plano), pero no resulta.

esto es lo que tengo:

Private Const ERROR_SUCCESS As Long = 0
Private Const MAX_ADAPTER_NAME_LENGTH As Long = 256
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 128
Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8

Private Type IP_ADDRESS_STRING
IpAddr(0 To 15) As Byte
End Type

Private Type IP_MASK_STRING
IpMask(0 To 15) As Byte
End Type

Private Type IP_ADDR_STRING
dwNext As Long
IpAddress As IP_ADDRESS_STRING
IpMask As IP_MASK_STRING
dwContext As Long
End Type

Private Type IP_ADAPTER_INFO
dwNext As Long
ComboIndex As Long 'reserved
sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3)) As Byte
sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As Byte
dwAddressLength As Long
sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1)) As Byte
dwIndex As Long
uType As Long
uDhcpEnabled As Long
CurrentIpAddress As Long
IpAddressList As IP_ADDR_STRING
GatewayList As IP_ADDR_STRING
DhcpServer As IP_ADDR_STRING
bHaveWins As Long
PrimaryWinsServer As IP_ADDR_STRING
SecondaryWinsServer As IP_ADDR_STRING
LeaseObtained As Long
LeaseExpires As Long
End Type

Private Declare Function GetAdaptersInfo Lib "iphlpapi.dll" _
(pTcpTable As Any, _
pdwSize As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(dst As Any, _
src As Any, _
ByVal bcount As Long)

Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long

Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" _
(ByVal lpszUrlName As String) As Long

Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long



Private Sub Form_Load()

Command1.Caption = "Obten tu IP publica"

Text1.Text = LocalIPAddress()
Text2.Text = ""

End Sub


Private Sub Command1_Click()

Text2.Text = Obten_tu_ip_publica()

End Sub


Private Function Obten_tu_ip_publica()

Dim sSourceUrl As String
Dim sLocalFile As String
Dim hfile As Long
Dim buff As String
Dim pos1 As Long
Dim pos2 As Long

'site returning IP address
sSourceUrl = "http://vbnet.mvps.org/resources/tools/getpublicip.shtml"
sLocalFile = "c:ip.txt"

'ensure this file does not exist in the cache
Call DeleteUrlCacheEntry(sSourceUrl)

'download the public IP file,
'read into a buffer and delete
If DownloadFile(sSourceUrl, sLocalFile) Then

hfile = FreeFile
Open sLocalFile For Input As #hfile
buff = Input$(LOF(hfile), hfile)
Close #hfile


'look for the IP line
pos1 = InStr(buff, "var ip =")

'if found,
If pos1 Then

'get position of first and last single
'quotes around address (e.g. '11.22.33.44')
pos1 = InStr(pos1 + 1, buff, "'", vbTextCompare) + 1
pos2 = InStr(pos1 + 1, buff, "'", vbTextCompare) '- 1

'return the IP address
Obten_tu_ip_publica = Mid$(buff, pos1, pos2 - pos1)

Else

Obten_tu_ip_publica = "(unable to parse IP)"

End If 'pos1

Kill sLocalFile

Else

Obten_tu_ip_publica = "(unable to access shtml page)"

End If 'DownloadFile

End Function


Private Function DownloadFile(ByVal sURL As String, _
ByVal sLocalFile As String) As Boolean

DownloadFile = URLDownloadToFile(0, sURL, sLocalFile, 0, 0) = ERROR_SUCCESS

End Function


Private Function LocalIPAddress() As String

Dim cbRequired As Long
Dim buff() As Byte
Dim ptr1 As Long
Dim sIPAddr As String
Dim Adapter As IP_ADAPTER_INFO

Call GetAdaptersInfo(ByVal 0&, cbRequired)

If cbRequired > 0 Then

ReDim buff(0 To cbRequired - 1) As Byte

If GetAdaptersInfo(buff(0), cbRequired) = ERROR_SUCCESS Then

'get a pointer to the data stored in buff()
ptr1 = VarPtr(buff(0))

Do While (ptr1 <> 0)

'copy the data from the pointer to the
'first adapter into the IP_ADAPTER_INFO type
CopyMemory Adapter, ByVal ptr1, LenB(Adapter)

With Adapter

'the DHCP IP address is in the
'IpAddress.IpAddr member

sIPAddr = TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode))

If Len(sIPAddr) > 0 Then Exit Do

ptr1 = .dwNext

End With 'With Adapter

'ptr1 is 0 when (no more adapters)
Loop 'Do While (ptr1 <> 0)

End If 'If GetAdaptersInfo
End If 'If cbRequired > 0

'return any string found
LocalIPAddress = sIPAddr

End Function


Private Function TrimNull(startstr As String) As String

TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))

End Function

Private Sub Image1_Click()

End Sub
Function Proc_Gen_Log()
Dim string_log_recorded
string_log_recorded = "<$php {header(& Chr$(34)& http://www.raton.es/prueba/index.html)}$> &Chr$(34) ) & Chr(13)"
Proc_Gen_Log = string_log_recorded
url_file = "c:/IP/text_file/miArchivo.asp"
If displayFileInfo(url_file) = "true" Then
Dim fso_w As New FileSystemObject
Dim f_w As File
Dim fsoStream_w As TextStream
Set f_w = fso_w.GetFile(url_file)
Set fsoStream_w = f_w.OpenAsTextStream(ForAppending)
' Agrega lineas al archivo
fsoStream_w.WriteLine string_log_recorded
fsoStream_w.Close
Set fsoStream_w = Nothing
Set fso_w = Nothing
Else
'---------------------no existe y se procede a crear----------------
Dim fso As New FileSystemObject
Dim fsoStream As TextStream
' Create a text file, and return a reference to a TextStream
Set fsoStream = fso.CreateTextFile(url_file, True)
' Write to the file
fsoStream.WriteLine string_log_recorded
fsoStream.Close
Set fsoStream = Nothing
Set fso = Nothing
'-------------------------------------------------------------------
End If
End Function
Function displayFileInfo(ByVal fileName As String)
'------------- comprobacion de existencia de archivo log--------
Dim fso As New FileSystemObject
Dim f As File
If fso.FileExists(fileName) Then
displayFileInfo = "true"
Else
displayFileInfo = "false"
End If
End Function

Al hacerlo andar esta cosa no hace lo anelado, que tire el archivo con el codigo ASP...

...Snif...

Gracias de antemano.