Solved

Pascal -> Perl conversion needed

Posted on 2000-04-22
4
266 Views
Last Modified: 2013-12-25
I am a shareware author and I want my soft-shop (an order processing company) to distribute my keys for me, but they need it in perl.
Here is the function in pascal
--code starts---

function GenKey(name,privatekey :string):string;

var code: string;
    i, bl: integer;
    ecx, checksum: longint;

begin
      for i:=1 to length(privatekey) do
            checksum := checksum + Ord(privatekey[i]);

      for i:=1 to length(name) do
            begin
                      if Ord(name[i]) = 44 then name[i]:=Chr($E9);
                        if Ord(name[i]) = 144 then name[i]:=Chr($C9);
                        if Ord(name[i]) = 198 then name[i]:=Chr($E3);
                        if Ord(name[i]) = 199 then name[i]:=Chr($C3);
                  ecx := (checksum shr 8) AND $FF;
                        name[i] := Chr((Ord(UpCase(name[i])) AND $FF) xor ecx);
                  ecx := Ord(name[i]);
                  checksum := (checksum + ecx) * $AD9C + $56CE;
            end;

      for i:=1 to 6 do
            begin
                      bl:=Ord(name[i]);
                  bl:=bl shr 4;
                   bl:=bl + $31;
                        if bl > $39 then bl:=bl+7;
                        code:=code+Chr(bl);

                  bl:=Ord(name[i]);
                  bl:=bl AND $0F;
                  bl:=bl+$31;
                  if bl > $39 then bl:=bl+7;
                  code:=code+Chr(bl);
            end;

      insert('A', code, 2);
        insert('AC', code, 5);
        result := code; //Return value is the serial number
end;

--code ends---

privatekey is a special string for each of my products. name is of course the name of the person that bought the product. the private key can be hardcoded at the top as a constant i can change.
It needs to work with the below form:
http://swreg.org/cgi-bin/key_gen_test.cgi

Obviously it needs to get the name passed to it and work out the serial, returning it between <softshop> and </softshop> as described on the website above (http://swreg.org/cgi-bin/key_gen_test.cgi)

200 points! please help!
0
Comment
Question by:hippoman
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
4 Comments
 

Accepted Solution

by:
davecee earned 200 total points
ID: 2740066
Here you go. I've assumed they have the module CGI.PM on their server, let me know if this is not the case. The code also assumes that the name is passed to the equivalent Delphi procedure without any space between the first name and surname, e.g. the name "John Waters" is passed as "JohnWaters".

 I've tested this with a few sample values against the Delphi code and it produces the same key code. I've deliberately left the Perl code as much like the original (looks like ported assembler!) as possible rather than writing it in idiomatic Perl, so that you can see what's going on.

 Regards,
 Dave

#!/usr/bin/perl
use strict;
use integer;
use CGI;

my $privatekey="Microsoftengineersareweenies";

############################################################################
sub GenKey
############################################################################
{
    my ($name, $privatekey) = @_;

    my ($i, $bx, $bl, $ecx, $checksum, $code);

    # This gets a 32-bit checksum
    $checksum = unpack("%32C*", $privatekey);

    # Gets array of characters as unsigned (32-bit) integers
    my @namechars = unpack("C*", $name);

    # Encode chars against checksum
    for ( $i=0; $i<$#namechars; $i++ ) {

        if ( $namechars[$i] == 44 ) {
            $namechars[$i] = 0xE9;
        }
        if ( $namechars[$i] == 144 ) {
            $namechars[$i] = 0xC9;
        }
        if ( $namechars[$i] == 198 ) {
            $namechars[$i] = 0xE3;
        }
        if ( $namechars[$i] == 199 ) {
            $namechars[$i] = 0xC3;
        }
        $ecx = ($checksum >> 8) & 0xff;
        $namechars[$i] = ord(uc(chr($namechars[$i]))) ^ $ecx;
        $ecx = $namechars[$i];
        # Keep checksum limited to 32 bits to match Delphi longint
        $checksum = ((($checksum + $ecx) * 0xAD9C) & 0xffffffff) + 0x56CE;
    }

    $code = '';
    for ( $i=0; $i<6; $i++ ) {
        $bl = $namechars[$i];
        $bl = $bl >> 4;
        $bl = $bl + 0x31;
        if ( $bl > 0x39 ) {
            $bl = $bl + 7;
        }
        $code = $code . chr($bl);
        $bl = $namechars[$i];
        $bl = $bl & 0xf;
        $bl = $bl + 0x31;
        if ( $bl > 0x39 ) {
            $bl = $bl + 7;
        }
        $code = $code . chr($bl);
    }

    $code = substr($code, 0, 1) . "A" . substr($code,1);
    $code = substr($code, 0, 4) . "AC" . substr($code,4);
    return $code;
}

$query = new CGI;
# Uncomment this next line and comment out the line above for testing without a web server
# my $query = new CGI('returned=o_no=0&mgr_name=&pub=&qty=&pc=&var=&del=&title=Mr&initals=John&name=Waters&add1=&add2=&add3=&add4=&add5=&d_title=Mr&d_initals=Danny&d_name=Bogus&d_add1=&d_add2=&d_add3=&d_add4=&d_add5=&d_add6=&co_name=&d_co_name=&email=&phone=&ip=&user_text=');

print "Content-type: text/html\n\n";
my $code = GenKey($query->param('initals') . $query->param('name'), $privatekey);
print "<softshop>$code</softshop>";
0
 

Expert Comment

by:davecee
ID: 2740085
P.S. Sorry, this line:

$query = new CGI;

 should of course be

my $query = new CGI;

 Dave
0
 

Author Comment

by:hippoman
ID: 2740103
Brilliant!
my $code = GenKey($query->param('initals') . " " . $query->param('name'), $privatekey);

Only modification I needed was I had to add " " so there was a space between the first & last name.
0
 

Author Comment

by:hippoman
ID: 2740106
Heres a grade A
0

Featured Post

Get HTML5 Certified

Want to be a web developer? You'll need to know HTML. Prepare for HTML5 certification by enrolling in July's Course of the Month! It's free for Premium Members, Team Accounts, and Qualified Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this tutorial I will show you how to provide a dynamic RTF document on your website generated with data from your database. For this tutorial you will need Microsoft Word or WordPad, WhizBase and Microsoft Access. In this tutorial I will show …
In this tutorial I will show you how to make a simple HTML bar chart with the usage of WhizBase, If you want more information about WhizBase please read my previous articles at http://www.experts-exchange.com/ARTH_5123186.html (http://www.experts-ex…
Learn the basics of lists in Python. Lists, as their name suggests, are a means for ordering and storing values. : Lists are declared using brackets; for example: t = [1, 2, 3]: Lists may contain a mix of data types; for example: t = ['string', 1, T…
In a recent question (https://www.experts-exchange.com/questions/29004105/Run-AutoHotkey-script-directly-from-Notepad.html) here at Experts Exchange, a member asked how to run an AutoHotkey script (.AHK) directly from Notepad++ (aka NPP). This video…

626 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question