Matthew Hipkin

CGI mailform using FreePascal

Download: http://www.matthewhipkin.co.uk/programs/mailform-example.zip
The first in a series of examples using FreePascal in a CGI environment.
A simple mail form that extracts the POSTed variables and sends an e-mail to the specified address.
Compile for the server OS, upload to cgi-bin directory and enjoy.
program mailform;

{$mode objfpc}{$H+}

// Requires synapse libraries from http://www.ararat.cz/synapse/doku.php/start
uses Classes, smtpsend, synacode;

{ Compile command line:
    fpc mailform.pas -Fupath/to/synapse -omailform.cgi
}    

type
  TArray = array of AnsiString;
  
const
  TARGETMAIL = 'me@myaddress.com';
  TARGETHOST = '127.0.0.1'; // Most hosting will have an SMTP server,
  TARGETPORT = '25';        // so no need to connect elsewhere

var
  postVar: AnsiString;
  postItems: TArray;
  c: Char;
  x: integer;
  name: String;
  email: String;
  message: TStrings;
  lTmp: String;
  rTmp: AnsiString;
  s: TSMTPSend;

// explode function from http://www.jasonwhite.co.uk/delphi-explode-function-like-php-explode/  
function explode(cDelimiter,  sValue : string; iCount : integer) : TArray;
var
  s : string; i,p : integer;
begin
  s := sValue; i := 0;
  while length(s) > 0 do
  begin
    inc(i);
    SetLength(result, i);
    p := pos(cDelimiter,s);
    if ( p > 0 ) and ( ( i < iCount ) OR ( iCount = 0) ) then
    begin
      result[i - 1] := copy(s,0,p-1);
      s := copy(s,p + length(cDelimiter),length(s));
    end else
    begin
      result[i - 1] := s;
      s :=  '';
    end;
  end;
end;

begin
  // Process post variables
  postVar := '';
  while not eof(input) do
  begin
     read(c);
     postVar := postVar + c;
  end;
  // Output content type header
  writeln('Content-Type:text/html',#10#13);
  // Output HTML
  writeln('<!DOCTYPE html>');  
  writeln('<html>');
  writeln('<head>');
  writeln('  <title>Mail form example</title>');
  writeln('</head>');  
  writeln('<body>');
  // If postVar isn't empty then the form has been submitted.
  if postVar <> '' then 
  begin
    // Create objects
    s := TSMTPSend.Create;
    message := TStringList.Create;
    // Split post variables into an array
    postItems := explode('&',postVar,0);
    // Process array, extract the name, email and message fields
    for x := 0 to High(postItems) do
    begin
      lTmp := Copy(postItems[x],1,Pos('=',postItems[x])-1);
      rTmp := Copy(postItems[x],Pos('=',postItems[x])+1,Length(postItems[x]));
      if lTmp = 'name' then name := DecodeURL(rTmp);
      if lTmp = 'email' then email := DecodeURL(rTmp);
      if lTmp = 'message' then message.Text := DecodeURL(rTmp);
    end;
    // Configure SMTP object
    s.TargetHost := TARGETHOST;
    s.TargetPort := TARGETPORT;
    // Connect to SMTP server
    if s.Login then
    begin
      // Send the message	
      s.MailFrom(name+' <'+email+'>', Length(name+' <'+email+'>'));
      s.MailTo(TARGETMAIL);
      s.MailData(message);
      s.Logout;
      writeln('  <p>Thank you, your message has been sent.</p>');
    end;
    // Clean up
    s.Free;
    message.Free;
  end
  else 
  begin
    // POST variable is empty, display the form
    writeln('  <form name="mailform" method="post">');
    writeln('    <table>');
    writeln('      <tr><td>Name</td><td><input type="text" name="name"></td></tr>');
    writeln('      <tr><td>E-mail</td><td><input type="text" name="email"></td></tr>');
    writeln('      <tr><td colspan="2"><textarea name="message"></textarea></td></tr>');
    writeln('      <tr><td colspan="2"><input type="submit" name="submit" value="Send"></td></tr>');
    writeln('    </table>');
    writeln('  </form>');
  end;
  writeln('</body>');
  writeln('</html>');    
end.