my_registry.pas

是和Delphi 编程精选集锦书本配套的源码

//************************************************//
// Author:Youzhen
// Date: 2000/08/09
// Version: 1.0
//
// This Is A Dll File For Config ScreenSave
//
// Don't Use TString In Dll File !
// Use shortstring Instead of TString !
//
// Topic Function:
//         TRegistry
//         TRegistry.ValueExists
//         TRegistry.WriteBinaryData
//         TRegistry.ReadBinaryData
//         My_HexToInt
//         My_Encode_Array_Initialize
//         My_Decode
//         My_Encode
//
//************************************************//
unit My_Registry;

interface

uses
  Windows, Dialogs, Registry, SysUtils;



var My_Reg:TRegistry;

type Encode_Array_Type=array[1..20] of integer;
var My_Encode_Array:Encode_Array_Type;

const MaxLength=41; {Because 20*2+1=41!!!}


function My_Read_Key(var Output_String1:shortstring;
                     var Output_String2:shortstring):boolean;

function My_Create_Key(Input_New_Password:shortstring;
  ScreenSaveUsePassword_Active_Or_InActive:shortstring):boolean;


implementation

procedure My_Encode_Array_Initialize;
begin
  My_Encode_Array[1]:=72;
  My_Encode_Array[2]:=238;
  My_Encode_Array[3]:=118;
  My_Encode_Array[4]:=29;
  My_Encode_Array[5]:=103;

  My_Encode_Array[6]:=105;
  My_Encode_Array[7]:=161;
  My_Encode_Array[8]:=27;
  My_Encode_Array[9]:=122;
  My_Encode_Array[10]:=140;

  My_Encode_Array[11]:=71;
  My_Encode_Array[12]:=248;
  My_Encode_Array[13]:=84;
  My_Encode_Array[14]:=149;
  My_Encode_Array[15]:=151;

  My_Encode_Array[16]:=95;
  My_Encode_Array[17]:=120;
  My_Encode_Array[18]:=217;
  My_Encode_Array[19]:=218;
  My_Encode_Array[20]:=108;
end;

function My_HexToInt(var c:char):integer;
begin
  if c in ['0'..'9'] then
    Result:=StrToInt(c);
  case c of
  'A': Result:=10;
  'B': Result:=11;
  'C': Result:=12;
  'D': Result:=13;
  'E': Result:=14;
  'F': Result:=15;
  end;
end;

procedure My_Decode(var Input_String:shortstring;
                               var Output_String:shortstring);
var i,j:integer;

begin
  My_Encode_Array_Initialize;

  Output_String:='';
  for i:=1 to (Length(Input_String) div 2) do
    begin
      j:=(My_HexToInt(Input_String[2*i-1])*16
            +My_HexToInt(Input_String[2*i])) xor
         My_Encode_Array[i];
      Output_String:=Output_String+Chr(j);
    end;
  SetLength(Output_String,Length(Input_String) div 2);
end;

procedure My_Encode(Input_String:shortstring;
                    var Output_String:shortstring);
var i,j:integer;
    s:shortstring;
begin
  My_Encode_Array_Initialize;

  Output_String:='';
  for i:=1 to Length(Input_String) do
    begin
      // 1
      j:=Ord(Input_String[i]) xor Ord(My_Encode_Array[i]);
      // 2
      s:=IntToHex(j,2);
      for j:=1 to 2 do
        begin
          Output_String:=Output_String+s[j];
        end;
    end;
  Output_String:=Output_String+Chr(0);
end;

function My_Read_Key(var Output_String1:shortstring;
                     var Output_String2:shortstring):boolean;
var Input_String:shortstring;
    Output_String:shortstring;
    ScreenSave_Data_Value_Length:integer;

type AA=array [1..MaxLength] of char;  // 20*2+1=41!!!
var ss:AA;

var i:integer;
    s:shortstring;
    c:char;
    Have_Finded:boolean;

begin
  Result:=false;

  Input_String:='';
  Output_String:='';
  Have_Finded:=False;

  My_Reg:=TRegistry.Create;
       try
       My_Reg.RootKey:=HKEY_CURRENT_USER;
       if not My_Reg.OpenKey('Control Panel\desktop',false) then
         begin
           MessageDlg('Open Key For Reading Failed!',
              mtConfirmation, [mbOk], 0);
           exit;
         end
       else
         begin

           // Read ScreenSaveUsePassword
           if not My_Reg.ValueExists('ScreenSaveUsePassword') then
             begin
               My_Reg.WriteInteger('ScreenSaveUsePassword',
                      0);
             end;
           i:=My_Reg.ReadInteger('ScreenSaveUsePassword');

           Output_String1:=IntToStr(i);

           // Read ScreenSave_Data
           if not My_Reg.ValueExists('ScreenSave_Data') then
             begin
               c:=Chr(0);  //即 PassWord 为空时！！！
               My_Reg.WriteBinaryData('ScreenSave_Data',
                                       c,1);
             end;

           My_Reg.ReadBinaryData('ScreenSave_Data',
                                      ss[1],MaxLength);
           // Confirm ScreenSave_Data Value's Length
           i:=1;
           ScreenSave_Data_Value_Length:=i;
           i:=1;
           while (i <= MaxLength{=41}) and (not Have_Finded) do
             begin
               if ss[i]=Chr(0) then
                 begin
                   ScreenSave_Data_Value_Length:=i;
                   Have_Finded:=true;
                 end;
               i:=i+1;
             end;
           s:='';
           for i:=1 to ScreenSave_Data_Value_Length-1 do
             begin
               s:=s+ss[i];
             end;

           Input_String:=s;
           My_Decode(Input_String,Output_String);

           Output_String2:=Output_String;
         end;
       finally
         My_Reg.CloseKey;
         My_Reg.Free;
       end;

  Result:=true;
end;

function My_Create_Key(Input_New_Password:shortstring;
            ScreenSaveUsePassword_Active_Or_InActive:shortstring):boolean;
var Input_String:shortstring;
    Output_String:shortstring;

type AA=array [1..41] of char;  // 20*2+1=41!!!
var ss:AA;
    i:integer;
begin
  Result:=false;

  Input_String:=UpperCase(Input_New_Password);
  // 加密前必须先转化为大写！！！
  //这是由屏保加密规则决定的！！！
  Output_String:='';

  My_Reg:=TRegistry.Create;

  try
    My_Reg.RootKey:=HKEY_CURRENT_USER;
    if not My_Reg.OpenKey('Control Panel\desktop',false) then
      begin
        MessageDlg('Open Key For Setting Failed!',
                   mtConfirmation, [mbOk], 0);
        Exit;
      end
    else
      begin
       // Set ScreenSaveUsePassword Active
       My_Reg.WriteInteger('ScreenSaveUsePassword',
          StrToInt(ScreenSaveUsePassword_Active_Or_InActive));

       // Set ScreenSave_Data

       My_Encode(Input_String,Output_String);
       for i:=1 to Length(Output_String) do
         begin
           ss[i]:=Output_String[i];
         end;

       My_Reg.WriteBinaryData('ScreenSave_Data',
                              ss[1],Length(Output_String));
      end;
  finally
    My_Reg.CloseKey;
    My_Reg.Free;
  end;

  Result:=true;
end;


end.