Solved

Pascal -> Perl conversion needed

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

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

It is becoming increasingly popular to have a front-page slider on a web site. Nearly every TV website,  magazine or online news has one on their site, and even some e-commerce sites have one. Today you can use sliders with Joomla, WordPress or …
This article will show, step by step, how to integrate R code into a R Sweave document
Learn the basics of strings in Python: declaration, operations, indices, and slicing. Strings are declared with quotations; for example: s = "string": Strings are immutable.: Strings may be concatenated or multiplied using the addition and multiplic…
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…

760 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

22 Experts available now in Live!

Get 1:1 Help Now