{$mode objfpc}{$H+}
uses
classes,fphttpapp,httpdefs,httpprotocol,httproute;
procedure Index(ARequest : TRequest; AResponse : TResponse);
var
i: Integer;
s: String;
begin
with AResponse.Contents do begin
Add('<html>');
Add(' <head>');
Add(' <title>Paypal Test Page</title>');
Add(' </head>');
Add(' <body>');
Add(' <h1>Paypal Test Page</h1>');
Add(' <form action="/pay" method="post">');
for i := 1 to 3 do begin
Str(i,s);
Add(' <label>Item</label><input type="text" name="item_name_' + s + '"/>');
Add(' <label>Price</label><input type="text" name="amount_' + s + '"/>');
Add(' <label>Quantity</label><input type="text" name="qty_' + s + '"/>');
Add(' <br />');
end;
Add(' <input type="submit" value="Checkout" />');
Add(' </form>');
Add(' </body>');
Add('</html>');
end
end;
procedure Pay(ARequest : TRequest; AResponse : TResponse);
function StringListToQueryString(sl: TStrings): String;
var
i: Integer;
OldDelimiter : Char;
OldStrictDelimiter: Boolean;
begin
for i := 0 to sl.Count - 1 do
sl.ValueFromIndex[i] := HTTPEncode(sl.ValueFromIndex[i]);
OldDelimiter := sl.Delimiter;
OldStrictDelimiter := sl.StrictDelimiter;
sl.Delimiter := '&';
sl.StrictDelimiter := true;
Result := sl.DelimitedText;
sl.Delimiter := OldDelimiter;
sl.StrictDelimiter := OldStrictDelimiter;
end;
var
PaypalParams: String;
begin
with ARequest.ContentFields do begin
Values['business'] := 'put.your@email.here';
Values['cmd'] := '_cart';
Values['upload'] := '1';
Values['currency_code'] := 'USD';
Values['charset'] := 'utf-8';
Values['custom'] := 'any custom data you wish to be sent back from notification, optional of course';
Values['notify_url'] := 'http://where.paypal.should/fire/back/for/notifying/you';
Values['return'] := 'http://where.paypal.should/redirect/user/after/payment';
Values['shipping_1'] := 'the chosen shipping method';
Values['discount_amount_cart'] := '0';
Values['tax_cart'] := '0';
Values['first_name'] := 'receiver first name';
Values['last_name'] := 'receiver last name';
Values['address1'] := 'address line 1';
Values['address2'] := 'address line 2';
Values['zip'] := '12345';
Values['city'] := 'Depok';
Values['state'] := 'West Java';
Values['country'] := 'Indonesia';
Values['night_phone_b'] := '021-112911388';
Values['email'] := 'receiver@email.address';
end;
PaypalParams := StringListToQueryString(ARequest.ContentFields);
AResponse.Code := 301;
AResponse.CodeText := 'Redirect';
AResponse.Location := 'https://www.paypal.com/cgi-bin/webscr?' + PaypalParams;
end;
begin
HTTPRouter.RegisterRoute('/',rmAll,@Index);
HTTPRouter.RegisterRoute('/pay',rmAll,@Pay);
Application.Port := 9999;
Application.Initialize;
Application.Run;
end.