Genering af password

Har fået dette fra Jens B engang

procedure TdlgPassword.FastCrypt(ptrBuffer: Pointer; iSize: Integer; uiInit: Byte = $00);
var
  iIdx      : Integer;
  uiCurrByte : Integer;
  uiLastByte : Integer;
begin
  uiLastByte := 0;

  for iIdx := 1 to iSize do
  begin
    uiCurrByte := Byte(ptrBuffer^);
    uiCurrByte := uiCurrByte xor uiLastByte;
    uiCurrByte := not uiCurrByte;
    uiCurrByte := uiCurrByte xor uiInit;
    uiCurrByte := ((uiCurrByte and $0F) shl 4) or ((uiCurrByte and $F0) shr 4);
    uiLastByte := uiCurrByte;
    Char(ptrBuffer^) := Char(uiCurrByte);
    inc(pChar(ptrBuffer));
  end;
end;

procedure TdlgPassword.FastDeCrypt(ptrBuffer: Pointer; iSize: Integer; uiInit: Byte = $00);
var
  iIdx      : Integer;
  uiCurrByte : Byte;
  uiLastByte : Byte;
begin
  uiLastByte := 0;
  for iIdx := 1 to iSize do
  begin
    uiCurrByte := Byte(ptrBuffer^);
    uiCurrByte := ((uiCurrByte and $0F) shl 4) or ((uiCurrByte and $F0) shr 4);
    uiCurrByte := uiCurrByte xor uiInit;
    uiCurrByte := not uiCurrByte;
    uiCurrByte := uiCurrByte xor uiLastByte;
    uiLastByte := Byte(ptrBuffer^);
    Char(ptrBuffer^) := char(uiCurrByte);
    inc(pChar(ptrBuffer));
  end;
end;

Kaldes med:
  InStr:= AnsiUpperCase(PChar(ePassword.Text));
  FastCrypt(pointer(InStr), length(InStr));

Her kan du jo bare bruge LowerCase istedet

Hvor får du passwordet ud?
Jeg har deklareret InStr som en String. Jeg forventer at passwordet bliver lagt i InStr, men det ser ikke sådan ud.
Jeg synes heller ikke at mit format bliver overholdt.

Den her forudsætter at både for og efternavn er på mindst 6 bogstaver ....

Ellers kan du jo bare hacke den om

procedure TForm1.Button1Click(Sender: TObject);
var
  FirstName, LastName: string;
  Res: string;

  procedure GetChar(Min, Max, Index: Integer);
  begin
    Res[Index] := char(Integer(FirstName[Index]) + Integer(LastName[Index]));
    if Integer(Res[Index]) > Max then
      Res[Index] := char(Integer(Res[Index]) mod (Max - Min) + Min);
  end;

begin
  FirstName := Edit1.Text;
  LastName := Edit2.Text;

  SetLength(Res, 7);
  GetChar(65, 90, 1);
  GetChar(65, 90, 2);
  GetChar(48, 58, 3);
  GetChar(48, 58, 4);
  GetChar(48, 58, 5);
  GetChar(48, 58, 6);

  Edit3.Text := Res;

end;


Jens B

morten_s>> De der krypterings dimser tænkte jeg også på .. men de overholder ikke den med xx1234
Jens B

Jens.B> Det må han jo så checke for inden han kryptere, den fungere ellers fint her hos mig

Den virker sådan her
1. start nyt projekt med form + 2 edit bokse + 2 button
2. brug nedenstående kode

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure FastCrypt(ptrBuffer: Pointer; iSize: Integer; uiInit: Byte = $00);
    procedure FastDeCrypt(ptrBuffer: Pointer; iSize: Integer; uiInit: Byte = $00);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.FastCrypt(ptrBuffer: Pointer; iSize: Integer; uiInit: Byte = $00);
var
  iIdx      : Integer;
  uiCurrByte : Integer;
  uiLastByte : Integer;
begin
  uiLastByte := 0;

  for iIdx := 1 to iSize do
  begin
    uiCurrByte := Byte(ptrBuffer^);
    uiCurrByte := uiCurrByte xor uiLastByte;
    uiCurrByte := not uiCurrByte;
    uiCurrByte := uiCurrByte xor uiInit;
    uiCurrByte := ((uiCurrByte and $0F) shl 4) or ((uiCurrByte and $F0) shr 4);
    uiLastByte := uiCurrByte;
    Char(ptrBuffer^) := Char(uiCurrByte);
    inc(pChar(ptrBuffer));
  end;
end;

procedure TForm1.FastDeCrypt(ptrBuffer: Pointer; iSize: Integer; uiInit: Byte = $00);
var
  iIdx      : Integer;
  uiCurrByte : Byte;
  uiLastByte : Byte;
begin
  uiLastByte := 0;
  for iIdx := 1 to iSize do
  begin
    uiCurrByte := Byte(ptrBuffer^);
    uiCurrByte := ((uiCurrByte and $0F) shl 4) or ((uiCurrByte and $F0) shr 4);
    uiCurrByte := uiCurrByte xor uiInit;
    uiCurrByte := not uiCurrByte;
    uiCurrByte := uiCurrByte xor uiLastByte;
    uiLastByte := Byte(ptrBuffer^);
    Char(ptrBuffer^) := char(uiCurrByte);
    inc(pChar(ptrBuffer));
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  InStr: String;
begin
  InStr:= PChar(Edit1.Text);
  FastCrypt(pointer(InStr), length(InStr));
  Edit2.Text:= InStr;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  InStr: String;
begin
  InStr:= PChar(Edit2.Text);
  FastDeCrypt(pointer(InStr), length(InStr));
  Edit1.Text:= InStr;
end;

