unit frmMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, KeePassApi_dynamic, pfgDbSave, md5, DCPcrypt2, DCPblockciphers,
  DCPdes, DCPmd5, Mask, ToolEdit, rmar;

type
  TfrmMainForm = class(TForm)
    Button1: TButton;
    memLog: TMemo;
    lblLog: TLabel;
    btnDecodePdb: TButton;
    Button3: TButton;
    DCP_3des: TDCP_3des;
    Hash: TDCP_md5;
    btnSave: TButton;
    fedtKeePassDatabase: TFilenameEdit;
    fedtPalmPdb: TFilenameEdit;
    lblKeePassFilename: TLabel;
    Label2: TLabel;
    edtPassword: TEdit;
    lblPassword: TLabel;
    btnConvert: TButton;
    Button2: TButton;
    Procedure InitCategories(PDB : TpfgPalmDbFile);
    Procedure AppendFirstRecord(PDB : TpfgPalmDbFile);
    Procedure InitCrypto;
    Procedure InitHeader(PDB : TpfgPalmDbFile);
    Procedure DecodeBlock(var DataBlock : Array of byte);
    Procedure EncodeBlock(var DataBlock : Array of Byte);
    Procedure CreateDataBlock(Title, Username, Password, Note : String; var PDataBlock : Pointer; var Size : Integer);
