Solved

Pascal -> Perl conversion needed

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

3 Use Cases for Connected Systems

Our Dev teams are like yours. They’re continually cranking out code for new features/bugs fixes, testing, deploying, testing some more, responding to production monitoring events and more. It’s complex. So, we thought you’d like to see what’s working for us.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Reading variable length EBCDIC in SAS 9 96
exchange 2007, scripts 15 71
exchange, scripts 3 60
AWS CLI issues with Tags 3 63
Making a simple AJAX shopping cart Couple years ago I made my first shopping cart, I used iframe and JavaScript, it was very good at that time, there were no sessions or AJAX, I used cookies on clients machine. Today we have more advanced techno…
This article is meant to give a basic understanding of how to use R Sweave as a way to merge LaTeX and R code seamlessly into one presentable document.
The viewer will learn the basics of jQuery, including how to invoke it on a web page. Reference your jQuery libraries: (CODE) Include your new external js/jQuery file: (CODE) Write your first lines of code to setup your site for jQuery.: (CODE)
In this fifth video of the Xpdf series, we discuss and demonstrate the PDFdetach utility, which is able to list and, more importantly, extract attachments that are embedded in PDF files. It does this via a command line interface, making it suitable …

912 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now