Page History

uses IdCoder, IdCoderMIME, IdGlobal;

.
.
.

const CK_SINGATURE = '!CK!';
const CK_SINGATURE_KEY = 'ChunKang';
const CK_MAX_MSG_LEN = 1024*8;
const CK_ENC_VAR_RANGE=10;

function CKEncrypt(const Source:string; Salt:string): string;
var
  i, lenSalt, key, keyWeight: Word;
  InString: string;
begin
  Result := '';
  if (Salt = '') then begin
    Result := Source;
  end else begin
    InString := TIdEncoderMIME.EncodeString(Source, IndyTextEncoding_UTF8);

    lenSalt := Length(Salt);

    keyWeight := 0;
    for i := 1 to lenSalt do keyWeight := keyWeight + ord(Salt[i]);
    keyWeight := keyWeight mod CK_ENC_VAR_RANGE;

    for i := 1 to Length(InString) do
    begin
      key := ( ord(Salt[(i mod lenSalt) + 1]) mod CK_ENC_VAR_RANGE);
      Result := Result + CHAR(Byte(InString[i]) + key - keyWeight);
    end;
  end;
end;

function CKDecrypt(const InString:string; Salt:string): string;
var
  i, lenSalt, key, keyWeight: Word;
  Target: string;
begin
  if (Salt = '') then begin
    Target := InString;
  end else begin
    lenSalt := Length(Salt);

    keyWeight := 0;
    for i := 1 to lenSalt do keyWeight := keyWeight + ord(Salt[i]);
    keyWeight := keyWeight mod CK_ENC_VAR_RANGE;

    Target := '';
    for i := 1 to Length(InString) do
    begin
      key := ( ord(Salt[(i mod lenSalt) + 1]) mod CK_ENC_VAR_RANGE);
      Target := Target + CHAR(Byte(InString[i]) - key + keyWeight);
    end;
    Result := TIdDecoderMIME.DecodeString(Target, IndyTextEncoding_UTF8);
  end;
end;

function CKReadPassword(sFileName:string):string;
var
  lenPWD: WORD;
  buff: PAnsiChar;
  tmp: AnsiString;
  sFile: TFileStream;
  sEncryptedPWD: AnsiString;
begin
  GetMem( buff, CK_MAX_MSG_LEN);
  ZeroMemory( buff, CK_MAX_MSG_LEN);

  if FileExists(sFileName) then begin
    sFile := TFileStream.Create( sFileName, fmOpenRead);
    if sFile.Handle<>THandle(nil) then begin
      sFile.Seek( -4, soFromEnd);
      sFile.Read( PAnsiChar(buff)^, 4);
      if buff=CK_SINGATURE then
      begin
        // has master key, so need to erase it
        sFile.Seek( -6, soFromEnd);
        sFile.Read( lenPwd, 2);
        sFile.Seek( -(lenPWD + 6), soFromEnd);
        sFile.Read( PAnsIChar(buff)^, lenPWD);
        tmp := ansiString(string(buff));
        tmp := CKDecrypt( tmp, CK_SINGATURE_KEY);
        Result := Trim(tmp);
      end;
      sFile.Destroy;
    end;
  end;

  FreeMem(buff);
end;

function CKUpdatePassword(sFileName, sPWD:String):Boolean;
var
  buff: PAnsiChar;
  sFile: TFileStream;
  lenPWD, lenPWD_old: WORD;
  sEncryptedPWD: AnsiString;
begin
  GetMem( buff, CK_MAX_MSG_LEN);
  ZeroMemory( buff, CK_MAX_MSG_LEN);

  if not FileExists(sFileName) then begin
    Result := False;
  end else begin
    lenPWD_old := 0;
    sFile := TFileStream.Create( sFileName, fmOpenReadWrite);
    if sFile.Handle<>THandle(nil) then begin
      sFile.Seek( -4, soFromEnd);
      sFile.Read( PAnsiChar(buff)^, 4);
      if buff=CK_SINGATURE then
      begin
        // has master key, so need to erase it
        sFile.Seek( -6, soFromEnd);
        sFile.Read( lenPwd, 2);
        sFile.Seek( -(lenPWD + 6), soFromEnd);
        lenPWD_old := lenPWD;
      end else sFile.Seek( 0, soFromEnd);

      while Length(sPWD)<lenPWD_old do sPWD := sPWD + ' ';

      sEncryptedPWD := CKEncrypt(sPWD, CK_SINGATURE_KEY);
      lenPWD := Length(sEncryptedPWD);
      if (lenPWD>CK_MAX_MSG_LEN) then begin
        // too long message length
        Result := False;
      end else begin
        sFile.Write( PAnsiChar(sEncryptedPWD)^, lenPWD);
        sFile.Write( lenPWD, 2);
        sFile.Write( PAnsiChar(CK_SINGATURE)^, 4);
        Result := True;
      end;
      sFile.Destroy;
    end else Result := False;
  end;

  FreeMem(buff);
end;

procedure Test;
begin
  CKUpdatePassword( "c:\foo.exe", "hello kitty");
  ShowMessage( CKReadPassword( "c:\foo.exe"));
end;