Networking
.
File download
by Todd G. Nist
This program utilizes the standard DoFileDownload API.
On the occasions when you simply need to download one file, this routine will display the IE file download dialog. The nice thing is that the dialog takes care of all aspects of the interface, including the progressbar, animation and statistics. This code can easily be integrated into any application requiring this type of functionality.
The program has been tested under Windows 2000 Server/Professional.
----
API-procedures used in this example are listed here to be included in the search index:
PROCEDURE DoFileDownload EXTERNAL 'shdocvw.dll':U: PROCEDURE WideCharToMultiByte EXTERNAL "KERNEL32.dll": PROCEDURE MultiByteToWideChar EXTERNAL "KERNEL32.dll":
Attachments
ftpdownload.w.zip : demo
File Transfer Protocol (FTP)
by Todd G. Nist
Program source is available for download: winftp.w. Modified 20 July 2000.
This program demonstrates common FTP functionality: connect to an FTP server, list directory contents, change the current directory and of course: get, put and delete files.
See also FileDownload.
The code functions as follows:
* By default, it will connect to ftp.progress.com when you press the Connect FTP button.
* Once on the site, if you double click a directory in the directory selection list, it will open that directory and display the contents.
* By selecting the appropriate button, put, get, delete, you can achieve the desired request. These are all based on having permissions to the web site.
Notes
The function FtpFindFirstFile can only be invoked once within a given FTP Session. Therefore, when a double click occurs on the directory selection list, the current FTP session is closed, and then a new one established and the function FTPDirList invoked. This function is similar to the FindFirstFile and FindNextFile win32 API calls.
No username or password are used when connecting to the FTP server. This means the default username ("anonymous") and default password (something like "IE40USER@") will be used. This will probably not give you enough permissions to put or delete items. You may have to pass more specific username and password parameters in function InternetConnectionA.
The program has been tested under NT 4.0 with service pack 3 and IE4 or IE5, and also under Windows 98 with IE5.
----
API-procedures used in this example are listed here to be included in the search index:
PROCEDURE InternetConnectA EXTERNAL "wininet.dll" PERSISTENT: PROCEDURE InternetGetLastResponseInfoA EXTERNAL "wininet.dll" PERSISTENT: PROCEDURE InternetOpenUrlA EXTERNAL "wininet.dll" PERSISTENT: PROCEDURE InternetOpenA EXTERNAL "wininet.dll" PERSISTENT: PROCEDURE InternetReadFile EXTERNAL "wininet.dll" PERSISTENT: PROCEDURE InternetCloseHandle EXTERNAL "wininet.dll" PERSISTENT: PROCEDURE FtpFindFirstFileA EXTERNAL "wininet.dll" PERSISTENT: PROCEDURE InternetFindNextFileA EXTERNAL "wininet.dll" PERSISTENT: PROCEDURE FtpGetCurrentDirectoryA EXTERNAL "wininet.dll" PERSISTENT: PROCEDURE FtpSetCurrentDirectoryA EXTERNAL "wininet.dll" PERSISTENT: PROCEDURE FtpOpenFileA EXTERNAL "wininet.dll" PERSISTENT: PROCEDURE FtpPutFileA EXTERNAL "wininet.dll" PERSISTENT: PROCEDURE FtpGetFileA EXTERNAL "wininet.dll" PERSISTENT: PROCEDURE FtpDeleteFileA EXTERNAL "wininet.dll" PERSISTENT:
Attachments
winftp.w.zip : demo program
Get MAC address
by Maurits van Rijnen
Every network adapter has a unique id: the MAC address. The MAC address may be used to identify a computer, at least for a while until its network adapter is replaced or until someone decides to flash a new MAC address into the adapter. Also, be carefull if the computer has more than one network adapter.
To read the MAC address you should read the ARP cache, but that's very complicated. Let's forget about the ARP cache.
Maurits found a neat "workaround" based on UuidCreate:
UuidCreate creates a new universally unique identifier, which can be used for creating new ActiveX controls and so on. Because it has to be universally unique it is based on a MAC address and probably some datetime-value (and perhaps some other hardware metrics). Maurits recognized how to read the MAC address from the uuid :
PROCEDURE UuidCreate EXTERNAL "rpcrt4.dll":U :
DEFINE INPUT-OUTPUT PARAMETER opi-guid AS CHARACTER NO-UNDO.
END PROCEDURE.
PROCEDURE UuidCreateSequential EXTERNAL "rpcrt4.dll":U :
DEFINE INPUT-OUTPUT PARAMETER opi-guid AS CHARACTER NO-UNDO.
END PROCEDURE.
FUNCTION inttohex RETURNS CHARACTER (INPUT i AS INTEGER):
/* only for 0..255 integer values */
DEFINE VARIABLE cHex AS CHARACTER NO-UNDO INIT '0123456789ABCDEF':U.
DEFINE VARIABLE j1 AS INTEGER NO-UNDO.
DEFINE VARIABLE j2 AS INTEGER NO-UNDO.
j1 = TRUNCATE(i / 16, 0) .
j2 = i - (j1 * 16).
RETURN SUBSTR(cHex, j1 + 1, 1) + SUBSTR(cHex, j2 + 1, 1).
END.
FUNCTION GetMacAddress RETURNS CHAR:
DEFINE VARIABLE X AS CHARACTER NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
DEFINE VARIABLE j AS INTEGER NO-UNDO.
DEFINE VARIABLE r AS CHARACTER NO-UNDO.
X = FILL(' ':U, 16).
IF RunningWindows2000() THEN
RUN UuidCreateSequential (INPUT-OUTPUT X).
ELSE
RUN UuidCreate (INPUT-OUTPUT X).
DO i = 11 TO 16:
r = r + ' ':U + inttohex(ASC(SUBSTR(X,i,1))).
END.
RETURN SUBSTR(R,2).
END.
DISPLAY GetMAcAddress() FORMAT "X(20)":U.
Notes
Procedure UuidCreate() in Windows 2000 returns a uuid that can not be traced back to the MAC address. Procedure UuidCreateSequential is provided for backward compatibility: it behaves like UuidCreate() in Windows 95/98/NT4.
Mailslots
Introduction
There are several techniques for Inter Process Communication (IPC) like DDE, pipes, atoms, sockets and mailslots. Each technique has its own characteristics; this topic concentrates on Mailslots.
Mailslots offer an easy way for a process to broadcast a message to several other processes at once. A Mailslot is a pseudo-file created by one particular process, known as the Mailslot server. The Maislot server can read messages from the mailslot.
Other processes, known as Mailslot clients, can write messages to mailslots owned by Mailslot servers. A Mailslot client is not allowed to read from another process' mailslot.
Remember: a mailslot is a pseudo-file and lives in memory only for the lifetime of the process, or shorter. Don't confuse it with email where messages are persistently stored in an "inbox folder" or file.
A simple scenario
For the sake of simplicity it's easiest to think of processes as 'computers'. It is possible to set up mailsots between processes on the same computer but this has some limitations.
In it's simplest form, a server can receive messages from one or many clients but the clients can not receive anything.
In this case, Sue has set up a mailslot on her local machine. She named this mailslot
\\.\mailslot\myapp\finance
(The "dot" means "local machine". "myapp" and "finance" are path and name to be picked by your application). This path and name have to be known by other processes. That won't be a problem if those other processes are running instances of the same application!
Bob and Pete are clients; they can write messages to Sue's mailslot by addressing
\\Sue\mailslot\myapp\finance
Where "Sue" is a machine name. More realisticly, they would address to
\\domainname\mailslot\myapp\finance
or even to
\\*\mailslot\myapp\finance
where the asterisk stands for the primary domain. In these last two cases, the messages will also be picked up by anyone else in the domain who defined the mailslot like Sue did. Hence you have a broadcasting mechanism.
A more realistic scenario
Although Sue is the mailslot server for her own local mailslot, there is no reason why she shouldn't be able to send messages to other processes who also have a local mailslot named ".\mailslot\myapp\finance". Sue can be a server and a client at the same time.
Likewise, there is no reason why Bob and Pete should't be able to serve a mailslot each, also using this same mailslot name.
A message sent by either Bob, Pete or Sue (or anyone else) will now be recieved by all others.
Limitations
Only one process on a computer can serve a mailslot with a particular name. In other words: this broadcasting mechanism will not work between multiple instances of an application running on the same computer.
The maximum size of a message is 64K if it is not broadcast. A broadcasted message can be no longer than 400 byte.
Mailslots use datagrams. There is no way of knowing if a broadcasted message will actually be received by everyone.
If you need to broadcast across a WAN you may consider setting up sockets on an "IP Multicast" enabled network. See http:www.ipmulticast.com.
Procedures
A server creates a mailslot by calling procedure CreateMailslot(). This procedure returns a Mailslot-handle. The Mailslot-handle is somewhat compatible with a file-handle: the server can read messages from the mailslot by calling procedure ReadFile(). Procedure GetMailslotInfo() tells how many messages are in the pseudo-file and how long they are. The server calls CloseHandle() to destroy the mailslot.
A client writes to a mailslot just as if it writes to a file, except the filename must be a valid mailslot-name. In other words a client uses CreateFile(), WriteFile() and CloseHandle().
Note: CreateFile() doesn't create the file of course, it only gets a handle to the existing pseudo-file (the "share"-flags are especially important here).
Mailslot example
Source code by Todd. G. Nist, Protech Systems Inc.
Source is attached for download.
This procedure can run either as a mailslot server or as a mailslot client. If it runs as a server, it will be able to read messages (it uses a PSTimer.ocx to scan for new messages each 500 msec). If it runs as a client it is able to send messages if there is also a server active.
I (Jurjen) had only one PC to play with, so I launched two instances of Progress on that PC, each running a copy of w-mailslot.w as shown on the pic.
User Manual for this example
First you have to start a mailslot server: run w-mailslot.w and make sure the toggle-box is checked. Click on the editor-widget: the ON ENTRY trigger of the editor will create the mailslot. From now on the PSTimer will check for new messages and will show them in the editor.
After you have created a server you can start one or more clients: run w-mailslot.w again and make sure the toggle-box is NOT checked. Change the mailslot name if the server is not running on the same PC. Click on the editor widget: the ON-ENTRY trigger will now open the mailslot for writing and the PSTimer.ocx will be closed.
Type a message, press the "Write" button and watch how the server receives it.
About the source
This program will not act as a server and a client at the same time, so let's look at it as if it were two separate programs.
the server functionality
These three parts do the core functionality: CreateMailslot, ReadMailslot and CloseHandle.
RUN CreateMailSlot{&A} (INPUT cMailslotName:SCREEN-VALUE,
INPUT 0, /* Maximum message length */
INPUT 0, /* Read timeout */
INPUT 0, /* security attributes */
OUTPUT hMailSlot). /* handle to mailslot
or INVALID_HANDLE_VALUE */
--------------------------------------------------------------------------------
FUNCTION ReadMailSlot RETURNS CHARACTER
( /* parameter-definitions */ ) :
DEFINE VARIABLE cTempStr AS CHARACTER NO-UNDO.
DEFINE VARIABLE iBytesRead AS INTEGER NO-UNDO.
DEFINE VARIABLE iResultCode AS INTEGER NO-UNDO.
/* allocate some space */
cTempStr = FILL(' ', 512).
RUN ReadFile (INPUT hMailslot,
OUTPUT cTempStr,
INPUT 512,
OUTPUT iBytesRead,
INPUT 0,
OUTPUT iResultCode).
RETURN TRIM(cTempStr) +
(IF TRIM(cTempStr) = '' THEN '' ELSE CHR(10)).
END FUNCTION.
--------------------------------------------------------------------------------
RUN CloseHandle(hMailslot,
OUTPUT iResultCode).
Function ReadFile() reads one message even if there are more messages pending. The size (512) may not be enough. I think you should call function GetMailslotInfo() first: this returns the number of pending messages (so you can read all of them) and the size of the next message (so you can allocate the proper size).
the client functionality
The most important parts are now: CreateFile, WriteMailSlot and CloseHandle.
RUN CreateFile{&A}( INPUT cMailslotName:SCREEN-VALUE,
{&GENERIC_WRITE},
{&FILE_SHARE_READ},
0,
{&OPEN_EXISTING},
{&FILE_ATTRIBUTE_NORMAL},
0,
OUTPUT hMailslot).
--------------------------------------------------------------------------------
FUNCTION WriteMailSlot RETURNS CHARACTER
( /* parameter-definitions */ ) :
DEFINE VARIABLE iBytesWritten AS INTEGER NO-UNDO.
DEFINE VARIABLE iResultCode AS INTEGER NO-UNDO.
/* Write to the mailslot */
cMsg = "\\":U + cComputerName
+ " - ":U
+ cMsg:SCREEN-VALUE IN FRAME {&frame-name}.
RUN WriteFile(INPUT hMailslot,
INPUT cMsg,
INPUT LENGTH(cMsg) + 1,
OUTPUT iBytesWritten,
INPUT 0,
OUTPUT iResultCode).
IF iResultCode = 0 THEN
DO:
MESSAGE "Error on WriteFile. "
"Terminating client."
VIEW-AS ALERT-BOX.
APPLY "window-close" TO {&window-name}.
END.
ELSE
cMsg:SCREEN-VALUE = "".
RETURN "". /* Function return value. */
END FUNCTION.
--------------------------------------------------------------------------------
RUN CloseHandle(hMailslot,
OUTPUT iResultCode).
Attachments
mailslot.zip : demo
Ping
by Marian EDU
Marian made a function to check if the host is alive or not. He wrote:
"if you want to get funky you can use gethostbyname to resolve the address, and use more options on IcmpSendEcho. but I don't see no utility in this. you probably want to check if a specific service is running on that machine. so it's more easy to use sockets and attempt to connect to the specific service."
/******************************************************************************
Program: ping.p
Written By: Marian EDU
Written On: September 2002
Description: Used to do ping or traceroute to one specific host address.
Host name is not supported, works only with IP address.
Parameters: Input - IP address
- ping && traceroute options
- show result message flag
Output - host available flag
Note: Options: You can specify ping && traceroute options
as a comma delimited string.
ex: '-t,-n 10,-i 20,-l 32,-w 300'
will send maximum 10 echo requests with
32 bytes of data for each host on trace
route with the 300 milliseconds time-out
and the maximum TTL is 20 and traceroute
is enabled.
-t enable traceroute
-n number of request to send
-i time to live TTL
-l send packet size
-w time-out in milliseconds to wait for reply
Examples: ping.p('66.218.71.86', '-t,-w 300,-n 10,-l 320,-i 20', TRUE, OUTPUT lAvail)
Will do a traceroute to yahoo servers using a
320 bytes data packet, with a maximum hops number
of 20 (TTL), for each host in trace route will send
a maximum 10 echo request until will get an answer
using 300 milliseconds time-out.
Cause the show result message flag is true will
display the traceroute result at the end.
--------------------- Revision History ------------------
Date: Author Change Description
23/09/02 M EDU Initial Release
24/09/02 M EDU Traceroute implemented, more options available
******************************************************************************/
DEFINE INPUT PARAMETER pcHostAddr AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcOptions AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER plShowResults AS LOGICAL NO-UNDO.
DEFINE OUTPUT PARAMETER plAlive AS LOGICAL NO-UNDO.
DEFINE VARIABLE iNoRetry AS INTEGER NO-UNDO.
DEFINE VARIABLE iPacketSize AS INTEGER NO-UNDO.
DEFINE VARIABLE iTimeOut AS INTEGER NO-UNDO.
DEFINE VARIABLE iMaxHops AS INTEGER NO-UNDO.
DEFINE VARIABLE lEnableTrace AS LOGICAL NO-UNDO.
DEFINE VARIABLE ReqData AS MEMPTR NO-UNDO.
DEFINE VARIABLE ReplyBuf AS MEMPTR NO-UNDO.
DEFINE VARIABLE PIP_OPTION_INFORMATION AS MEMPTR NO-UNDO.
DEFINE VARIABLE HopAddr AS MEMPTR NO-UNDO.
DEFINE VARIABLE iCount AS INTEGER NO-UNDO EXTENT 3.
DEFINE VARIABLE iRes AS INTEGER NO-UNDO.
DEFINE VARIABLE iIcmpHdl AS INTEGER NO-UNDO.
DEFINE VARIABLE iDstAddr AS INTEGER NO-UNDO.
DEFINE VARIABLE cHostAddr AS CHARACTER NO-UNDO.
DEFINE VARIABLE cEntry AS CHARACTER NO-UNDO.
DEFINE VARIABLE cMessage AS CHARACTER NO-UNDO.
/* API definitions */
/* Microsoft has their own proprietary API for ping
and tracert implemented in ICMP.DLL.
The functions in ICMP.DLL are not considered part
of the Win32 API and might not be supported in
future releases. */
PROCEDURE IcmpCreateFile EXTERNAL 'ICMP.DLL':
DEFINE RETURN PARAMETER phIcmp AS LONG.
END PROCEDURE.
PROCEDURE IcmpCloseHandle EXTERNAL 'ICMP.DLL':
DEFINE INPUT PARAMETER phIcmp AS LONG.
END PROCEDURE.
PROCEDURE IcmpSendEcho EXTERNAL 'ICMP.DLL':
DEFINE INPUT PARAMETER phIcmp AS LONG.
DEFINE INPUT PARAMETER DstAddr AS LONG.
DEFINE INPUT PARAMETER ReqData AS LONG.
DEFINE INPUT PARAMETER ReqSize AS LONG.
DEFINE INPUT PARAMETER ReqOptions AS LONG.
DEFINE INPUT PARAMETER ReplyBuf AS LONG.
DEFINE INPUT PARAMETER ReplySize AS LONG.
DEFINE INPUT PARAMETER Timeout AS LONG.
DEFINE RETURN PARAMETER ReplyCount AS LONG.
END PROCEDURE.
PROCEDURE inet_addr EXTERNAL 'WS2_32.DLL':
DEFINE INPUT PARAMETER HostName AS CHARACTER.
DEFINE RETURN PARAMETER HostAddr AS LONG.
END PROCEDURE.
PROCEDURE inet_ntoa EXTERNAL 'WS2_32.DLL':
DEFINE INPUT PARAMETER HostAddr AS LONG.
DEFINE RETURN PARAMETER HostName AS MEMPTR.
END PROCEDURE.
/* default options */
ASSIGN
lEnableTrace = FALSE
iPacketSize = 32
iTimeOut = 5000
iNoRetry = 4
iMaxHops = 64 NO-ERROR.
/* parse options parameter */
DO iCount[1] = 1 TO NUM-ENTRIES(pcOptions):
cEntry = ENTRY(iCount[1],pcOptions).
CASE ENTRY(1,cEntry,' ':U):
WHEN '-t':U THEN lEnableTrace = TRUE.
WHEN '-w' THEN iTimeOut = INTEGER(ENTRY(NUM-ENTRIES(cEntry,' ':U),cEntry,' ':U)) NO-ERROR.
WHEN '-n' THEN iNoRetry = INTEGER(ENTRY(NUM-ENTRIES(cEntry,' ':U),cEntry,' ':U)) NO-ERROR.
WHEN '-l' THEN iPacketSize = INTEGER(ENTRY(NUM-ENTRIES(cEntry,' ':U),cEntry,' ':U)) NO-ERROR.
WHEN '-i' THEN iMaxHops = INTEGER(ENTRY(NUM-ENTRIES(cEntry,' ':U),cEntry,' ':U)) NO-ERROR.
END CASE.
END.
SET-SIZE(ReqData) = iPacketSize + 1.
DO iCount[1] = 1 TO iPacketSize:
PUT-STRING(ReqData,iCount[1]) = CHR(32 + iCount[2]).
iCount[2] = iCount[2] + 1.
IF iCount[2] >= 94 THEN iCount[2] = 0.
END.
SET-SIZE(ReplyBuf) = GET-SIZE(ReqData) + 28 + 1.
SET-SIZE(PIP_OPTION_INFORMATION) = 4 + 1.
SET-SIZE(HopAddr) = 16.
RUN inet_addr(pcHostAddr, OUTPUT iDstAddr) NO-ERROR.
RUN IcmpCreateFile(OUTPUT iIcmpHdl) NO-ERROR.
/* if valid host IP address suplied */
IF iDstAddr NE -1 AND iIcmpHdl NE -1 THEN DO:
/* traceroute - increment TTL and send a new
echo request */
IF lEnableTrace THEN DO iCount[1] = 1 TO iMaxHops:
PUT-LONG(PIP_OPTION_INFORMATION,1) = iCount[1].
DO iCount[2] = 1 TO iNoRetry:
RUN IcmpSendEcho(iIcmpHdl,
iDstAddr,
GET-POINTER-VALUE(ReqData),
GET-SIZE(ReqData),
GET-POINTER-VALUE(PIP_OPTION_INFORMATION),
GET-POINTER-VALUE(ReplyBuf),
GET-SIZE(ReplyBuf),
iTimeOut,
OUTPUT iRes).
IF iRes > 0 THEN LEAVE.
END.
RUN inet_ntoa(GET-LONG(ReplyBuf,1), OUTPUT HopAddr).
/* format the treceroute result message */
IF plShowResults THEN
cMessage = cMessage +
SUBSTITUTE('Reply from &1~t time=&2ms~t TTL=&3~n',
GET-STRING(HopAddr,1),
STRING(GET-LONG(ReplyBuf,9)),
STRING(iCount[1])).
IF iDstAddr = GET-LONG(ReplyBuf,1) THEN DO:
plAlive = TRUE.
LEAVE.
END.
END.
/* ping - send a number of requests using
the given TTL, time-out, packet size */
ELSE DO iCount[1] = 1 TO iNoRetry:
PUT-LONG(PIP_OPTION_INFORMATION,1) = iMaxHops.
RUN IcmpSendEcho(iIcmpHdl,
iDstAddr,
GET-POINTER-VALUE(ReqData),
GET-SIZE(ReqData),
GET-POINTER-VALUE(PIP_OPTION_INFORMATION),
GET-POINTER-VALUE(ReplyBuf),
GET-SIZE(ReplyBuf),
iTimeOut,
OUTPUT iRes).
IF iRes = 0 THEN NEXT.
RUN inet_ntoa(GET-LONG(ReplyBuf,1), OUTPUT HopAddr).
/* format the ping result message */
IF plShowResults THEN
cMessage = cMessage +
SUBSTITUTE('Reply from &1~t bytes=&2~t~ttime=&3ms~t TTL=&4~n',
GET-STRING(HopAddr,1),
STRING(GET-LONG(ReplyBuf,13)),
STRING(GET-LONG(ReplyBuf,9)),
STRING(GET-LONG(ReplyBuf,21))).
IF iRes > 0 THEN plAlive = TRUE.
END.
END.
RUN IcmpCloseHandle(iIcmpHdl).
SET-SIZE(HopAddr) = 0.
SET-SIZE(PIP_OPTION_INFORMATION) = 0.
SET-SIZE(ReqData) = 0.
SET-SIZE(ReplyBuf) = 0.
IF cMessage NE '':U THEN
MESSAGE cMessage VIEW-AS ALERT-BOX.
The IP address of your local computer
by Bill Prew
The following procedure returns the ip adress and the host name for the local computer.
&SCOPED-DEFINE WSADESCRIPTION_LEN 256
&SCOPED-DEFINE WSASYS_STATUS_LEN 128
&SCOPED-DEFINE WSADATA_VERSION_LOW 1 /* WORD(2) */
&SCOPED-DEFINE WSADATA_VERSION_HIGH 3 /* WORD(2) */
&SCOPED-DEFINE WSADATA_DESCRIPTION 5 /* CHAR(WSADESCRIPTION_LEN + 1) */
&SCOPED-DEFINE WSADATA_SYSTEM_STATUS 262 /* CHAR(WSASYS_STATUS_LEN + 1) */
&SCOPED-DEFINE WSADATA_MAX_SOCKETS 391 /* SHORT(4) */
&SCOPED-DEFINE WSADATA_MAX_UDP 395 /* SHORT(4) */
&SCOPED-DEFINE WSADATA_VENDOR_INFO 399 /* CHAR*(4) */
&SCOPED-DEFINE WSADATA_LENGTH 403
&SCOPED-DEFINE HOSTENT_NAME 1 /* CHAR*(4) */
&SCOPED-DEFINE HOSTENT_ALIASES 5 /* CHAR**(4) */
&SCOPED-DEFINE HOSTENT_ADDR_TYPE 9 /* SHORT(2) */
&SCOPED-DEFINE HOSTENT_ADDR_LENGTH 11 /* SHORT(2) */
&SCOPED-DEFINE HOSTENT_ADDR_LIST 13 /* CHAR**(4) */
&SCOPED-DEFINE HOSTENT_LENGTH 16
PROCEDURE i-GetTcpInfo:
/*------------------------------------------------------------------------
Procedure : i-GetTcpInfo
Description : Return the windows TCP host name and address of this PC.
Parms : - Host name. (OUTPUT, CHARACTER)
- Host address. (OUTPUT, CHARACTER):
Sample usage: RUN i-GetTcpInfo (OUTPUT w-TcpName,
OUTPUT w-TcpAddr).
Notes : -
------------------------------------------------------------------------*/
DEFINE OUTPUT PARAMETER p-TcpName AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER p-TcpAddr AS CHARACTER NO-UNDO.
DEFINE VARIABLE w-TcpName AS CHARACTER NO-UNDO.
DEFINE VARIABLE w-Length AS INTEGER NO-UNDO.
DEFINE VARIABLE w-Return AS INTEGER NO-UNDO.
DEFINE VARIABLE ptr-WsaData AS MEMPTR NO-UNDO.
DEFINE VARIABLE w-Hostent AS INTEGER NO-UNDO.
DEFINE VARIABLE ptr-Hostent AS MEMPTR NO-UNDO.
DEFINE VARIABLE ptr-AddrString AS MEMPTR NO-UNDO.
DEFINE VARIABLE ptr-AddrList AS MEMPTR NO-UNDO.
DEFINE VARIABLE ptr-ListEntry AS MEMPTR NO-UNDO.
DEFINE VARIABLE w-TcpLong AS INTEGER NO-UNDO.
/* Initialize return values */
ASSIGN p-TcpName = ?
p-TcpAddr = ?
.
/* Allocate work structure for WSADATA */
SET-SIZE(ptr-WsaData) = {&WSADATA_LENGTH}.
/* Ask Win32 for winsock usage */
RUN WSAStartup (INPUT 257, /* requested version 1.1 */
INPUT GET-POINTER-VALUE(ptr-WsaData),
OUTPUT w-Return).
/* Release allocated memory */
SET-SIZE(ptr-WsaData) = 0.
/* Check for errors */
IF w-Return NE 0 THEN DO:
MESSAGE "Error accessing WINSOCK support." VIEW-AS ALERT-BOX.
RETURN.
END.
/* Set up variables */
ASSIGN w-Length = 100
w-TcpName = FILL(" ", w-Length)
.
/* Call Win32 routine to get host name */
RUN gethostname (OUTPUT w-TcpName,
INPUT w-Length,
OUTPUT w-Return).
/* Check for errors */
IF w-Return NE 0 THEN DO:
MESSAGE "Error getting tcp name." VIEW-AS ALERT-BOX.
RUN WSACleanup (OUTPUT w-Return).
RETURN.
END.
/* Pass back gathered info */
/* remember: the string is null-terminated so there is a CHR(0)
inside w-TcpName. We have to trim it: */
p-TcpName = ENTRY(1,w-TcpName,CHR(0)).
/* Call Win32 routine to get host address */
RUN gethostbyname (INPUT w-TcpName,
OUTPUT w-Hostent).
/* Check for errors */
IF w-Hostent EQ 0 THEN DO:
MESSAGE "Error resolving host name." VIEW-AS ALERT-BOX.
RUN WSACleanup (OUTPUT w-Return).
RETURN.
END.
/* Set pointer to HostEnt data structure */
SET-POINTER-VALUE(ptr-Hostent) = w-Hostent.
/* "Chase" pointers to get to first address list entry */
SET-POINTER-VALUE(ptr-AddrList) = GET-LONG(ptr-Hostent,
{&HOSTENT_ADDR_LIST}).
SET-POINTER-VALUE(ptr-ListEntry) = GET-LONG(ptr-AddrList, 1).
w-TcpLong = GET-LONG(ptr-ListEntry, 1).
RUN inet_ntoa (INPUT w-TcpLong,
OUTPUT ptr-AddrString).
/* Pass back gathered info */
p-TcpAddr = GET-STRING(ptr-AddrString, 1).
/* Terminate winsock usage */
RUN WSACleanup (OUTPUT w-Return).
END PROCEDURE.
Definitions used in this procedure, not listed in windows.p :
PROCEDURE gethostname EXTERNAL "wsock32.dll" : DEFINE OUTPUT PARAMETER p-Hostname AS CHARACTER. DEFINE INPUT PARAMETER p-Length AS LONG. DEFINE RETURN PARAMETER p-Return AS LONG. END PROCEDURE. PROCEDURE gethostbyname EXTERNAL "wsock32.dll" : DEFINE INPUT PARAMETER p-Name AS CHARACTER. DEFINE RETURN PARAMETER p-Hostent AS LONG. END PROCEDURE. PROCEDURE inet_ntoa EXTERNAL "wsock32.dll" : DEFINE INPUT PARAMETER p-AddrStruct AS LONG. DEFINE RETURN PARAMETER p-AddrString AS MEMPTR. END PROCEDURE. PROCEDURE WSAStartup EXTERNAL "wsock32.dll" : DEFINE INPUT PARAMETER p-VersionReq AS SHORT. DEFINE INPUT PARAMETER ptr-WsaData AS LONG. DEFINE RETURN PARAMETER p-Return AS LONG. END PROCEDURE. PROCEDURE WSACleanup EXTERNAL "wsock32": DEFINE RETURN PARAMETER p-Return AS LONG. END PROCEDURE.
Notes
On Windows 98 and perhaps other versions of Windows you may prefer to use "ws32_2.dll" instead "wsock32.dll".
bugfix
June 22, 1999
Joern Winther found and solved the following bug:
p-TcpName = w-TcpName.
should be
p-TcpName = ENTRY(1,w-TcpName,CHR(0)).
to get rid of the terminating null.