Solved

Pascal -> Perl conversion needed

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

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Can I exclude specific directory with icacle command? 3 90
List all Printers with anmes and Ip address 3 47
size of file 1 37
Sleep one hour while in loop 4 44
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…
In threads here at EE, each comment has a unique Identifier (ID). It is easy to get the full path for an ID via the right-click context menu. However, we often want to post a short link within a thread rather than the full link. This article shows a…
The viewer will learn how to create a basic form using some HTML5 and PHP for later processing. Set up your basic HTML file. Open your form tag and set the method and action attributes.: (CODE) Set up your first few inputs one for the name and …
In this fourth video of the Xpdf series, we discuss and demonstrate the PDFinfo utility, which retrieves the contents of a PDF's Info Dictionary, as well as some other information, including the page count. We show how to isolate the page count in a…

751 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