irielogo.gif (1617 bytes)
Irie Tools
Irie Pascal
CGI
  Introduction
  Install
  Examples
  Links
Links

Pascal Search Engine

Join Mailing List

Do you want to receive email announcements about  important developments at Irie Tools? If so, please enter your email address below:

Redirect.pas

The following program redirects the visitor to another page. A brief description, of how this program works, follows the program listing below.

program redirect(input, output);
const
   MaxBuffer = 256;
   BASE = 'http://www.irietools.com/';
var
   buffer : string[MaxBuffer];
   NewLocation : string;

   procedure Init;
   begin
      NewLocation := BASE
   end;

   procedure GenerateHTTPHeader;
   begin
      writeln('Content-type: text/html');
      writeln;
   end;

   procedure GetCGIData;
   var
      RequestMethod : string;

      procedure GetRequest;
      begin (* GetRequest *)
         buffer := getenv('QUERY_STRING')
      end; (* GetRequest *)

      procedure PostRequest;
      var
         len, i : 0..maxint;
         err : integer;
         ContentLength : string;
         c : char;
      begin (* PostRequest *)
         buffer := '';
         ContentLength := getenv('CONTENT_LENGTH');
         if ContentLength <> '' then
            val(ContentLength, len, err)
         else
            len := 0;
         if len <= MaxBuffer then
            for i := 1 to len do
            begin
               read(c);
               buffer := buffer + c
            end
      end; (* PostRequest *)

   begin (* GetCGIData *)
      RequestMethod := getenv('REQUEST_METHOD');
      if RequestMethod = 'GET' then
         GetRequest
      else
         PostRequest
   end; (* GetCGIData *)

   procedure ProcessCGIData;
   var
      i, num, p : integer;
      EncodedVariable, DecodedVariable, name, value : string;

      procedure ProcessNameValuePair(var name, value : string);
      begin
         if (name = 'lstnavigation') or
            (name = 'navigation') or
            (name = 'goto') then
            begin
               if value <> '[none]' then
                  if lowercase(copy(value, 1, 5)) = 'http:' then
                     NewLocation := value
                  else
                     NewLocation := BASE + value
            end
         else
            ; (* do nothing we have an undefined form element *)
      end;

   begin (* ProcessCGIData *)
      num := CountWords(buffer, '&');
      for i := 1 to num do
         begin
            EncodedVariable := CopyWord(buffer, i, '&');
            DecodedVariable := URLDecode(EncodedVariable);
            p := pos('=', DecodedVariable);
            if p > 0 then
               begin
                  name := lowercase(trim(copy(DecodedVariable, 1, p-1)));
                  value := lowercase(trim(copy(DecodedVariable, p+1)));
                  ProcessNameValuePair(name, value);
               end
         end
   end; (* ProcessCGIData *)

   procedure GenerateResponse;

      procedure GenerateHTMLHeader;
      begin
         writeln('<html>');
         writeln('<head>');
         writeln('<meta name="Description" content="Redirect New Location">');
         writeln('<meta http-equiv="Refresh" content="0;URL=', NewLocation, '">');
         writeln('<title>Redirect to New Location</title>');
         writeln('</head>');
      end;

      procedure GenerateHTMLFooter;
      begin
         writeln('<hr>');
         writeln('<p>');
         writeln('Redirect 1.0 Copyright &copy; 1999-2001, Stuart King<br>');
         writeln('Home page <a href="http://www.irietools.com/">www.irietools.com</a>');
         writeln('</p>');
         writeln('</body>');
         writeln('</html>');
      end;

   begin (* GenerateResponse *)
      GenerateHTMLHeader;
      writeln('<body bgcolor="#FFE8E8">');
      writeln('<p>You should be automatically taken to the next page.</p>');
      writeln('<p>However if your browser does not support redirection ');
      writeln('click <a href="', NewLocation, '">here</a></p>');
      GenerateHTMLFooter;
   end; (* GenerateResponse *)

begin
   GenerateHTTPHeader;
   Init;
   GetCGIData;
   ProcessCGIData;
   GenerateResponse;
end.

First the program calls GenerateHTTPHeader. This is just the familiar

      writeln('Content-type: text/html');
      writeln;

Then the program calls Init, which initializes the variable NewLocation, which is used to store the URL of the page to redirect to.

Then the program calls GetCGIData, which retrieves the name/value pairs passed to the CGI applications, whether from a GET request or a POST request, and stores them in a buffer.

NOTE: In addition to the information passed to CGI applications in environment variables (see cgiinfo), additional information can be sent to the application in the form of one or more of the following

name=value

where "name" identifies the information being passed
    and "value" is the actual contents being passed.

These are sometimes called "name/value" pairs.

Then the program calls ProcessCGIData, which seperates each name/value pair (name/value pairs are deliminated by "&" characters), and decodes them, then the "name" part is seperated from the "value" part, and then ProcessNameValuePair is called. ProcessNameValuePair checks to make sure that the "name" is one of the expected values, and updates the variable NewLocation with the URL of the page to redirect to. (which means that by passing the appropriate name/value pair to this program you can specify the URL of the page to redirect to).

Finally the program calls GenerateResponse, which generates the HTML header (using the meta-tag http-equiv to actually perform the redirection). GenerateReponse also generates a page body with a link to the new URL just in case the user's browser doesn't respond to the meta tag. Then GenerateResponse writes the HTML footer which is basically just a copyright notice.

To download click below:

Source code: redirect.pas (size=3,876 bytes)

If you are using the Irie Pascal IDE (available only in the Windows edition) then you might also want to download the IDE project file: redirect.ipj (size=1,720 bytes)

Next > CGIMail