mibuso.com

Microsoft Business Solutions online community
It is currently Thu May 23, 2013 7:50 pm

All times are UTC + 1 hour [ DST ]




Post new topic Reply to topic  [ 1 post ] 
Author Message
 Post subject: Simple crypt functions
PostPosted: Thu Jun 12, 2008 12:57 pm 
Offline

Joined: Wed May 10, 2006 11:25 am
Posts: 149
Location: Kiev
Country: Ukraine (ua)
Hi All

Simple crypt method base on key and ... cards :D :D

Code: Select all
OBJECT Codeunit 70000 Crypto Cards
{
  OBJECT-PROPERTIES
  {
    Date=12-06-08;
    Time=[ 1:48:12 ];
    Modified=Yes;
    Version List=;
  }
  PROPERTIES
  {
    OnRun=BEGIN
            Code('c:\cards.key','c:\file.txt','c:\file.___');
            Decode('c:\cards.key','c:\file.___','c:\file2.txt');
          END;

  }
  CODE
  {
    VAR
      Cards@1000 : ARRAY [256] OF Integer;

    LOCAL PROCEDURE Initialize@2();
    VAR
      i@1000 : Integer;
    BEGIN
      FOR i := 0 TO 255 DO
        Cards[i+1] := i;
    END;

    LOCAL PROCEDURE Shuffle@1();
    VAR
      p@1002 : ARRAY [2] OF Integer;
      i@1000 : Integer;
    BEGIN
      FOR i := 1 TO RANDOM(10) DO
        p[1] := RANDOM(256);
      FOR i := 1 TO RANDOM(10) DO
        p[2] := RANDOM(256);

      Cards[p[1]] := Cards[p[1]] - Cards[p[2]];
      Cards[p[2]] := Cards[p[1]] + Cards[p[2]];
      Cards[p[1]] := Cards[p[2]] - Cards[p[1]];
    END;

    LOCAL PROCEDURE Save@3(Name@1000 : Text[250]);
    VAR
      F@1001 : File;
      i@1002 : Integer;
      c@1003 : Char;
    BEGIN
      F.TEXTMODE := FALSE;
      F.WRITEMODE := TRUE;
      F.CREATE(Name);
      FOR i := 1 TO 256 DO BEGIN
        c := Cards[i];
        F.WRITE(c);
      END;
      F.CLOSE;
    END;

    PROCEDURE CreateCards@4(Name@1000 : Text[250]);
    VAR
      i@1001 : Integer;
    BEGIN
      Initialize();

      RANDOMIZE;
      FOR i := 1 TO 10000 DO
        Shuffle();

      Save(Name);
    END;

    PROCEDURE Load@5(Name@1000 : Text[250]);
    VAR
      F@1001 : File;
      i@1002 : Integer;
      c@1003 : Char;
    BEGIN
      F.TEXTMODE := FALSE;
      F.WRITEMODE := TRUE;
      F.OPEN(Name);
      FOR i := 1 TO 256 DO BEGIN
        F.READ(c);
        Cards[i] := c;
      END;
      F.CLOSE;
    END;

    PROCEDURE Code@6(pStrCards@1007 : Text[250];pStrSource@1000 : Text[250];pStrTarget@1006 : Text[250]);
    VAR
      inf@1001 : File;
      c@1002 : Char;
      i@1003 : Integer;
      outf@1004 : File;
      p@1005 : Integer;
    BEGIN
      CreateCards(pStrCards);

      inf.TEXTMODE := FALSE;
      inf.OPEN(pStrSource);

      outf.TEXTMODE := FALSE;
      outf.WRITEMODE := TRUE;
      outf.CREATE(pStrTarget);

      p := 13;
      WHILE inf.LEN <> inf.POS DO BEGIN
        inf.READ(c);
        i := c + Cards[p];
        IF i > 255 THEN
          i := i - 256;
        c := i;
        outf.WRITE(c);
        p := (255 MOD (p + inf.POS)) + 1;
      END;

      outf.CLOSE;
      inf.CLOSE;
    END;

    PROCEDURE Decode@7(pStrCards@1007 : Text[250];pStrSource@1006 : Text[250];pStrTarget@1005 : Text[250]);
    VAR
      inf@1004 : File;
      c@1003 : Char;
      i@1002 : Integer;
      outf@1001 : File;
      p@1000 : Integer;
    BEGIN
      Load(pStrCards);

      inf.TEXTMODE := FALSE;
      inf.OPEN(pStrSource);

      outf.TEXTMODE := FALSE;
      outf.WRITEMODE := TRUE;
      outf.CREATE(pStrTarget);

      p := 13;
      WHILE inf.LEN <> inf.POS DO BEGIN
        inf.READ(c);
        i := c;
        IF i < Cards[p] THEN
          i := i + 256;
        c := i - Cards[p];
        outf.WRITE(c);
        p := (255 MOD (p + inf.POS)) + 1;
      END;

      outf.CLOSE;
      inf.CLOSE;
    END;

    BEGIN
    END.
  }
}


_________________
Yaroslav Gaponov


Top
 Profile E-mail WWW  
 
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 1 post ] 

All times are UTC + 1 hour [ DST ]


Who is online

Users browsing this forum: No registered users and 2 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot post attachments in this forum


Search for:
Jump to: