Solved

Pascal -> Perl conversion needed

Posted on 2000-04-22
4
258 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
  • 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

Master Your Team's Linux and Cloud Stack

Come see why top tech companies like Mailchimp and Media Temple use Linux Academy to build their employee training programs.

Question has a verified solution.

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

If you get a (Blue Screen of Death), your system writes a small file called a minidump. Your first step is to make certain your computer is setup to record memory dumps. Right click My Computer, choose properties. Click on the advanced tab, an…
This tutorial will discuss the log-in process using WhizBase. In this article I assume you already know HTML. I will write the code using WhizBase Server Pages, so you need to know some basics in WBSP (you might look at some of my other articles abo…
Learn the basics of while and for loops in Python.  while loops are used for testing while, or until, a condition is met: The structure of a while loop is as follows:     while <condition>:         do something         repeate: The break statement m…
The viewer will learn how to create and use a small PHP class to apply a watermark to an image. This video shows the viewer the setup for the PHP watermark as well as important coding language. Continue to Part 2 to learn the core code used in creat…

828 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