//    procedure Button1Click(Sender: TObject);
//    procedure btnDecodePdbClick(Sender: TObject);
//    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
//    procedure btnSaveClick(Sender: TObject);
    procedure btnConvertClick(Sender: TObject);
    procedure fedtKeePassDatabaseChange(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure fedtKeePassDatabaseAfterDialog(Sender: TObject;
      var Name: String; var Action: Boolean);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    Digest : MD5Digest;
//    Pass   : String;
    Salt   : Array[0..3] of Byte;
  public
    { Public declarations }
  end;

var
  frmMainForm: TfrmMainForm;


implementation

{$R *.DFM}

(*procedure TfrmMainForm.Button1Click(Sender: TObject);
var
  mgr : Pointer;
  strPassWord : PChar;
  strFile : PChar;
  Version : PChar;
  Repair : Pointer;
  Result : Integer;
  EntryCount : Integer;
  PItem : Pointer;
  Index : Cardinal;
  Title : PChar;
  Username : PChar;
  Password : PChar;
//  Data : String;
begin
  strPassword := 'testpass';
  strFile := 'C:\Delphi\KeePass\GuiTest\testdb.kdb';

  InitManager(mgr, False);
  Try
    SetMasterKey(mgr, strPassword, false, nil, 0, false);

    Repair := nil;
    Result := OpenDatabase(mgr, strFile, Repair);
    memLog.Lines.Add(Format('Opendatabase result: %d',[Result]));

    If Result = 1 then begin

      EntryCount := GetNumberOfEntries(mgr);
      memLog.Lines.Add(Format('Number of entries: %d',[EntryCount]));

//      If entryCount > 0 then begin
      For Index := 0 to EntryCount-1 do begin
//        Index := 0;
        PItem := GetEntry(mgr,Index);
//        PItem := GetLastEditedEntry(mgr);
        If PItem <> nil then begin
          memLog.Lines.Add(Format('Index: %d',[Index]));
          Title := PE_GetTitle(PItem);
          memLog.Lines.Add(Format('Title: %s',[Title]));
          Username := PE_GetUserName(PItem);
          memLog.Lines.Add(Format('Username: %s',[Username]));
          Password := PE_GetPasswordPtr(PItem);
          memLog.Lines.Add(Format('Password: %s',[Password]));
          UnlockEntryPassword(mgr,PItem);
          Password := PE_GetPasswordPtr(PItem);
          memLog.Lines.Add(Format('Password: %s',[Password]));
        end;
      end;
    End;
  finally
//    DeleteManager(mgr);
  end;
end;
*)
Function TruncateString(s : String) : String;
Var
  I : Integer;
begin
  I := 1;
  While (I < Length(S)) and (S[I] <> Chr(0)) do
    Inc(I);
  SetLength(S,I-1);
  Result := S;
end;

Function PrintHex(H : Array of Byte) : String;
var
  i : Integer;
begin
  Result := '';
  For I := 0 to Length(H)-1 do begin
    Result := Result + format('%.2x',[H[i]]);
  end;
end;

Function PrintChar(H : Array of Byte) : String;
var
  i : Integer;
begin
  Result := '';
  For I := 0 to Length(H)-1 do begin
    If (H[i] < 32) or (H[i] > 122) then
      Result := Result + Format('$%.2x',[H[i]])
    else
      Result := Result + Chr(H[i]);
  end;
end;


Function GetString(Buf : Array Of Byte; Start : Integer; var Index : Integer) : String;
var
  I : Integer;
begin
  I := Start;
  Result := '';
  While (i < Length(Buf)) and (Buf[i] <> 0) do begin
    Result := Result + Chr(Buf[i]);
    inc(I);
  end;
  Index := I+1;
end;

Function SwapLongWord(LW : LongWord) : LongWord;
var
  Hi : LongWord;
  Lo : Word;
begin
  Lo := LW shr 16;
  Hi := (LW and $FFFF) shl 16;
  Result := HI or Lo;
end;

Function PalmDateToDateTime(PDate : Word) : TDateTime;
var
  Day, Month, Year : Word;
begin
  // DateType (2 bytes): 7 bit year, 4 bit month, 5 bit day
  Day := PDate and $1f;
  Month := PDate and $1e0 shr 5;
  Year := (PDate and $FE00 shr 9) + 1904;
  Result := EncodeDate(Year,Month,Day);
end;

Function DateTimeToPalmDate(DateTime : TDateTime) : Word;
var
  Day, Month, Year : Word;
begin
  DecodeDate(DateTime,Year,Month,Day);
  Month := Month shl 5;
  Year := (Year - 1904) shl 9;
  Result := Day + Month + year;
end;

Procedure TfrmMainForm.DecodeBlock(var DataBlock : Array of byte);
var
  BufEnc,BufDec : Array[0..7] of byte;
  BlockCount : Integer;
  LengthEncrypted : Integer;
  I : Integer;
begin
  LengthEncrypted := Length(DataBlock);
  // Decrypt in Blocks of 8 bytes
  BlockCount := LengthEncrypted div 8;
  For I := 0 to BlockCount-1 do begin
    Move(DataBlock[I*8],BufEnc[0],8);
    FillChar(BufDec,8,#0);
    // Try to decrypt
    DCP_3des.DecryptECB(BufEnc,BufDec);
    // Add to full decrypted buffer
    Move(BufDec[0],DataBlock[I*8],8);
  end;
end;

Procedure TfrmMainForm.EncodeBlock(var DataBlock : Array of Byte);
var
  BufEnc,BufDec : Array[0..7] of byte;
  BlockCount : Integer;
  LengthEncrypted : Integer;
  I : Integer;
begin
  LengthEncrypted := Length(DataBlock);
  // Encrypt in Blocks of 8 bytes
  BlockCount := LengthEncrypted div 8;
  For I := 0 to BlockCount-1 do begin
    Move(DataBlock[I*8],BufEnc[0],8);
    FillChar(BufDec,8,#0);
    // Try to decrypt
    DCP_3des.EncryptECB(BufEnc,BufDec);
    // Put back in Datablock
    Move(BufDec[0],DataBlock[I*8],8);
  end;
end;

Procedure TfrmMainForm.CreateDataBlock(Title, Username, Password, Note : String; var PDataBlock : Pointer; var Size : Integer);
var
  DataBlock : Array of Byte;
  DataBlockLength : Integer;
  CryptoBlock : Array of Byte;
  CryptoBlockLength : Integer;
  Index : Integer;
  BlockCount : Integer;
  PalmDate : Word;
begin
  CryptoBlockLength := Length(Username) + 1 + Length(Password) + 1 + Length(Note) + 1 + 2;
  If CryptoBlockLength mod 8 <> 0 then begin
    BlockCount := CryptoBlockLength div 8;
    // Use only full 8 byte blocks
    CryptoBlockLength := (BlockCount+1) * 8;
  end;
  Index := 0;
  SetLength(CryptoBlock,CryptoBlockLength);
  Move(Username[1],CryptoBlock[Index],Length(Username));
  Inc(Index,Length(Username)+1);
  Move(Password[1],CryptoBlock[Index],Length(Password));
  Inc(Index,Length(Password)+1);
  Move(Note[1],CryptoBlock[Index],Length(Note));
  Inc(Index,Length(Note)+1);
  PalmDate := DateTimeToPalmDate(Date);
  CryptoBlock[Index] := PalmDate shr 8;
  CryptoBlock[Index+1] := PalmDate and $FF;
//  Move(PalmDate,CryptoBlock[Index],2);

  EncodeBlock(CryptoBlock);

  DataBlockLength := Length(Title) + 1 + CryptoBlockLength;

  SetLength(DataBlock,DataBlockLength);
  Move(Title[1],DataBlock[0],Length(Title));
  Move(CryptoBlock[0],DataBlock[Length(Title)+1],CryptoBlockLength);

  getMem(PDataBlock,DataBlockLength);
  Move(DataBlock[0],PDataBlock^,DataBlockLength);
  Size := DataBlockLength;
end;

(*procedure TfrmMainForm.btnDecodePdbClick(Sender: TObject);
var
  PDB : TpfgPalmDbFile;
  Filename : String;
  RecCount : Integer;
  Attributes: Byte;
  ID: LongWord;
  Index : Integer;
  Category: Shortint;
  Data: Pointer;
  DataSize: Integer;
  strTitle : String;
  FullBuf : Array of Byte;
  DataBlock : Array of Byte;
  StartOfEncrypted : Integer;
  LengthEncrypted : Integer;
  I : Integer;
  strAccount, strPassWord, strNote : String;
  PalmDate : Word;
  InternalDate : TDateTime;
  strDate : String;
begin
  FileName := 'C:\Delphi\KeePass\GuiTest\Keyring_testpass.pdb';
//  FileName := 'C:\Delphi\KeePass\GuiTest\Keyring_decrpted.pdb';
  PDB := TpfgPalmDbFile.Create(Filename, dbReadOnly);
  Try
    RecCount := PDB.RecordCount;
    If RecCount > 0 then begin
      Index := 0;
      PDB.GetRecord(Index, Attributes, ID, Category, Data, DataSize);
      SetLength(FullBuf,DataSize);
      Move(Data^,FullBuf[0],DataSize);
      MemLog.Lines.Add(PrintHex(FullBuf));
      Inc(index);
      While (Index < RecCount) and (Index < 3) do begin
        PDB.GetRecord(Index, Attributes, ID, Category, Data, DataSize);

        // Move the data to an array of byte;
        SetLength(FullBuf,DataSize);
        Move(Data^,FullBuf[0],DataSize);

        // Get the title string from the buf and determine the start of the encrypted datablock
        strTitle := GetString(FullBuf,0,StartOfEncrypted);

        LengthEncrypted := DataSize-StartOfEncrypted;
        SetLength(DataBlock,LengthEncrypted);

        // Put encrypted data in seperate datablock
        Move(FullBuf[StartOfEncrypted],DataBlock[0],LengthEncrypted);

        // Decode the ecrypted datablock
        DecodeBlock(DataBlock);

        strAccount := GetString(DataBlock,0,I);
        strPassWord := GetString(DataBlock,I,I);
        strNote := GetString(DataBlock,I,I);
        PalmDate := DataBlock[i+1] + DataBlock[i] shl 8;
        InternalDate := PalmDateToDateTime(PalmDate);
        strDate := DateTimeToStr(InternalDate);

        Memlog.Lines.Add(Format('%s,%s,%s,%s,%s',[strTitle, strAccount, strPassWord, strNote,strDate]));

        inc(Index);
      end;
      DCP_3des.Burn;
    end;
  finally
    PDB.Free;
  end;
end;
*)
(*procedure TfrmMainForm.Button3Click(Sender: TObject);
var
  Salt: array[0..3] of byte;
  HashDigest: array of byte;   // the result of hashing the passphrase with the salt
begin
//  Memlog.Lines.Add(MD5Print(Digest));
  Salt[0] := $4A;
  Salt[1] := $65;
  Salt[2] := $93;
  Salt[3] := $EE;
  SetLength(HashDigest,16);
  Hash.Init;
//  Hash.Update(Salt[0],Sizeof(Salt));   // hash the salt
  Hash.UpdateStr(pass);  // and the passphrase
  Hash.Final(HashDigest[0]);           // store the output in HashDigest
  MemLog.Lines.Add(PrintHex(HashDigest));
end;
*)
procedure TfrmMainForm.FormCreate(Sender: TObject);
begin
  memLog.Lines.Add(format('KeePass API dll version: %s',[GetKeePassVersionString]));
end;

Const
  CategorySize = 276;

(*procedure TfrmMainForm.btnSaveClick(Sender: TObject);
var
  PDB : TpfgPalmDbFile;
  Buf : Array of byte;
  P : Pointer;
  Size : Integer;
  B : Byte;

begin
  PDB := TpfgPalmDbFile.Create('C:\Delphi\KeePass\GuiTest\Keyring_decrpted.pdb',dbReadWrite);
  Try
    PDB.DbName := 'Keys-Gtkr';
    PDB.Attributes := $08;
    PDB.Version := $04;  // Version 4 database
    PDB.CreationDate := Date;
    PDB.ModificationDate := Date;
    PDB.LastBackupDate := Date;
    PDB.Creator := $47746b72;
    PDB.DbType := $476B7972;
    PDB.ModificationNumber := $17;
    PDB.UniqueIDSeed := 707686514;

    SetLength(Buf,20);
    Buf[0] := $A7;
    Buf[1] := $1A;
    Buf[2] := $71;
    Buf[3] := $F0;
    Move(Digest[0],Buf[4],16);

    InitCategories(PDB);

    PDB.RecordCount := 3;

    GetMem(P,20);
    Move(Buf[0],P^,20);

    PDB.SetRecord(0,80,1,0,P,20);
    //some email account,emailaccount,123456789,Note: reading my email,8-1-2006
    CreateDataBlock('some email account','emailaccount','123456789','Note: reading my email',P,Size);
    PDB.SetRecord(1,64,2,0,P,Size);
    CreateDataBlock('Second test','testuser1','Testpass1','Note 2',P,Size);
    PDB.SetRecord(2,64,3,0,P,Size);
    PDB.Flush;
  finally
    PDB.Free;

  end;

end;
*)
Procedure TfrmMainForm.InitCategories(PDB : TpfgPalmDbFile);
var
  CategoryList : Array[0..275] of char;
  B : Byte;
begin
    FillChar(CategoryList,276,#0);
    CategoryList[0] := Chr($0);
    CategoryList[1] := Chr($1F);

    Move('Unfiled',CategoryList[2+0],7);
    Move('Banking',CategoryList[2+16],7);
    Move('Computer',CategoryList[2+32],8);
    Move('Phone',CategoryList[2+48],5);
    Move('Web',CategoryList[2+64],3);

    For B := 0 to 15 do
      CategoryList[2+256+B] := Chr(B);

    CategoryList[274] := Chr($0F);
    CategoryList[275] := Chr($00);

    PDB.AppInfo.Write(CategoryList,CategorySize);
end;

Procedure TfrmMainForm.AppendFirstRecord(PDB : TpfgPalmDbFile);
var
  Buf : Array[0..19] of byte;
  RecordPointer : Pointer;
begin
  Move(Salt[0],Buf[0],4);
  Move(Digest[0],Buf[4],16);
  GetMem(RecordPointer,20);
  Move(Buf[0],RecordPointer^,20);
  PDB.SetRecord(0,80,1,0,RecordPointer,20);
  FreeMem(RecordPointer,20);
end;

Procedure TfrmMainForm.InitHeader(PDB : TpfgPalmDbFile);
begin
  PDB.DbName := 'Keys-Gtkr';
  PDB.Attributes := $08;
  PDB.Version := $04;  // Version 4 database
  PDB.CreationDate := Date;
  PDB.ModificationDate := Date;
  PDB.LastBackupDate := Date;
  PDB.Creator := $47746b72;
  PDB.DbType := $476B7972;
  PDB.ModificationNumber := $17;
  PDB.UniqueIDSeed := 707686514;
end;

procedure TfrmMainForm.InitCrypto;
var
  MD5Buf : MD5Buffer;
  Context: MD5Context;
  D      : Double;
  W1     : Word;
  W2     : Word;
  HashDigest: MD5Digest;   // the result of hashing the passphrase with the salt

begin
  // Create Digest for first record in pdb

  FillChar(MD5Buf,64,#0);
  // generate random salt

  Randomize;
  RMSeed(Random(31329),Random(30082));
  D := RMRandom * 4096*4096;
  W1 := Trunc(D);
  D := RMRandom * 4096*4096;
  W2 := Trunc(D);

  Move(W1,Salt[0],2);
  Move(W2,Salt[2],2);

  // Add salt to buff
  Move(Salt[0],MD5Buf[0],4);
  // add the pass
  Move(edtPassword.text[1],md5Buf[4],Length(edtPassword.text));

  MD5Init(Context);
  MD5Update(Context, @MD5Buf, 64);
  MD5Final(Context, Digest);

  // Init the Cipher with a key
  // The key is a normal MD5 for the password string

  Hash.Init;
  Hash.UpdateStr(edtPassword.text);       // and the passphrase
  Hash.Final(HashDigest[0]);  // store the output in HashDigest

  DCP_3des.Init(HashDigest,128,nil);

end;

procedure TfrmMainForm.btnConvertClick(Sender: TObject);
var
  mgr : Pointer;
  Repair : Pointer;
  Result : Integer;
  EntryCount : Integer;
  PItem : Pointer;
  Index : Cardinal;
  Title : PChar;
  Username : PChar;
  Password : PChar;
  Notes : PChar;
  PDB : TpfgPalmDbFile;
  Size : Integer;  // result size for pdb record
  RecordPointer : Pointer;
begin
  PDB := TpfgPalmDbFile.Create(fedtPalmPdb.FileName,dbReadWrite);
  InitHeader(PDB);
  InitCategories(PDB);

  InitManager(mgr, False);
  Try
    SetMasterKey(mgr, PChar(edtPassword.Text), false, nil, 0, false);

    Repair := nil;
    Result := OpenDatabase(mgr,PChar(fedtKeePassDatabase.Filename) , Repair);
    If Result = 1 then begin
      InitCrypto;
      EntryCount := GetNumberOfEntries(mgr);
      PDB.RecordCount := EntryCount+1;   // We need one extra for the first record
      AppendFirstRecord(PDB);
      For Index := 0 to EntryCount-1 do begin
        PItem := GetEntry(mgr,Index);
        If PItem <> nil then begin
          Title := PE_GetTitle(PItem);
          Username := PE_GetUserName(PItem);
          UnlockEntryPassword(mgr,PItem);
          Password := PE_GetPassword(PItem);
          Notes := PE_GetNotes(PItem);
          CreateDataBlock(Title,Username,Password,Notes,RecordPointer,Size);
          PDB.SetRecord(Index+1,64,Index+2,0,RecordPointer,Size);
        end;
      end;  // End for to Entrycount
      PDB.Flush; // Save the pdb
      memLog.Lines.Add('Palm database is saved.');
      memLog.Lines.Add('REMEMBER! If you put it on your palm, all prevous Keyring data will be overwritten!!!');
    end
    else
      memLog.Lines.Add(Format('Error opening file. Result: %d',[Result]));
  finally
    DCP_3des.Burn;
    PDB.Free;
  end;
end;


procedure TfrmMainForm.fedtKeePassDatabaseChange(Sender: TObject);
begin
  btnConvert.Enabled := FileExists(fedtKeePassDatabase.FileName) and (fedtPalmPdb.Filename <> '') and (edtPassword.Text <> '');
end;

procedure TfrmMainForm.Button2Click(Sender: TObject);
begin
  Close;
end;

procedure TfrmMainForm.fedtKeePassDatabaseAfterDialog(Sender: TObject;
  var Name: String; var Action: Boolean);
begin
  If Action then begin
    (Sender as TFileNameEdit).Filename := Name;
    fedtKeePassDatabaseChange(Sender);
  end;
end;

procedure TfrmMainForm.FormDestroy(Sender: TObject);
var
  S : String;
  len : Integer;
begin
  // Clear the typed password
  Len := Length(edtPassword.Text);
  SetLength(S,Len);
  FillChar(S,Len,#0);
  edtPassword.Text := S;
end;

end.