end.

Jens' løsning fungerer godt nok, men jeg kunne godt tænke mig at få at vide, hvordan Morten får sin løsning til at fungere.

>Morten
Den kryptering du foreslår, kan ikke bruges til et password, som en bruger skal indtaste.

Nu har jeg ikke gennemlæst de ovenstående forslag, men her er mit - og det er lo-tech erkender jeg, men det er det jo også at have et password der ikke er fuldstændig tilfældig.

procedure TfrmMain.Button6Click(Sender: TObject);

  // Name is given in the format: 'Surname, Firstname(s)'
  function GetInitials(aName : string) : string;
  var
    p : integer;
    Surname, FirstNames : string;
  begin
    p := pos(',',aName);
    Surname := copy(aName,1,p-1);
    FirstNames := trim(copy(aName,p+1,length(aName) - p));

    result := LowerCase(FirstNames[1] + Surname[1]);
  end;

  function GetPassword(aName : string) : string;
  var
    st, Work : string;
    i : integer;
    pName : pchar;
    aHash : array[0..19] of byte;
  begin
    GetMem(pName,40+1);

    DCP_md51 := TDCP_md5.Create(self);
    try
      st := GetInitials(aName);

      DCP_md51.Init;

      StrPCopy(pName,aName);
      DCP_md51.Update(pName,strlen(pName));
      DCP_md51.Final(aHash);

      // Af de 20 tal som hash-algoritmen generer tager jeg det bagerste ciffer
      // af de seks første. Eksempelvis bliver 120 12 34 54 27 32 til 024472
      // Det er langtfra sikkert, men alternativet er at gemme navn og password i
      // en tabel - og det ligger ikke i oplægget fra nca
      for i := 0 to 5 do begin
        work := IntToStr(aHash[i]);
        st := st + copy(Work,length(Work),1);
      end; // for

// Hvis man vil se HASH'en
//      for i := 0 to 19 do
//        st := st + IntToHex(aHash[i],2) + ' ';

      result := st;
    finally
      DCP_md51.Free;
      FreeMem(pName);
    end; // try
  end;

begin
  MessageDlg(GetPassword('Voigt, Pelle'), mtInformation, [mbOK], 0);
end;


De udemærkede hach og krypterings komponenter har jeg fra http://www.cityinthesky.co.uk/

>>hrc
Hvad er DCP_md51 og TDCP_md5

>>hrc
Jeg tror jeg har fundet pakken, men findes der ikke en version til Delphi 7?

Det er en gratis samling hash og krypteringskomponenter som jeg bruger. MD5 er den hyppigst brugte hash-algoritme som man kan bruge til at lave et eller andet om til en (med ret stor sikkerhed) unik 20 tegns indifikation.

Man bruger det bl.a. på eDonkey hvor filerne identificeres via deres hash-nummer - på den måde er det underordnet hvad navn filerne har.

Jeg ville gerne - sådan lige her - have lavet en hash-algoritmen til at generere en 6-tegns identifikator så den kunne komme i enden af initialerne, men det fik jeg ikke lige ordnet - mit forslag er en derfor kun en halv løsning men hvor der er meget lille sandsynlighed for at der kommer overlap.

I øvrigt. Har man normalt ikke brugerens initialer som ID mens password er noget "tilfældigt"?. Er det nødvendigt at password indeholder initialerne?

Det skal du ikke tage så tungt - den fungerer fint på min D7'er.

Alle 6 tegn i passwordet er tilfældige tegn, altså er de to første bogstaver ikke brugernes initialer.
Jeg har ca. 18.000 brugere som jeg skal holde styr på. Desværre har jeg været ude for, at jeg har fået leveret forkerte data, så jeg har været nødt til at lave mine nyoprettelser om EFTER at brugerne har fået en mail om deres brugerid og pw. Derfor vil jeg gerne kunne køre en brugeroprettelse 2 gange og være sikker på, at passwordet bliver ens hver gang.

// Name is given in the format: 'Surname, Firstname(s)'
  function GetPassword(aName : string) : string;
  var
    Work : string;
    i, j, k : integer;
    p, x, x1, x2 : integer;
    Surname, FirstNames : string;
    pwd : array[0..7] of char;
  begin
    p := pos(',',aName);
    Surname := LowerCase(copy(aName,1,p-1));
    FirstNames := LowerCase(trim(copy(aName,p+1,length(aName) - p)));

    x1 := 0; x2 := 0;
    for i := 1 to length(Firstnames) do // Summarize
      inc(x1,ord(Firstnames[i]));

    for i := 1 to length(Surname) do //  Summarize
      inc(x2,ord(Surname[i]));

    pwd[0] := chr(ord('a') + x1 mod 27); // A prime number (important when hashing)
    pwd[1] := chr(ord('a') + x2 mod 27);

    // Must use at least 28 chars to generate 6 digits
    Work := '';
    repeat
      Work := Work + (FirstNames + Surname);
    until length(Work) >= 28;

    // For each digit we need
    for i := 0 to 5 do begin
      x := 0;

      // Summarize sets of four chars
      for j := 1 to 4 do
        inc(x,ord(Work[i shl 2+j]));

      // Don't know how much it matters not to use a prime number
      k := x mod 10; // Do a modulo 10 to get a number
      pwd[i+2] := chr(k + 48); // Convert to ascii
    end; // for
    result := string(pwd);
  end;

Jeg har brygget ovenstående sammen, men både med komponent-hashing fra tidligere og denne, så er der problemet med navnesammenfald. Det er ikke utænkeligt at du blandt 18 brugere støder på "Jensen, Peter". Hvad gør du der? Tilføjer et indeksnummer: "Jensen, Peter 1"?