This Article provides a sample procedure called
AccessWebSiteUsingSockets.p to access a web site using the Hypertext Transfer Protocol (HTTP) internet protocol ( including the secure version HTTPS) with Progress 4GL.
The procedure retrieves a web page as a web browser would do and presents the corresponding text of the page.
The sockets related routines in this sample procedure are in the
httpget.i include file.
Both the sample
procedure and the
httpget.i include file are attached to this solution as one zip file
This code may be used the starting point of a program to access a web site or as an example of how to use 4GL sockets in a client application.
/* AccessWebSiteUsingSockets.p */
DEFINE VARIABLE wurl AS CHARACTER FORMAT "X(255)" VIEW-AS FILL-IN SIZE 65 BY 1 INITIAL "http://www.progress.com/" LABEL "Url" NO-UNDO.
DEFINE VARIABLE weditor AS CHARACTER VIEW-AS EDITOR INNER-CHARS 72 INNER-LINES 32 LARGE SCROLLBAR-VERTICAL NO-UNDO.
DEFINE BUTTON b-get LABEL "GET".
DEFINE VARIABLE vhost AS CHARACTER NO-UNDO.
DEFINE VARIABLE vport AS CHARACTER NO-UNDO.
DEFINE VARIABLE vpath AS CHARACTER NO-UNDO.
DEFINE VARIABLE vfile AS CHARACTER NO-UNDO.
SESSION:APPL-ALERT-BOXES = YES.
FORM wurl b-get SKIP weditor NO-LABELS WITH FRAME DEFAULT-FRAME THREE-D SIDE-LABELS.
ON 'RETURN':U OF wurl OR 'CHOOSE':U OF b-get DO:
ASSIGN wurl.
RUN UrlParser(INPUT wurl, OUTPUT vhost, OUTPUT vport, OUTPUT vpath).
RUN HTTPGet(vhost, vport, vpath, vfile).
weditor:READ-FILE(vfile).
RETURN.
END.
RUN adecomm/_tmpfile.p ("i", ".htm", OUTPUT vfile).
MAIN-BLOCK:
DO ON ERROR UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
DISPLAY wurl weditor WITH FRAME DEFAULT-FRAME.
ENABLE wurl b-get weditor WITH FRAME DEFAULT-FRAME.
WAIT-FOR GO OF CURRENT-WINDOW.
END.
OS-DELETE VALUE(vfile) NO-ERROR.
{ httpget.i }
/* httpget.i */
DEFINE STREAM outfile.
DEFINE VARIABLE vSocket AS HANDLE NO-UNDO.
DEFINE VARIABLE wstatus AS LOGICAL NO-UNDO.
DEFINE VARIABLE vStr AS CHARACTER NO-UNDO.
DEFINE VARIABLE vBuffer AS MEMPTR NO-UNDO.
DEFINE VARIABLE wloop AS LOGICAL NO-UNDO.
PROCEDURE UrlParser:
DEFINE INPUT PARAMETER purl AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER phost AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER pport AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER ppath AS CHARACTER NO-UNDO.
DEFINE VARIABLE vStr AS CHARACTER NO-UNDO.
IF purl BEGINS "http://" THEN DO:
vStr = SUBSTRING(purl, 8).
phost = ENTRY(1, vStr, "/").
IF NUM-ENTRIES(vStr, "/") = 1 THEN vStr = vStr + "/".
ppath = SUBSTRING(vStr, INDEX(vStr,"/")).
IF NUM-ENTRIES(phost, ":") > 1 THEN DO:
pport = ENTRY(2, phost, ":").
phost = ENTRY(1, phost, ":").
END.
ELSE DO:
pport = "80".
END.
END.
ELSE DO:
phost = "".
pport = "".
ppath = purl.
END.
END PROCEDURE.
PROCEDURE HTTPGet:
DEFINE INPUT PARAMETER phost AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pport AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER ppath AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pfile AS CHARACTER NO-UNDO.
wloop = YES.
CREATE SOCKET vSocket.
vSocket:SET-READ-RESPONSE-PROCEDURE ("readHandler",THIS-PROCEDURE).
wstatus = vSocket:CONNECT("-H " + phost + " -S " + pport) NO-ERROR.
IF wstatus = NO THEN DO:
MESSAGE "Connection to http server:" phost "port" pport "is unavailable".
DELETE OBJECT vSocket.
RETURN.
END.
OUTPUT STREAM outfile TO VALUE(pfile) BINARY NO-CONVERT.
vStr = "GET " + ppath + " HTTP/1.0" + "~n~n~n".
SET-SIZE(vBuffer) = LENGTH(vStr) + 1.
PUT-STRING(vBuffer,1) = vStr.
vSocket:WRITE(vBuffer, 1, LENGTH(vStr)).
SET-SIZE(vBuffer) = 0.
WAIT-FOR CLOSE OF THIS-PROCEDURE.
vSocket:DISCONNECT().
DELETE OBJECT vSocket.
OUTPUT STREAM outfile CLOSE.
END PROCEDURE.
PROCEDURE readHandler:
DEFINE VARIABLE l AS INTEGER NO-UNDO.
DEFINE VARIABLE str AS CHARACTER NO-UNDO.
DEFINE VARIABLE b AS MEMPTR NO-UNDO.
IF SELF:CONNECTED() = FALSE THEN DO:
APPLY 'CLOSE' TO THIS-PROCEDURE.
RETURN.
END.
l = vSocket:GET-BYTES-AVAILABLE().
IF l > 0 THEN DO:
SET-SIZE(b) = l + 1.
vSocket:READ(b, 1, l, 1).
str = GET-STRING(b,1).
PUT STREAM outfile CONTROL str.
SET-SIZE(b) = 0.
wloop = YES.
END.
ELSE DO:
wloop = NO.
OUTPUT STREAM outfile CLOSE.
END.
END PROCEDURE.
