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;
buff: PAnsiChar;
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);
sFile.Destroy Result := True;
Result := Trueend;
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; |